A .fln name carries no ? or !, and .fln has T?, x ?? d, x!, if let over a plain name and a?.b chaining.
This commit is contained in:
parent
7db1a81d1f
commit
178c129c97
7
TODO.org
7
TODO.org
@ -17,7 +17,8 @@ optionals: =T?= for =Option(T)=, =x ?? d=, =x!= (traps when absent), =if let g =
|
||||
(binds the payload), and chaining =a?.b=. Order: optionals and the name rule; the
|
||||
prelude and vendor rewritten in .fln; tests and examples converted with =flan convert=;
|
||||
then =flan convert=, the .flan source path and =flan-mode= removed. Nothing tracks what
|
||||
.flan can no longer say.
|
||||
.flan can no longer say. Step 1 is done: the name rule with the =is-=/=has-= renames
|
||||
through the prelude, vendor and raylib, and =T?=, =??=, =x!=, =if let g = x= and =a?.b=.
|
||||
** WAIT A cheap front for dyn sequences
|
||||
Decided 2026-09-26 (128) to pause: dyn vectors are mutable, so taking from the front
|
||||
shifts every element. Options were a linked list (cons/first/rest) or storing the dyn
|
||||
@ -32,8 +33,8 @@ Waits on the dyn char lane and the literal inference lane.
|
||||
** DONE if let
|
||||
CLOSED: [2026-09-26]
|
||||
=(if-let [P v] then else)= in paren syntax; an elif chain is the else. With no else it
|
||||
is a statement unless kept, when it is an Option as =when= is. Rules out a plain name or
|
||||
=_= as the pattern (use =let=).
|
||||
is a statement unless kept, when it is an Option as =when= is. A plain name binds what an
|
||||
Option or a dyn holds (130); over any other type, and =_=, it is refused toward =let=.
|
||||
** DONE when as a value, and get as a checked lookup
|
||||
CLOSED: [2026-09-26]
|
||||
Every one-armed =if= (and a =cond= with no =:else=) is a =when=; kept — a =let= value, a
|
||||
|
||||
@ -4041,7 +4041,7 @@ cannot help: their sentinel is set inside a `restart-case` body, which is a barr
|
||||
## `into`, which fuses at compile time because it is a macro
|
||||
|
||||
```
|
||||
(into xs (vec-new i32) (map double) (filter even?))
|
||||
(into xs (vec-new i32) (map double) (filter is-even))
|
||||
```
|
||||
|
||||
Source, destination, then any number of transforms — the shape of the `into->` macro the author already uses in
|
||||
|
||||
@ -80,11 +80,11 @@ is the `is_polymorphic_type_assignable` walk rather than a name match.
|
||||
```lisp
|
||||
(defn swap! [xs [$t] i i32 j i32] () ...)
|
||||
|
||||
(defn sort-by! [s [$t] before? (Fn [$t $t] bool)] ()
|
||||
(defn sort-by! [s [$t] is-before (Fn [$t $t] bool)] ()
|
||||
(let [i 1]
|
||||
(while (< i (length s))
|
||||
(let [j i]
|
||||
(while (and (> j 0) (before? (at s j) (at s (- j 1))))
|
||||
(while (and (> j 0) (is-before (at s j) (at s (- j 1))))
|
||||
(swap! s (- j 1) j)
|
||||
(set j (- j 1))))
|
||||
(set i (+ i 1)))))
|
||||
|
||||
@ -77,8 +77,8 @@ fine here. Brackets and strings are still paired."
|
||||
;; that starts with one, or follows a line that ends with one, continues the
|
||||
;; line above.
|
||||
(defconst flan-fln--binops
|
||||
'("or" "and" "==" "!=" "<" "<=" ">" ">=" "||" "^^" "&&" "<<" ">>" "+" "-" "*"
|
||||
"/" "%"))
|
||||
'("or" "and" "==" "!=" "??" "<" "<=" ">" ">=" "||" "^^" "&&" "<<" ">>" "+" "-"
|
||||
"*" "/" "%"))
|
||||
|
||||
(defconst flan-fln--binop-re (regexp-opt flan-fln--binops))
|
||||
|
||||
@ -131,8 +131,12 @@ fine here. Brackets and strings are still paired."
|
||||
;; Name characters: a name is anything up to a delimiter (`is_delimiter'
|
||||
;; in lib/reader.ml), so `is-key-pressed', `dyn->f64' and `rl/draw-fps' are
|
||||
;; one symbol each.
|
||||
(dolist (c '(?- ?_ ?? ?! ?/ ?. ?$ ?& ?* ?+ ?< ?> ?= ?% ?@ ?# ?^ ?| ?~))
|
||||
(dolist (c '(?- ?_ ?/ ?. ?$ ?& ?* ?+ ?< ?> ?= ?% ?@ ?# ?^ ?| ?~))
|
||||
(modify-syntax-entry c "_" table))
|
||||
;; A name carries no `?' or `!': they are the marks of `T?', `a?.b',
|
||||
;; `x!' and `??', so `x' alone is the symbol at `x!'.
|
||||
(modify-syntax-entry ?? "." table)
|
||||
(modify-syntax-entry ?! "." table)
|
||||
;; Not `:', which ends `x: T' and `comment:': a name glued to it would
|
||||
;; otherwise read as `x:', a name nothing defines. A `:key' keyword is
|
||||
;; drawn by its own font-lock rule instead.
|
||||
@ -1878,10 +1882,15 @@ lambda or a `Fn(...)' type, and not after a match arm's."
|
||||
;; `where' constraint.
|
||||
("[ \t]\\(then\\|else\\|in\\|where\\)[ \t]" 1 font-lock-keyword-face)
|
||||
;; `if let Some(g) = x', and a value's `if' or `when', `x = when c then a'.
|
||||
("\\_<if[ \t]+\\(let\\)[ \t]" 1 font-lock-keyword-face)
|
||||
("\\_<\\(?:el\\)?if[ \t]+\\(let\\)[ \t]" 1 font-lock-keyword-face)
|
||||
("[ \t=(,]\\(if\\|when\\)[ \t]" 1 font-lock-keyword-face)
|
||||
;; The operator words.
|
||||
("\\_<\\(and\\|or\\|not\\)\\_>" 1 font-lock-keyword-face)
|
||||
;; The optional marks: `x ?? d', the unwrap of `x!' and the `?' of a
|
||||
;; chain, `a?.b' and `a?[i]'. A type's `T?' stays the type's.
|
||||
("[ \t]\\(\\?\\?\\)[ \t]" 1 font-lock-keyword-face)
|
||||
("[])[:alnum:]_]\\(!\\)\\(?:[^=]\\|$\\)" 1 font-lock-keyword-face)
|
||||
("[])[:alnum:]_]\\(\\?\\)[.[]" 1 font-lock-keyword-face)
|
||||
(,(concat "\\_<" (regexp-opt flan--constants t) "\\_>")
|
||||
1 font-lock-constant-face)
|
||||
;; A keyword. `x:' is a name with a colon glued on, not one.
|
||||
|
||||
@ -88,12 +88,12 @@
|
||||
; a comment inside the body
|
||||
|
||||
return
|
||||
let left? = col > 0
|
||||
if left? or right?
|
||||
let is-left = col > 0
|
||||
if is-left or is-right
|
||||
let side =
|
||||
if not left?
|
||||
if not is-left
|
||||
1
|
||||
elif not right?
|
||||
elif not is-right
|
||||
-1
|
||||
else
|
||||
if f32(rand()) < 0.5 then 1 else -1
|
||||
@ -132,18 +132,18 @@ fn step() -> ()
|
||||
|
||||
return"))
|
||||
|
||||
(test-flan-fln--in (test-flan-fln--at test-flan-fln--settle "elif not right")
|
||||
(test-flan-fln--in (test-flan-fln--at test-flan-fln--settle "elif not is-right")
|
||||
(test-flan-fln--is "on a clause, the statement is its header's, clauses and all"
|
||||
(test-flan-fln--thing 'flan-fln-statement)
|
||||
"if not left?
|
||||
"if not is-left
|
||||
1
|
||||
elif not right?
|
||||
elif not is-right
|
||||
-1
|
||||
else
|
||||
if f32(rand()) < 0.5 then 1 else -1")
|
||||
(test-flan-fln--is "and the clause is its own line and block"
|
||||
(test-flan-fln--thing 'flan-fln-clause)
|
||||
"elif not right?
|
||||
"elif not is-right
|
||||
-1"))
|
||||
|
||||
(test-flan-fln--in (test-flan-fln--at test-flan-fln--settle "1\n elif")
|
||||
@ -160,9 +160,9 @@ fn step() -> ()
|
||||
(test-flan-fln--is "let x = with the value as a block"
|
||||
(test-flan-fln--thing 'flan-fln-statement)
|
||||
"let side =
|
||||
if not left?
|
||||
if not is-left
|
||||
1
|
||||
elif not right?
|
||||
elif not is-right
|
||||
-1
|
||||
else
|
||||
if f32(rand()) < 0.5 then 1 else -1"))
|
||||
@ -261,7 +261,7 @@ fn step() -> ()
|
||||
|
||||
;;; Statement motion
|
||||
|
||||
(test-flan-fln--in (test-flan-fln--at test-flan-fln--settle " let left?")
|
||||
(test-flan-fln--in (test-flan-fln--at test-flan-fln--settle " let is-left")
|
||||
(flan-fln-backward-statement)
|
||||
(test-flan--check "M-a at a statement's start goes to the one before at its level"
|
||||
(looking-at "if 0 == grid"))
|
||||
@ -277,7 +277,7 @@ fn step() -> ()
|
||||
(test-flan-fln--in (test-flan-fln--at test-flan-fln--settle " -1")
|
||||
(flan-fln-up)
|
||||
(test-flan--check "C-M-u goes to the line that owns the block"
|
||||
(looking-at "elif not right"))
|
||||
(looking-at "elif not is-right"))
|
||||
(flan-fln-up)
|
||||
(test-flan--check "and from there to its owner's" (looking-at "let side")))
|
||||
|
||||
@ -921,6 +921,34 @@ defconst(k, 3)
|
||||
(test-flan-fln--is "if let's let is a keyword" (funcall face "let Some") 'font-lock-keyword-face)
|
||||
(test-flan-fln--is "a value's when is a keyword" (funcall face "when a") 'font-lock-keyword-face)
|
||||
(test-flan-fln--is "and so is a statement's" (funcall face "when b") 'font-lock-keyword-face)))
|
||||
;; Swift optionals: the marks are not part of a name, `??' continues a line,
|
||||
;; and `elif let' reads as `if let' does.
|
||||
(test-flan-fln--in "fn f(o: i32?) -> i32\n if let g = o\n g!\n elif let h = p?.q\n h ?? 0\n"
|
||||
(font-lock-ensure)
|
||||
(let ((face (lambda (needle)
|
||||
(save-excursion (goto-char (point-min)) (search-forward needle)
|
||||
(get-text-property (match-beginning 0) 'face)))))
|
||||
(test-flan-fln--is "elif let's let is a keyword" (funcall face "let h") 'font-lock-keyword-face)
|
||||
(test-flan-fln--is "a type's ? is the type's" (funcall face "?)") 'font-lock-type-face)
|
||||
(test-flan-fln--is "an unwrap's ! is marked" (funcall face "!\n") 'font-lock-keyword-face)
|
||||
(test-flan-fln--is "a chain's ? is marked" (funcall face "?.q") 'font-lock-keyword-face)
|
||||
(test-flan-fln--is "?? is marked" (funcall face "??") 'font-lock-keyword-face))
|
||||
(goto-char (point-min))
|
||||
(search-forward "g!")
|
||||
(backward-char 1)
|
||||
(test-flan-fln--is "the name at x! is x" (thing-at-point 'symbol t) "g"))
|
||||
(test-flan-fln--is "after if let over a plain name, one level deeper"
|
||||
(test-flan-fln--tabs "fn f() -> ()\n if let g = o\n|" 1) 4)
|
||||
(with-temp-buffer
|
||||
(insert "x = a ??\n b\ny = a\n ?? b\n")
|
||||
(flan-fln-mode)
|
||||
(goto-char (point-min))
|
||||
(forward-line 1)
|
||||
(test-flan--check "a line after a trailing ?? continues it"
|
||||
(flan-fln--continuation-p (point)))
|
||||
(forward-line 2)
|
||||
(test-flan--check "a line starting with ?? continues"
|
||||
(flan-fln--continuation-p (point))))
|
||||
(test-flan-fln--is "else goes to its if's column, whatever the depth"
|
||||
(test-flan-fln--tabs "if a\n if b\n c\n |else" 1) 2)
|
||||
(test-flan-fln--is "and a second TAB to the outer if's"
|
||||
@ -1270,7 +1298,7 @@ its line with AT-END."
|
||||
(load-path (append dirs load-path)))
|
||||
(if (not (require 'expand-region nil t))
|
||||
(message " skip expand-region (not installed)")
|
||||
(test-flan-fln--in (test-flan-fln--at test-flan-fln--settle "right?\n -1")
|
||||
(test-flan-fln--in (test-flan-fln--at test-flan-fln--settle "is-right\n -1")
|
||||
(transient-mark-mode 1)
|
||||
(let ((steps nil))
|
||||
(dotimes (_ 6)
|
||||
@ -1279,8 +1307,8 @@ its line with AT-END."
|
||||
(setq steps (nreverse steps))
|
||||
(test-flan-fln--is "term, then statement's clause, then statement, then out"
|
||||
(mapcar (lambda (s) (car (split-string s "\n"))) steps)
|
||||
'("right?" "elif not right?" "if not left?" "let side ="
|
||||
"if left? or right?" "let left? = col > 0"))))))
|
||||
'("is-right" "elif not is-right" "if not is-left" "let side ="
|
||||
"if is-left or is-right" "let is-left = col > 0"))))))
|
||||
|
||||
;;; smartparens, where it is installed
|
||||
|
||||
@ -1346,7 +1374,7 @@ its line with AT-END."
|
||||
"if r >= 0 and r < rows - 1\n and c >= 0\n grid[r, c] = 1")
|
||||
("yas" ,(test-flan-fln--at test-flan-fln--settle "and c >= 0")
|
||||
" if r >= 0 and r < rows - 1\n and c >= 0\n grid[r, c] = 1\n")
|
||||
("yii" ,(test-flan-fln--at test-flan-fln--settle "if not left")
|
||||
("yii" ,(test-flan-fln--at test-flan-fln--settle "if not is-left")
|
||||
" 1\n")
|
||||
("yik" ,(test-flan-fln--at test-flan-fln--settle "if f32(rand())")
|
||||
" if f32(rand()) < 0.5 then 1 else -1\n")
|
||||
|
||||
@ -312,7 +312,7 @@
|
||||
;; still two in from `defn'.
|
||||
(test-flan-mode--check
|
||||
"a where clause sits in the body column and does not move the body"
|
||||
"(defn seen? [k $t] bool
|
||||
"(defn is-seen [k $t] bool
|
||||
{:where (is-hashable $t)}
|
||||
(let [m (map-new t i32)]
|
||||
(put m k 1)))")
|
||||
@ -483,7 +483,7 @@
|
||||
font-lock-type-face "Fn")
|
||||
("(declare call [(CFn [i64] i64)] i64)" "CFn"
|
||||
font-lock-type-face "CFn")
|
||||
("(defn seen? [k $t] bool 1)" "$t" font-lock-type-face
|
||||
("(defn is-seen [k $t] bool 1)" "$t" font-lock-type-face
|
||||
"a type variable")
|
||||
;; The package alias of a qualified name, `clojure-mode''s
|
||||
;; rule for a namespace.
|
||||
|
||||
@ -88,18 +88,18 @@
|
||||
;; call site says nothing, and because a gesture raylib adds later lands in
|
||||
;; the right family without this file being edited.
|
||||
|
||||
(defn pinch? [g rl/Gesture] bool ; the C's `> 255`
|
||||
(defn is-pinch [g rl/Gesture] bool ; the C's `> 255`
|
||||
(> (i32 g) 255))
|
||||
|
||||
(defn swipe? [g rl/Gesture] bool ; the C's `> 15`
|
||||
(defn is-swipe [g rl/Gesture] bool ; the C's `> 15`
|
||||
(> (i32 g) 15))
|
||||
|
||||
(defn tapish? [g rl/Gesture] bool ; the C's `< 3`
|
||||
(defn is-tapish [g rl/Gesture] bool ; the C's `< 3`
|
||||
(< (i32 g) 3))
|
||||
|
||||
;; Two orderings these impose, both of them the C's as well. A pinch is above
|
||||
;; 255 and therefore above 15, so swipe? has to be asked after the pinches
|
||||
;; rather than before; and tapish? admits :gesture-none, which is 0, so it
|
||||
;; 255 and therefore above 15, so is-swipe has to be asked after the pinches
|
||||
;; rather than before; and is-tapish admits :gesture-none, which is 0, so it
|
||||
;; belongs under a :gesture-none guard. The C's switch over single members
|
||||
;; hides both; a range test cannot.
|
||||
|
||||
@ -123,12 +123,12 @@
|
||||
(= g :gesture-tap) rl/blue
|
||||
(= g :gesture-double-tap) rl/skyblue
|
||||
(= g :gesture-drag) rl/lime
|
||||
;; The two pinches are above 255 and so are above 15 as well: swipe? is a
|
||||
;; The two pinches are above 255 and so are above 15 as well: is-swipe is a
|
||||
;; range test and has to be asked after them, not before. The C gets this
|
||||
;; for free by being a switch over single members.
|
||||
(= g :gesture-pinch-in) rl/violet
|
||||
(= g :gesture-pinch-out) rl/orange
|
||||
(swipe? g) rl/red
|
||||
(is-swipe g) rl/red
|
||||
:else rl/black))
|
||||
|
||||
;; ── The log ─────────────────────────────────────────────────────────
|
||||
@ -138,11 +138,11 @@
|
||||
;; 1 hides repeated events
|
||||
;; 2 shows repeated events but hides hold
|
||||
;; 3 hides repeated events and hides hold
|
||||
(defn should-log? [g rl/Gesture] bool
|
||||
(defn is-should-log [g rl/Gesture] bool
|
||||
(cond
|
||||
(= g :gesture-none) false
|
||||
(= log-mode 3) (or (and (not (= g :gesture-hold)) (not (= g previous-gesture)))
|
||||
(tapish? g))
|
||||
(is-tapish g))
|
||||
(= log-mode 2) (not (= g :gesture-hold))
|
||||
(= log-mode 1) (not (= g previous-gesture))
|
||||
:else true))
|
||||
@ -312,15 +312,15 @@
|
||||
(= log-mode 1) 3
|
||||
:else 2)))))
|
||||
|
||||
(when (should-log? g) (push-log g))
|
||||
(when (is-should-log g) (push-log g))
|
||||
|
||||
;; The protractor reads the pinch angle for a pinch, the drag angle for
|
||||
;; a swipe, and sits at 0 for everything else. These are the C's
|
||||
;; `> 255` / `> 15` / `> 0` — see the header for why they are spelled
|
||||
;; this way.
|
||||
(cond
|
||||
(pinch? g) (set current-angle (rl/get-gesture-pinch-angle))
|
||||
(swipe? g) (set current-angle (rl/get-gesture-drag-angle))
|
||||
(is-pinch g) (set current-angle (rl/get-gesture-pinch-angle))
|
||||
(is-swipe g) (set current-angle (rl/get-gesture-drag-angle))
|
||||
(not (= g :gesture-none)) (set current-angle 0.0)
|
||||
:else (do))
|
||||
|
||||
|
||||
@ -94,7 +94,7 @@
|
||||
(defonce unique-count i32)
|
||||
|
||||
;; Is `cp` already in the first `n` of the table?
|
||||
(defn seen? [cp i32 n i32] bool
|
||||
(defn is-seen [cp i32 n i32] bool
|
||||
(let [found false]
|
||||
(dotimes [i n]
|
||||
(when (= (at unique-codepoints i) cp) (set found true)))
|
||||
@ -113,7 +113,7 @@
|
||||
(set unique-count 0)
|
||||
(dotimes [i (length codepoints)]
|
||||
(let [cp (at codepoints i)]
|
||||
(when (and (not (seen? cp unique-count))
|
||||
(when (and (not (is-seen cp unique-count))
|
||||
(< unique-count max-codepoints))
|
||||
(set (at unique-codepoints unique-count) cp)
|
||||
(set unique-count (+ unique-count 1))))))
|
||||
|
||||
@ -57,14 +57,14 @@
|
||||
(defconst measure 0)
|
||||
(defconst draw 1)
|
||||
|
||||
;; Draw `text` inside `rec`, breaking lines on words when `word-wrap?`.
|
||||
;; Draw `text` inside `rec`, breaking lines on words when `is-word-wrap`.
|
||||
;;
|
||||
;; The two `slice-from` uses are inside rl/font-recs and rl/font-glyphs;
|
||||
;; from here they are ordinary slices, bounds-checked like any other, and the
|
||||
;; index comes from raylib's own get-glyph-index so it is in range by
|
||||
;; construction.
|
||||
(defn draw-text-boxed [font rl/Font text [const u8] rec rl/Rectangle
|
||||
font-size f32 spacing f32 word-wrap? bool
|
||||
font-size f32 spacing f32 is-word-wrap bool
|
||||
tint rl/Color] ()
|
||||
(let [glyphs (rl/font-glyphs font)
|
||||
recs (rl/font-recs font)
|
||||
@ -73,7 +73,7 @@
|
||||
line-h (* (f32 (+ (.base-size font) (/ (.base-size font) 2))) scale)
|
||||
off-x (f32 0.0)
|
||||
off-y (f32 0.0)
|
||||
state (if word-wrap? measure draw)
|
||||
state (if is-word-wrap measure draw)
|
||||
;; Byte offsets: where the current line begins and where it must end.
|
||||
;; -1 is "not decided yet", which is why end-line is compared against 1
|
||||
;; rather than 0 below — the C's `(endLine < 1)`.
|
||||
@ -130,11 +130,11 @@
|
||||
|
||||
(do
|
||||
(if (= cp (i32 \newline))
|
||||
(when (not word-wrap?)
|
||||
(when (not is-word-wrap)
|
||||
(set off-y (+ off-y line-h))
|
||||
(set off-x 0.0))
|
||||
(do
|
||||
(when (and (not word-wrap?) (> (+ off-x w) (.width rec)))
|
||||
(when (and (not is-word-wrap) (> (+ off-x w) (.width rec)))
|
||||
(set off-y (+ off-y line-h))
|
||||
(set off-x 0.0))
|
||||
;; Out of vertical room: stop, rather than drawing outside.
|
||||
@ -147,7 +147,7 @@
|
||||
(rl/Vector2 {.x (+ (.x rec) off-x)
|
||||
.y (+ (.y rec) off-y)})
|
||||
font-size tint))))
|
||||
(when (and word-wrap? (= i end-line))
|
||||
(when (and is-word-wrap (= i end-line))
|
||||
(set off-y (+ off-y line-h))
|
||||
(set off-x 0.0)
|
||||
(set start-line end-line)
|
||||
@ -166,8 +166,8 @@
|
||||
(defer (rl/close-window))
|
||||
|
||||
(let [text (bytes-view message)
|
||||
resizing? false
|
||||
word-wrap? true
|
||||
is-resizing false
|
||||
is-word-wrap true
|
||||
container (rl/Rectangle {.x 25.0 .y 25.0
|
||||
.width (- (f32 screen-width) 50.0)
|
||||
.height (- (f32 screen-height) 250.0)})
|
||||
@ -184,18 +184,18 @@
|
||||
(rl/set-target-fps 60)
|
||||
|
||||
(until (rl/window-should-close)
|
||||
(when (rl/is-key-pressed :key-space) (set word-wrap? (not word-wrap?)))
|
||||
(when (rl/is-key-pressed :key-space) (set is-word-wrap (not is-word-wrap)))
|
||||
|
||||
(let [mouse (rl/get-mouse-position)]
|
||||
;; The border fades while the pointer is over the container.
|
||||
(cond
|
||||
(rl/check-collision-point-rec mouse container)
|
||||
(set border (rl/fade rl/maroon 0.4))
|
||||
(not resizing?) (set border rl/maroon))
|
||||
(not is-resizing) (set border rl/maroon))
|
||||
|
||||
(if resizing?
|
||||
(if is-resizing
|
||||
(do
|
||||
(when (rl/is-mouse-button-released :mouse-left) (set resizing? false))
|
||||
(when (rl/is-mouse-button-released :mouse-left) (set is-resizing false))
|
||||
(let [w (+ (.width container) (- (.x mouse) (.x last-mouse)))
|
||||
h (+ (.height container) (- (.y mouse) (.y last-mouse)))]
|
||||
(set (.width container)
|
||||
@ -204,7 +204,7 @@
|
||||
(clamp h min-height max-height))))
|
||||
(when (and (rl/is-mouse-button-down :mouse-left)
|
||||
(rl/check-collision-point-rec mouse resizer))
|
||||
(set resizing? true)))
|
||||
(set is-resizing true)))
|
||||
|
||||
(set (.x resizer) (- (+ (.x container) (.width container)) 17.0))
|
||||
(set (.y resizer) (- (+ (.y container) (.height container)) 17.0))
|
||||
@ -221,7 +221,7 @@
|
||||
.y (+ (.y container) 4.0)
|
||||
.width (- (.width container) 4.0)
|
||||
.height (- (.height container) 4.0)})
|
||||
20.0 2.0 word-wrap? rl/gray)
|
||||
20.0 2.0 is-word-wrap rl/gray)
|
||||
|
||||
(rl/draw-rectangle-rec resizer border)
|
||||
|
||||
@ -232,7 +232,7 @@
|
||||
rl/maroon)
|
||||
|
||||
(rl/draw-text "Word Wrap: " 313 (- screen-height 115) 20 rl/black)
|
||||
(if word-wrap?
|
||||
(if is-word-wrap
|
||||
(rl/draw-text "ON" 447 (- screen-height 115) 20 rl/red)
|
||||
(rl/draw-text "OFF" 447 (- screen-height 115) 20 rl/black))
|
||||
|
||||
|
||||
@ -83,6 +83,10 @@ and expr_kind =
|
||||
A two-arm [match]: the arm is the pattern with [then] as its body, and
|
||||
the else is the [_] arm. With no else it is a statement. *)
|
||||
| IfLet of expr * arm * expr option
|
||||
(* (?. [n v] body) — [v?.rest] in .fln. When [v] holds a value, [n] is
|
||||
bound to it for [body]; the result is an Option (nil or a value over a
|
||||
dyn), flat when [body] is already one. [n] is the reader's fresh name. *)
|
||||
| Chain of string * expr * expr
|
||||
| Struct of string * (string * expr) list (* (Cursor {.src s}) *)
|
||||
(* {.src s .pos 0} with no type written in front of it. The fields alone do
|
||||
not name a type, so this node carries no name and is only checkable where
|
||||
@ -470,6 +474,7 @@ let map_children f (e : expr) : expr =
|
||||
| Call (fn, args) -> Call (ex fn, List.map ex args)
|
||||
| Match (s, arms) -> Match (ex s, List.map arm arms)
|
||||
| IfLet (s, a, e) -> IfLet (ex s, arm a, Option.map ex e)
|
||||
| Chain (n, v, b) -> Chain (n, ex v, ex b)
|
||||
| Struct (n, fs) -> Struct (n, List.map (fun (n, v) -> (n, ex v)) fs)
|
||||
| Bare fs -> Bare (List.map (fun (n, v) -> (n, ex v)) fs)
|
||||
| MapLit (tag, kvs) -> MapLit (tag, List.map (fun (k, v) -> (ex k, ex v)) kvs)
|
||||
|
||||
206
lib/check.ml
206
lib/check.ml
@ -3264,6 +3264,10 @@ let close_over ~fname (octx : ctx) (fctx : ctx) loc =
|
||||
crosses as ptr+len like any other. *)
|
||||
let here loc = mk loc Types.String (Tast.Str (Loc.to_string loc))
|
||||
|
||||
(* Names for the value an [if let] over a plain name holds; [~] keeps them
|
||||
out of any reader's reach. *)
|
||||
let held_n = ref 0
|
||||
|
||||
(* The read-only slice a value's storage is reached through, if there is one:
|
||||
an element of a [[const T]], a field of such an element, or an element of
|
||||
an array that is. The last slice stepped through decides, because the
|
||||
@ -6465,6 +6469,7 @@ and check_value ctx ?want (e : Ast.expr) : Tast.expr =
|
||||
| Ast.Match (scrutinee, arms) -> check_match ctx ~tail ~used ?want loc scrutinee arms
|
||||
| Ast.IfLet (scrutinee, arm, els) ->
|
||||
check_if_let ctx ~tail ~used ?want loc scrutinee arm els
|
||||
| Ast.Chain (n, v, body) -> check_chain ctx ~want loc n v body
|
||||
(* Constant integer arithmetic where a type variable is wanted is folded to
|
||||
the literal it computes first, so [(+ x (+ 1 2))] is admitted wherever
|
||||
[(+ x 3)] is. The instantiation re-checks the form unfolded, at a concrete
|
||||
@ -10469,10 +10474,11 @@ and check_if_let ctx ~tail ~used ?want loc scrutinee (arm : Ast.arm) els =
|
||||
"the pattern _ always matches, so this if let has nothing to test. \
|
||||
Use the value directly, or match on it"
|
||||
in
|
||||
(match arm.Ast.pat with
|
||||
| Ast.Pwild -> irrefutable None
|
||||
| Ast.Pctor (n, []) when not (is_case n) -> irrefutable (Some n)
|
||||
| _ -> ());
|
||||
match arm.Ast.pat with
|
||||
| Ast.Pwild -> irrefutable None
|
||||
| Ast.Pctor (n, []) when not (is_case n) ->
|
||||
if_let_name ctx ~tail ~used ?want loc scrutinee n arm els
|
||||
| _ ->
|
||||
let wild body = { Ast.pat = Ast.Pwild; body; aloc = loc } in
|
||||
(* Kept with no else at the end of its chain, it is a [when] over a
|
||||
pattern: [Some] of the arm that ran and [None] when none did — or, where
|
||||
@ -10512,6 +10518,185 @@ and check_if_let ctx ~tail ~used ?want loc scrutinee (arm : Ast.arm) els =
|
||||
expect ctx loc ~want
|
||||
(check_match ctx ~tail ~stmt:true loc scrutinee [ arm; wild [] ])
|
||||
|
||||
(* [if let g = x] with a plain name: over an Option it is [if let Some(g) =
|
||||
x], and over a dyn it binds [g] when [x] is not nil. [x] is checked once
|
||||
and held under a name no reader can produce; the rest is the form it
|
||||
stands for, checked as that form is. Anything else always holds a value,
|
||||
so there is nothing to test. *)
|
||||
and if_let_name ctx ~tail ~used ?want loc scrutinee n (arm : Ast.arm) els =
|
||||
let sv = check ctx scrutinee in
|
||||
let fln = fln_source loc in
|
||||
let held f =
|
||||
scoped ctx (fun () ->
|
||||
incr held_n;
|
||||
let h = Printf.sprintf "~if%d" !held_n in
|
||||
let s = bind ctx h sv.Tast.ty ~assignable:false in
|
||||
let hv = { Ast.e = Ast.Var h; loc = scrutinee.Ast.loc } in
|
||||
let r = f hv in
|
||||
mk loc r.Tast.ty (Tast.Let ([ (s, sv) ], [ r ])))
|
||||
in
|
||||
match sv.Tast.ty with
|
||||
| Types.Option _ ->
|
||||
held (fun hv ->
|
||||
check_if_let ctx ~tail ~used ?want loc hv
|
||||
{ arm with Ast.pat = Ast.Pctor ("Some", [ n ]) } els)
|
||||
| Types.Dyn ->
|
||||
held (fun hv ->
|
||||
let at e = { Ast.e; loc = arm.Ast.aloc } in
|
||||
let test = at (Ast.Call (at (Ast.Var "!="), [ hv; at (Ast.Var "nil") ])) in
|
||||
let bnd = { Ast.bname = n; bty = None; bval = hv; bloc = arm.Ast.aloc } in
|
||||
let body = { Ast.e = Ast.Let ([ bnd ], arm.Ast.body); loc = arm.Ast.aloc } in
|
||||
ctx.tail <- tail;
|
||||
ctx.used <- used;
|
||||
check ctx ?want { Ast.e = Ast.If (test, body, els); loc })
|
||||
| t ->
|
||||
Loc.failk "check/if-let-irrefutable" arm.Ast.aloc
|
||||
"%s is %s, which always holds a value, so this if let has nothing to \
|
||||
test. A plain name in an if let binds what an Option or a dyn holds \
|
||||
when it holds something. Bind this value with %s"
|
||||
(spell_arg "the value" scrutinee) (tyname loc t)
|
||||
(if fln then Printf.sprintf "let %s = ..." n
|
||||
else Printf.sprintf "(let [%s ...] ...)" n)
|
||||
|
||||
(* The tag test and the payload of an Option held in a local, and the nil
|
||||
test of a dyn: the shapes [box_option] and [unbox_option] build. *)
|
||||
and opt_is_some loc (sv : Tast.expr) =
|
||||
mk loc Types.Bool
|
||||
(Tast.Prim (Tast.Ne,
|
||||
[ mk loc (Types.Int Types.I8) (Tast.Field (sv, 0));
|
||||
mk loc (Types.Int Types.I8) (Tast.Int (0L, Types.I8)) ]))
|
||||
|
||||
and opt_payload loc t (sv : Tast.expr) = mk loc t (Tast.Field (sv, 1))
|
||||
|
||||
and dyn_not_nil loc (sv : Tast.expr) =
|
||||
mk loc Types.Bool
|
||||
(Tast.Prim (Tast.Eq,
|
||||
[ rt loc (Types.Int Types.I32) "flan_dyn_is_nil" [ sv ];
|
||||
mk loc (Types.Int Types.I32) (Tast.Int (0L, Types.I32)) ]))
|
||||
|
||||
(* [x ?? d]: what [x] holds, or [d] when it holds nothing — [None], or nil
|
||||
over a dyn. [d] is evaluated only then. A chain, [(?? a b c)], is read
|
||||
from the right, [a ?? (b ?? c)], so a default may itself be an Option and
|
||||
the whole is then an Option, as in Swift. *)
|
||||
and check_coalesce ctx ~want loc (args : Ast.expr list) =
|
||||
match args with
|
||||
| [] | [ _ ] -> fail loc "?? takes a value and a default: x ?? d"
|
||||
| x :: rest ->
|
||||
let d =
|
||||
match rest with
|
||||
| [ d ] -> d
|
||||
| d :: _ -> { Ast.e = Ast.Call ({ Ast.e = Ast.Var "??"; loc }, rest); loc = d.Ast.loc }
|
||||
| [] -> assert false
|
||||
in
|
||||
let xv = check ctx x in
|
||||
let s = fresh_slot ctx xv.Tast.ty in
|
||||
let sv = mk loc xv.Tast.ty (Tast.Local s) in
|
||||
let held ty e = mk loc ty (Tast.Let ([ (s, xv) ], [ mk loc ty e ])) in
|
||||
(match xv.Tast.ty with
|
||||
| Types.Option t ->
|
||||
(match trial ctx (fun () -> expect ctx d.Ast.loc ~want:(Some t) (check ctx ~want:t d)) with
|
||||
| Ok dv -> expect ctx loc ~want (held t (Tast.If (opt_is_some loc sv, opt_payload loc t sv, dv)))
|
||||
| Error first ->
|
||||
let o = Types.Option t in
|
||||
(match trial ctx (fun () -> expect ctx d.Ast.loc ~want:(Some o) (check ctx ~want:o d)) with
|
||||
| Ok dv -> expect ctx loc ~want (held o (Tast.If (opt_is_some loc sv, sv, dv)))
|
||||
| Error _ -> raise (Loc.Error first)))
|
||||
| Types.Dyn ->
|
||||
let dv = check ctx ~want:Types.Dyn d in
|
||||
expect ctx loc ~want (held Types.Dyn (Tast.If (dyn_not_nil loc sv, sv, dv)))
|
||||
| t ->
|
||||
fail x.Ast.loc
|
||||
"the left side of ?? is %s, which always holds a value, so there is \
|
||||
nothing to fall back from. ?? takes an Option or a dyn"
|
||||
(tyname loc t))
|
||||
|
||||
(* The source text of [e], for a message the program prints when it runs. *)
|
||||
and source_text (e : Ast.expr) =
|
||||
match Loc.snippet ~lim:48 e.Ast.loc with
|
||||
| Some t -> t
|
||||
| None -> spell_arg "the value" e
|
||||
|
||||
(* [x!]: what [x] holds, and a trap at this site naming [x] when it holds
|
||||
nothing. The trap never returns; the zero after it only gives the arm its
|
||||
type, so no backend needs a call typed Never. *)
|
||||
and check_unwrap ctx ~want loc (args : Ast.expr list) =
|
||||
match args with
|
||||
| [ x ] ->
|
||||
let xv = check ctx x in
|
||||
let s = fresh_slot ctx xv.Tast.ty in
|
||||
let sv = mk loc xv.Tast.ty (Tast.Local s) in
|
||||
let text = source_text x in
|
||||
let fail_with none zero ty =
|
||||
mk loc ty
|
||||
(Tast.Do
|
||||
[ rt loc Types.Unit "flan_unwrap_fail"
|
||||
[ here loc;
|
||||
mk loc Types.String
|
||||
(Tast.Str (Printf.sprintf "%s is %s, so %s! has no value to give"
|
||||
text none text)) ];
|
||||
zero ])
|
||||
in
|
||||
let held ty e = mk loc ty (Tast.Let ([ (s, xv) ], [ mk loc ty e ])) in
|
||||
(match xv.Tast.ty with
|
||||
| Types.Option t ->
|
||||
expect ctx loc ~want
|
||||
(held t (Tast.If (opt_is_some loc sv, opt_payload loc t sv,
|
||||
fail_with "None" (mk loc t (Tast.Zero t)) t)))
|
||||
| Types.Dyn ->
|
||||
expect ctx loc ~want
|
||||
(held Types.Dyn
|
||||
(Tast.If (dyn_not_nil loc sv, sv,
|
||||
fail_with "nil" (rt loc Types.Dyn "flan_dyn_nil" []) Types.Dyn)))
|
||||
| t ->
|
||||
fail x.Ast.loc
|
||||
"%s is %s, which always holds a value, so ! has nothing to unwrap. \
|
||||
Leave the ! out" text (tyname loc t))
|
||||
| _ -> fail loc "! unwraps one value: x!"
|
||||
|
||||
(* [a?.b]: [(?. [n a] body)] — [body] over what [a] holds, bound to [n], or
|
||||
None when it holds nothing (nil over a dyn). [body] already an Option is
|
||||
not wrapped again, so [a?.b?.c] is one Option; [body] with no value makes
|
||||
the whole a statement. *)
|
||||
and check_chain ctx ~want loc n (v : Ast.expr) (body : Ast.expr) =
|
||||
let hv = check ctx v in
|
||||
let s = fresh_slot ctx hv.Tast.ty in
|
||||
let sv = mk loc hv.Tast.ty (Tast.Local s) in
|
||||
let arm t ~dyn =
|
||||
scoped ctx (fun () ->
|
||||
let p = bind ctx n t ~assignable:false in
|
||||
let bv = if dyn then check ctx ~want:Types.Dyn body else check ctx body in
|
||||
(p, bv))
|
||||
in
|
||||
let held ty e = mk loc ty (Tast.Let ([ (s, hv) ], [ mk loc ty e ])) in
|
||||
match hv.Tast.ty with
|
||||
| Types.Option t ->
|
||||
let p, bv = arm t ~dyn:false in
|
||||
let inner ty e = mk loc ty (Tast.Let ([ (p, opt_payload loc t sv) ], [ e ])) in
|
||||
(match bv.Tast.ty with
|
||||
| Types.Unit | Types.Never ->
|
||||
expect ctx loc ~want
|
||||
(held Types.Unit
|
||||
(Tast.If (opt_is_some loc sv, inner Types.Unit bv, mk loc Types.Unit Tast.Unit)))
|
||||
| Types.Option _ as o ->
|
||||
expect ctx loc ~want
|
||||
(held o (Tast.If (opt_is_some loc sv, inner o bv, mk loc o Tast.None_)))
|
||||
| b ->
|
||||
let o = Types.Option b in
|
||||
expect ctx loc ~want
|
||||
(held o (Tast.If (opt_is_some loc sv, inner o (mk loc o (Tast.Some_ bv)),
|
||||
mk loc o Tast.None_))))
|
||||
| Types.Dyn ->
|
||||
let p, bv = arm Types.Dyn ~dyn:true in
|
||||
let ty = match bv.Tast.ty with Types.Unit | Types.Never -> Types.Unit | _ -> Types.Dyn in
|
||||
let none = if ty = Types.Unit then mk loc Types.Unit Tast.Unit
|
||||
else rt loc Types.Dyn "flan_dyn_nil" [] in
|
||||
expect ctx loc ~want
|
||||
(held ty (Tast.If (dyn_not_nil loc sv, mk loc ty (Tast.Let ([ (p, sv) ], [ bv ])), none)))
|
||||
| t ->
|
||||
fail v.Ast.loc
|
||||
"%s is %s, which always holds a value, so ?. has nothing to test. \
|
||||
Write . instead" (source_text v) (tyname loc t)
|
||||
|
||||
(* ── Places ────────────────────────────────────────────────────────── *)
|
||||
|
||||
(* The fields a name has, whether it is a struct or an untagged union. The two
|
||||
@ -12687,6 +12872,9 @@ and named_call ?(qualified = false) ctx ~want loc name args =
|
||||
defn has everywhere else. *)
|
||||
| _ when (not qualified) && shadows_builtin ctx loc name ->
|
||||
ordinary_call ctx ~want loc name args
|
||||
(* .fln's [x ?? d] and [x!]; no .fln name can take them over. *)
|
||||
| "??" -> check_coalesce ctx ~want loc args
|
||||
| "!!" -> check_unwrap ctx ~want loc args
|
||||
(* ── arithmetic and comparison ─────────────────────────────────── *)
|
||||
(* (- x) negates, Clojure's rule. A literal operand is the negative literal,
|
||||
so it takes its type from the site as any literal does. A float is
|
||||
@ -15732,7 +15920,7 @@ and generic_call ctx ~want loc name vars pats pret args =
|
||||
walked back on 2026-09-20, by the author: a numeric argument at a
|
||||
variable an earlier argument already bound resolves the variable
|
||||
to whichever of the pair the other widens into, value-preserving
|
||||
widening only, so [(eq2? (i8 3) (i64 3))] and its reverse are one
|
||||
widening only, so [(is-eq2 (i8 3) (i64 3))] and its reverse are one
|
||||
copy at i64. A pair with no join — u64 against i64 — is still
|
||||
refused: there is no type that holds every value of both, and
|
||||
inventing one would be picking a type neither argument was
|
||||
@ -16689,6 +16877,13 @@ let builtins : (string * string * string) list =
|
||||
"Walks the map one entry per call through a cursor the caller owns, and \
|
||||
is the whole of map iteration: (while (map-next m (addr cur) (addr k) \
|
||||
(addr v)) ...).");
|
||||
("??", "?? [(Option T)|dyn T ...] T",
|
||||
"x ?? d in .fln: what x holds, or d when x is None (nil over a dyn). d is \
|
||||
evaluated only then. a ?? b ?? c reads from the right, and a default \
|
||||
that is itself an Option keeps the whole an Option.");
|
||||
("!!", "!! [(Option T)|dyn] T",
|
||||
"x! in .fln: what x holds. When x is None (nil over a dyn) the program \
|
||||
stops there, naming x.");
|
||||
("has-key", "has-key [(Map K V) K] bool",
|
||||
"Whether the key is present, copying no value — the form a condition \
|
||||
wants, where get would hand back an Option to match on. Over a dyn map \
|
||||
@ -17698,6 +17893,7 @@ let escaping_names ~returns (body : Ast.expr list) : string list =
|
||||
| Ast.IfLet (_, a, b) ->
|
||||
(match List.rev a.Ast.body with x :: _ -> tails x | [] -> ());
|
||||
Option.iter tails b
|
||||
| Ast.Chain (_, _, b) -> tails b
|
||||
| Ast.Match (_, arms) ->
|
||||
List.iter
|
||||
(fun (a : Ast.arm) ->
|
||||
|
||||
@ -5003,6 +5003,7 @@ declare void @flan_restart_fail(ptr, i64, ptr, i64) noreturn cold
|
||||
declare void @flan_restart_args_fail(ptr, i64, ptr, i64, ptr, i64, ptr, i64) noreturn cold
|
||||
declare void @flan_restart_unarmed(ptr, i64, ptr, i64, ptr, i64) noreturn cold
|
||||
declare void @flan_transfer_fail(ptr, i64) noreturn cold
|
||||
declare void @flan_unwrap_fail(ptr, i64, ptr, i64) noreturn cold
|
||||
; Not noreturn: each signals BoundsError and returns when something answered
|
||||
; it, which is the one path out. The trailing ptr is the transfer channel.
|
||||
declare void @flan_bounds_error(ptr, i64, i64, i64, ptr) cold
|
||||
|
||||
@ -25,6 +25,8 @@ type tok =
|
||||
| UNQ | SPLICE (* ~ and ~@ *)
|
||||
| BNOT (* ~~, bit-not; a nested unquote is ~(~x) *)
|
||||
| NEG (* the - glued to the front of a name *)
|
||||
| QUEST (* T? and a?.b: a ? glued after a name or a closer *)
|
||||
| BANG (* x!: a ! glued after a value *)
|
||||
| NEWLINE | INDENT | DEDENT | EOF
|
||||
|
||||
type token = { tok : tok; loc : Loc.t; sp : bool (* whitespace before it *) }
|
||||
@ -38,6 +40,7 @@ let show = function
|
||||
| DATUM f -> Form.to_source f
|
||||
| LP -> "(" | RP -> ")" | LB -> "[" | RB -> "]" | LC -> "{" | RC -> "}"
|
||||
| COMMA -> "," | COLON -> ":" | UNQ -> "~" | SPLICE -> "~@" | BNOT -> "~~" | NEG -> "-"
|
||||
| QUEST -> "?" | BANG -> "!"
|
||||
| NEWLINE -> "the end of the line"
|
||||
| INDENT -> "an indented line"
|
||||
| DEDENT -> "the end of the block"
|
||||
@ -143,6 +146,9 @@ let cmp_chain ~fresh (l : Loc.t) (xs : Form.t list) (ops : string list) =
|
||||
let cmp_n = ref 0
|
||||
let cmp_fresh () = incr cmp_n; Printf.sprintf "~cmp%d" !cmp_n
|
||||
|
||||
(* The reader's fresh names for an optional chain's payload, per [read_all]. *)
|
||||
let opt_n = ref 0
|
||||
|
||||
(* A [-] glued to one of these starts a negation: [-x] is [(- x)]. Anything
|
||||
else keeps the Lisp reading, so [--], [->] and [-=] stay names. *)
|
||||
let is_neg_char c =
|
||||
@ -168,6 +174,62 @@ let split_fields text =
|
||||
then [ text ]
|
||||
else segs
|
||||
|
||||
(* ── Names without ? or ! ──────────────────────────────────────────── *)
|
||||
|
||||
(* What a [?] may follow to mean [Option]: a type's name. A capital after
|
||||
any [pkg/], a type variable, or a primitive. *)
|
||||
let type_like s =
|
||||
let base =
|
||||
match String.rindex_opt s '/' with
|
||||
| Some i -> String.sub s (i + 1) (String.length s - i - 1)
|
||||
| None -> s
|
||||
in
|
||||
base <> ""
|
||||
&& ((base.[0] >= 'A' && base.[0] <= 'Z') || base.[0] = '$'
|
||||
|| List.mem base ("char" :: Types.primitive_names))
|
||||
|
||||
(* The name a question is spelled with: [is-] in front, unless it already
|
||||
starts with a verb. The table holds the prelude's and raylib's names that
|
||||
do not follow that rule, so the fix for one of them is the real name. *)
|
||||
let question_fix name =
|
||||
let pkg, base =
|
||||
match String.rindex_opt name '/' with
|
||||
| Some i -> (String.sub name 0 (i + 1), String.sub name (i + 1) (String.length name - i - 1))
|
||||
| None -> ("", name)
|
||||
in
|
||||
let starts p = String.starts_with ~prefix:p base in
|
||||
let fixed =
|
||||
match base with
|
||||
| "starts-with" -> "has-prefix"
|
||||
| "ends-with" -> "has-suffix"
|
||||
| "file-exists" | "window-should-close" -> base
|
||||
| "bytes<" -> "is-bytes-less"
|
||||
| "into-maps" -> "has-map-step"
|
||||
| "form-sym" -> "is-form-named"
|
||||
| "form-is-sym" -> "is-form-sym"
|
||||
| _ when starts "is-" || starts "has-" || starts "can-" -> base
|
||||
| _ when starts "collision-" -> "check-" ^ base
|
||||
| _ when String.ends_with ~suffix:"=" base ->
|
||||
"is-" ^ String.sub base 0 (String.length base - 1) ^ "-equal"
|
||||
| _ -> "is-" ^ base
|
||||
in
|
||||
pkg ^ fixed
|
||||
|
||||
let name_refused loc whole =
|
||||
let drop c s = String.concat "" (String.split_on_char c s) in
|
||||
let n = String.length whole in
|
||||
if n > 1 && whole.[n - 1] = '?' && not (String.contains (String.sub whole 0 (n - 1)) '?')
|
||||
&& not (String.contains whole '!') then
|
||||
Loc.failk "indent/question-name" loc
|
||||
"%s is not a name: a name cannot contain ?.\n\n\
|
||||
A name for a yes-or-no question starts with is- or has- instead: %s"
|
||||
whole (question_fix (String.sub whole 0 (n - 1)))
|
||||
else
|
||||
let c = if String.contains whole '!' then '!' else '?' in
|
||||
Loc.failk "indent/mark-in-name" loc
|
||||
"%s is not a name: a name cannot contain %c.\n\nLeave it out: %s"
|
||||
whole c (drop '!' (drop '?' whole))
|
||||
|
||||
(* ── Lexing ────────────────────────────────────────────────────────── *)
|
||||
|
||||
let lex ?(line = 1) ?(col = 1) ~file src : token list =
|
||||
@ -198,21 +260,98 @@ let lex ?(line = 1) ?(col = 1) ~file src : token list =
|
||||
if text.[n - 1] = ':' then (String.sub text 0 (n - 1), true)
|
||||
else (text, false)
|
||||
in
|
||||
let bn = String.length body in
|
||||
let bcol, body =
|
||||
if bn > 1 && body.[0] = '-' && is_neg_char body.[1] then begin
|
||||
emit NEG (piece line col 1);
|
||||
(col + 1, String.sub body 1 (bn - 1))
|
||||
end
|
||||
else (col, body)
|
||||
let plain col body =
|
||||
let bn = String.length body in
|
||||
let bcol, body =
|
||||
if bn > 1 && body.[0] = '-' && is_neg_char body.[1] then begin
|
||||
emit NEG (piece line col 1);
|
||||
(col + 1, String.sub body 1 (bn - 1))
|
||||
end
|
||||
else (col, body)
|
||||
in
|
||||
let off = ref 0 in
|
||||
List.iteri
|
||||
(fun i seg ->
|
||||
let s = if i = 0 then seg else "." ^ seg in
|
||||
emit (NAME s) (piece line (bcol + !off) (String.length s));
|
||||
off := !off + String.length s)
|
||||
(split_fields body)
|
||||
in
|
||||
let off = ref 0 in
|
||||
List.iteri
|
||||
(fun i seg ->
|
||||
let s = if i = 0 then seg else "." ^ seg in
|
||||
emit (NAME s) (piece line (bcol + !off) (String.length s));
|
||||
off := !off + String.length s)
|
||||
(split_fields body);
|
||||
(* [.b.c] after a [?] or a [!]: one field access per segment. *)
|
||||
let fields col s =
|
||||
let segs = String.split_on_char '.' (String.sub s 1 (String.length s - 1)) in
|
||||
if List.mem "" segs then emit (NAME s) (piece line col (String.length s))
|
||||
else
|
||||
List.fold_left
|
||||
(fun c seg ->
|
||||
emit (NAME ("." ^ seg)) (piece line c (String.length seg + 1));
|
||||
c + String.length seg + 1)
|
||||
col segs
|
||||
|> ignore
|
||||
in
|
||||
(* Before the first mark a leading dot is the name's own, [.field] as
|
||||
an accessor; after one it starts a field access. *)
|
||||
let some_part ~after col s =
|
||||
if s = "" then () else if after && s.[0] = '.' then fields col s else plain col s
|
||||
in
|
||||
(* The name a [?] or a [!] at [i] of [s] belongs to: back to the dot
|
||||
or the start before it, on to the dot or the end after it. *)
|
||||
let word s i =
|
||||
let a = match String.rindex_from_opt s i '.' with Some d -> d + 1 | None -> 0 in
|
||||
let b = match String.index_from_opt s i '.' with Some d -> d | None -> String.length s in
|
||||
(a, String.sub s a (b - a))
|
||||
in
|
||||
let next = if Reader.at_end st then ' ' else Reader.peek st in
|
||||
(* A [?] ends a type's name, [T?], or starts a chain, [a?.b] and
|
||||
[a?[i]]; a [!] unwraps, [x!]. Anywhere else each is inside a name,
|
||||
which is refused (spec-syntax.md, "Names"). *)
|
||||
let rec marks ?(after = false) col s =
|
||||
match String.index_opt s '?', String.index_opt s '!' with
|
||||
| None, None -> some_part ~after col s
|
||||
| q, b ->
|
||||
let i = match q, b with
|
||||
| Some q, Some b -> min q b | Some q, None -> q | None, Some b -> b
|
||||
| None, None -> assert false
|
||||
in
|
||||
let pre = String.sub s 0 i and ch = s.[i] in
|
||||
let rest = String.sub s (i + 1) (String.length s - i - 1) in
|
||||
let at = col + i in
|
||||
let wa, whole = word s i in
|
||||
let last = match String.rindex_opt pre '.' with
|
||||
| Some d -> String.sub pre (d + 1) (String.length pre - d - 1)
|
||||
| None -> pre
|
||||
in
|
||||
if ch = '?' then begin
|
||||
if rest <> "" && rest.[0] = '?' && pre <> "" then
|
||||
failk "unspaced-operator" (piece line at 2)
|
||||
"?? is an operator here, and a binary operator has a space on \
|
||||
each side: %s ?? %s" pre
|
||||
(let r = String.sub rest 1 (String.length rest - 1) in
|
||||
if r = "" then "d" else r);
|
||||
let ends = rest = "" && next <> '(' in
|
||||
let chain = (rest <> "" && rest.[0] = '.') || (rest = "" && next = '[') in
|
||||
if (ends && (pre = "" || type_like last)) || chain then begin
|
||||
some_part ~after col pre;
|
||||
emit QUEST (piece line at 1);
|
||||
marks ~after:true (at + 1) rest
|
||||
end
|
||||
else name_refused (piece line (col + wa) (String.length whole)) whole
|
||||
end
|
||||
else begin
|
||||
if rest <> "" && rest.[0] = '=' then
|
||||
failk "unspaced-operator" (piece line at 2)
|
||||
"!= is an operator here, and a binary operator has a space on \
|
||||
each side: %s != %s" pre (String.sub rest 1 (String.length rest - 1));
|
||||
if (rest = "" && next <> '(') || (rest <> "" && rest.[0] = '.') then begin
|
||||
some_part ~after col pre;
|
||||
emit BANG (piece line at 1);
|
||||
marks ~after:true (at + 1) rest
|
||||
end
|
||||
else name_refused (piece line (col + wa) (String.length whole)) whole
|
||||
end
|
||||
in
|
||||
let wordy = String.exists (fun c -> Reader.is_digit c || (c >= 'a' && c <= 'z') || (c >= 'A' && c <= 'Z')) body in
|
||||
if wordy || body = "?" || body = "!" then marks col body else plain col body;
|
||||
if colon then emit COLON (piece line (col + n - 1) 1)
|
||||
end
|
||||
in
|
||||
@ -866,7 +1005,7 @@ and binary p lvl : Form.t * int =
|
||||
else if lvl > 10 then unary p
|
||||
else
|
||||
let l0 = (peek p).loc in
|
||||
let ((first, _) as fst_) = binary p (lvl + 1) in
|
||||
let ((first, _) as fst_) = operand p lvl in
|
||||
let close op operands =
|
||||
match List.rev operands with
|
||||
| [ x ] -> (x, lvl)
|
||||
@ -891,7 +1030,7 @@ and binary p lvl : Form.t * int =
|
||||
"%s is an operator here, and a binary operator has a space on each \
|
||||
side: a %s b. Without them a-b is one name"
|
||||
s s;
|
||||
let rhs, _ = binary p (lvl + 1) in
|
||||
let rhs, _ = operand p lvl in
|
||||
(ot, rhs)
|
||||
in
|
||||
let rec run op operands =
|
||||
@ -943,6 +1082,31 @@ and binary p lvl : Form.t * int =
|
||||
| NAME s when binary_here s -> run s [ first ]
|
||||
| _ -> fst_
|
||||
|
||||
(* An operand of level [lvl]'s operators. [??] sits between the comparisons
|
||||
(4) and the bit operators (5), Swift's place for it: [a ?? b == c] is
|
||||
[(a ?? b) == c] and [a ?? b + 1] is [a ?? (b + 1)]. A chain is one
|
||||
variadic form, [(?? a b c)], which the checker reads from the right. *)
|
||||
and operand p lvl =
|
||||
if lvl <> 4 then binary p (lvl + 1)
|
||||
else
|
||||
let l0 = (peek p).loc in
|
||||
let ((first, _) as fp) = binary p 5 in
|
||||
let rec more acc =
|
||||
match (peek p).tok with
|
||||
| NAME "??" when not ((peek_at p 1).tok = LP && not (peek_at p 1).sp) ->
|
||||
let ot = advance p in
|
||||
if not (ot.sp && (peek p).sp) then
|
||||
failk "unspaced-operator" ot.loc
|
||||
"?? is an operator here, and a binary operator has a space on each \
|
||||
side: a ?? b";
|
||||
let rhs, _ = binary p 5 in
|
||||
more (rhs :: acc)
|
||||
| _ -> List.rev acc
|
||||
in
|
||||
match more [] with
|
||||
| [] -> fp
|
||||
| rest -> (mk p l0 (Form.List (sym l0 "??" :: first :: rest)), 4)
|
||||
|
||||
and not_ p =
|
||||
let t = peek p in
|
||||
match t.tok with
|
||||
@ -987,6 +1151,33 @@ and postfix p =
|
||||
ignore (advance p);
|
||||
let m = map_items p t.loc in
|
||||
loop (mk p l0 (Form.List [ f; Form.make (Form.Map m) (span p t.loc) ]), 12)
|
||||
(* [a?.b.c(x)] and [a?[i]]: the rest of the chain is read over a fresh
|
||||
name, [~o1], bound to what [a] holds — [(?. [~o1 a] (.c ...))]. No
|
||||
reader can produce a [~] name, so it shadows nothing. A [?.] later
|
||||
in the rest nests, and the checker flattens it. *)
|
||||
| QUEST
|
||||
when (let n = peek_at p 1 in
|
||||
(not n.sp)
|
||||
&& (match n.tok with
|
||||
| NAME s -> String.length s > 1 && s.[0] = '.'
|
||||
| LB -> true
|
||||
| _ -> false)) ->
|
||||
ignore (advance p);
|
||||
incr opt_n;
|
||||
let h = Printf.sprintf "~o%d" !opt_n in
|
||||
let rest, _ = loop (sym t.loc h, 12) in
|
||||
(mk p l0
|
||||
(Form.List
|
||||
[ sym t.loc "?.";
|
||||
Form.make (Form.Vec [ sym t.loc h; f ]) f.loc;
|
||||
rest ]), 12)
|
||||
(* [T?]: the lexer lets a [?] end only a type's name or a closer. *)
|
||||
| QUEST ->
|
||||
ignore (advance p);
|
||||
loop (mk p l0 (Form.List [ sym l0 "Option"; f ]), 12)
|
||||
| BANG ->
|
||||
ignore (advance p);
|
||||
loop (mk p l0 (Form.List [ sym t.loc "!!"; f ]), 12)
|
||||
| _ -> fp
|
||||
in
|
||||
loop (primary p)
|
||||
@ -2787,14 +2978,15 @@ let read_all ?(line = 1) ?col ?indent ?(global_let = true) ~file src =
|
||||
let snippet = col <> None in
|
||||
let col = Option.value col ~default:1 in
|
||||
let saved = !source in
|
||||
let saved_n = !cmp_n in
|
||||
let saved_n = !cmp_n and saved_o = !opt_n in
|
||||
cmp_n := 0;
|
||||
opt_n := 0;
|
||||
(* The quoted text is indexed by the buffer's lines, so a snippet that
|
||||
starts on line 40 is padded to start there. *)
|
||||
source :=
|
||||
(file, Array.of_list (String.split_on_char '\n'
|
||||
(String.make (line - 1) '\n' ^ String.make (col - 1) ' ' ^ src)));
|
||||
Fun.protect ~finally:(fun () -> source := saved; cmp_n := saved_n) (fun () ->
|
||||
Fun.protect ~finally:(fun () -> source := saved; cmp_n := saved_n; opt_n := saved_o) (fun () ->
|
||||
let toks = layout ~snippet ~base:col ?indent (lex ~line ~col ~file src) in
|
||||
let s = { p = { toks; i = 0; closed = -1 }; lets = [] } in
|
||||
(* At the top level, a [let] is a global, [(def x dyn v)]: a let there has
|
||||
|
||||
10
lib/load.ml
10
lib/load.ml
@ -280,13 +280,20 @@ let rec rename_expr owned alias bound (e : Ast.expr) : Ast.expr =
|
||||
{ a with Ast.body = List.map (rename_expr owned alias bound)
|
||||
a.Ast.body }) arms)
|
||||
| Ast.IfLet (sc, a, e') ->
|
||||
(* A plain name, [if let g = x], binds [g] as [Some g] would. *)
|
||||
let inner =
|
||||
match a.Ast.pat with Ast.Pctor (_, ns) -> ns @ bound | _ -> bound
|
||||
match a.Ast.pat with
|
||||
| Ast.Pctor (n, []) when n <> "" && Char.lowercase_ascii n.[0] = n.[0]
|
||||
&& not (String.contains n '.') -> n :: bound
|
||||
| Ast.Pctor (_, ns) -> ns @ bound
|
||||
| _ -> bound
|
||||
in
|
||||
Ast.IfLet (go sc,
|
||||
{ a with Ast.body = List.map (rename_expr owned alias inner)
|
||||
a.Ast.body },
|
||||
Option.map go e')
|
||||
| Ast.Chain (n, v, b) ->
|
||||
Ast.Chain (n, go v, rename_expr owned alias (n :: bound) b)
|
||||
(* A quoted symbol naming something the package declares.
|
||||
[(Form.Sym {.s "Cursor"})] is what a quasiquote desugars to, and it is
|
||||
the one place a package's name survives into a *string* — which is
|
||||
@ -849,6 +856,7 @@ let rec expr_uses acc (e : Ast.expr) =
|
||||
| Ast.Match (sc, arms) ->
|
||||
go sc; List.iter (fun (a : Ast.arm) -> gos a.Ast.body) arms
|
||||
| Ast.IfLet (sc, a, e') -> go sc; gos a.Ast.body; Option.iter go e'
|
||||
| Ast.Chain (_, v, b) -> go v; go b
|
||||
| Ast.Struct (n, kvs) ->
|
||||
acc := (n, e.Ast.loc) :: !acc;
|
||||
List.iter (fun (_, v) -> go v) kvs
|
||||
|
||||
@ -501,6 +501,12 @@ and form f mk (head : Form.t) (args : Form.t list) : Ast.expr =
|
||||
fail f "if-let is (if-let [pattern value] then) or \
|
||||
(if-let [pattern value] then else)")
|
||||
|
||||
| Sym "?." ->
|
||||
(match args with
|
||||
| [ { v = Vec [ { v = Sym n; _ }; v ]; _ }; body ] ->
|
||||
mk (Ast.Chain (n, expr v, expr body))
|
||||
| _ -> fail f "?. is (?. [name value] body)")
|
||||
|
||||
(* Short-circuiting, so they cannot be ordinary calls. *)
|
||||
| Sym "and" -> shortcircuit f args ~is_and:true
|
||||
| Sym "or" -> shortcircuit f args ~is_and:false
|
||||
|
||||
@ -430,12 +430,12 @@ let source = {flan|
|
||||
(set i (+ i 1)))))
|
||||
|
||||
;; The same insertion sort, with the one comparison it had written in replaced
|
||||
;; by the one it is told. before? answers "does a come before b", so passing
|
||||
;; by the one it is told. is-before answers "does a come before b", so passing
|
||||
;; (fn [a b] (< a b)) is ascending and reversing it is descending — and a
|
||||
;; caller wanting a key rather than an order writes the comparison.
|
||||
;;
|
||||
;; It is stable exactly as sort is: the loop stops the moment before? says
|
||||
;; no, so equal elements never swap past each other. A before? that is not a
|
||||
;; It is stable exactly as sort is: the loop stops the moment is-before says
|
||||
;; no, so equal elements never swap past each other. A is-before that is not a
|
||||
;; strict weak ordering — one answering true for both (a b) and (b a) — is the
|
||||
;; caller's mistake and shows up as an order, not as a loop: the inner while
|
||||
;; is bounded by j reaching 0 whatever the comparison says.
|
||||
@ -444,11 +444,11 @@ let source = {flan|
|
||||
;; comparison it is given. It is the shape every generic had to take before
|
||||
;; predicates existed, and it stays because passing a comparison is a real
|
||||
;; thing to want and not only a workaround.
|
||||
(defn sort-by [s [$t] before? (Fn [$t $t] bool)] ()
|
||||
(defn sort-by [s [$t] is-before (Fn [$t $t] bool)] ()
|
||||
(let [i 1]
|
||||
(while (< i (length s))
|
||||
(let [j i]
|
||||
(while (and (> j 0) (before? (at s j) (at s (- j 1))))
|
||||
(while (and (> j 0) (is-before (at s j) (at s (- j 1))))
|
||||
(swap s (- j 1) j)
|
||||
(set j (- j 1))))
|
||||
(set i (+ i 1)))))
|
||||
@ -579,10 +579,10 @@ let source = {flan|
|
||||
;; allocates — (vec-new $t), push, returns (Vec $t) — and the type-erased Vec
|
||||
;; runtime needed no change at all, because SizeOf and AlignOf are computed at
|
||||
;; the instantiation site, where the element type is concrete.
|
||||
(defn filter [s [const $t] keep? (Fn [$t] bool)] (Vec $t)
|
||||
(defn filter [s [const $t] is-keep (Fn [$t] bool)] (Vec $t)
|
||||
(let [v (vec-new $t)]
|
||||
(dotimes [i (length s)]
|
||||
(when (keep? (at s i))
|
||||
(when (is-keep (at s i))
|
||||
(push v (at s i))))
|
||||
v))
|
||||
|
||||
@ -2375,7 +2375,7 @@ let source = {flan|
|
||||
|
||||
;; ── into: a fused transformation, and not a transducer ────────────────
|
||||
;;
|
||||
;; (into xs (vec-new i32) (map double) (filter even?))
|
||||
;; (into xs (vec-new i32) (map double) (filter is-even))
|
||||
;;
|
||||
;; Source, destination, then any number of transforms. It reads as a sentence
|
||||
;; — take this, put it there, doing these — and the variadic tail has to trail
|
||||
|
||||
@ -2462,6 +2462,15 @@ _Noreturn void flan_free_all_fail(const uint8_t *loc, int64_t loclen) {
|
||||
rt_trap((const uint8_t *)"NoFreeAll", 9);
|
||||
}
|
||||
|
||||
/* [x!] over an Option that is None, or a dyn that is nil. The checker writes
|
||||
* the sentence, since it has the expression's text and knows which absence
|
||||
* it is; this prints it at the site and stops. */
|
||||
_Noreturn void flan_unwrap_fail(const uint8_t *loc, int64_t loclen,
|
||||
const uint8_t *what, int64_t whatlen) {
|
||||
flan_say(loc, loclen, "%.*s", (int)whatlen, (const char *)what);
|
||||
rt_trap((const uint8_t *)"Unwrap", 6);
|
||||
}
|
||||
|
||||
/* ── The region requirement, spec-memory.md's arena rule ───────────────
|
||||
*
|
||||
* A container whose elements themselves own storage — a `(Vec Value)` where a
|
||||
|
||||
10
sand.flan
10
sand.flan
@ -55,12 +55,12 @@
|
||||
(set (at velocity y col) vel)
|
||||
(set (at velocity row col) 0.0)
|
||||
(return))
|
||||
(let [left? (and (> col 0) (= 0 (at grid y (- col 1))))
|
||||
right? (and (< col (- cols 1)) (= 0 (at grid y (+ col 1))))]
|
||||
(when (or left? right?)
|
||||
(let [is-left (and (> col 0) (= 0 (at grid y (- col 1))))
|
||||
is-right (and (< col (- cols 1)) (= 0 (at grid y (+ col 1))))]
|
||||
(when (or is-left is-right)
|
||||
(let [side (cond
|
||||
(not left?) 1
|
||||
(not right?) -1
|
||||
(not is-left) 1
|
||||
(not is-right) -1
|
||||
:else (if (< (f32 (rand)) 0.5) 1 -1))]
|
||||
(set (at grid y (+ col side)) (at grid row col))
|
||||
(set (at grid row col) 0)
|
||||
|
||||
@ -133,6 +133,11 @@ Each item: the proposal, then the reason in one line.
|
||||
rename). `a - b` is subtraction. `a -1` is an error: "separate with a comma or
|
||||
space the minus". **Built.**
|
||||
- **`->` needs spaces as the return arrow.** `dyn->f64` stays a name. **Built.**
|
||||
- **A name carries no `?` or `!`** (decision 130). A name that asks a question
|
||||
starts with `is-` or `has-`: `is-empty`, `has-key`, `rl/is-key-pressed`. A
|
||||
`?` or `!` inside a name, or ending one where no type or chain can follow,
|
||||
is refused with the `is-` form as the fix. `?` and `!` are the marks of the
|
||||
optionals below. **Built.**
|
||||
- **Character literals stay `\c`**, lexed before brackets and operators:
|
||||
`\(`, `\,`, `\space`. 277 uses, many of them delimiters of the new syntax.
|
||||
**Built.**
|
||||
@ -159,8 +164,8 @@ Each item: the proposal, then the reason in one line.
|
||||
### Expressions
|
||||
|
||||
- **Precedence**, low to high: `or` < `and` < `not` < comparisons
|
||||
(`== != < <= > >=`) < `||` < `^^` < `&&` < `<< >>` < `+ -` < `* / %` <
|
||||
prefix `-` and `~~` < postfix (call, index, field). **Built.** An operator
|
||||
(`== != < <= > >=`) < `??` < `||` < `^^` < `&&` < `<< >>` < `+ -` < `* / %` <
|
||||
prefix `-` and `~~` < postfix (call, index, field, `!`, `?.`). **Built.** An operator
|
||||
glued to `(` is always a call. The bit operators sit where Python and Rust
|
||||
put them, so `x && mask == 0` is `(x && mask) == 0`.
|
||||
- **The bit operators** are `a && b`, `a || b`, `a ^^ b` and `~~a`, reading
|
||||
@ -200,6 +205,18 @@ Each item: the proposal, then the reason in one line.
|
||||
- **`and`, `or`, `not` are words**, since they are Flan's own names. **Built.**
|
||||
`not` is a prefix word: `not a == b` is `not (a == b)`, `not a and b` is
|
||||
`(not a) and b`, and `not(x)`, glued, is the call.
|
||||
- **Optionals, after Swift** (decision 130). **Built.**
|
||||
- `x ?? d` reads `(?? x d)`: what `x` holds, or `d` when `x` is `None`
|
||||
(`nil` over a dyn). `d` is evaluated only then. `a ?? b ?? c` reads
|
||||
`(?? a b c)` and groups from the right; a default that is itself an
|
||||
Option keeps the whole an Option. `a ?? b == c` is `(a ?? b) == c`.
|
||||
- `x!` reads `(!! x)`: what `x` holds, and a trap at that site naming `x`
|
||||
when it holds nothing.
|
||||
- `a?.b` reads `(?. [~o1 a] (.b ~o1))`: `None` (or `nil`) when `a` holds
|
||||
nothing, otherwise `Some` of the rest of the postfix chain over what it
|
||||
holds — `a?.f(x)`, `a?[i]`, `a?.b.c`. A result that is already an Option
|
||||
is not wrapped again, so `a?.b?.c` is one Option. A rest with no value
|
||||
makes the whole a statement. `~o1` is a fresh name no reader produces.
|
||||
- **Casts and type-taking builtins are calls:** `i32(x)`, `vec-new(u8)`,
|
||||
`max-value(u8)`, `the([3 f32], [1 2 3.5])`. A pointer cast is the type
|
||||
called: `Ptr(Color)(p)` reads `((Ptr Color) p)`. **Built.**
|
||||
@ -269,8 +286,10 @@ Each item: the proposal, then the reason in one line.
|
||||
`elif let P = v` is a further `if-let` nested in that else.
|
||||
Kept with no `else` at the end of its chain, it gives an Option as `when` does.
|
||||
`P` is any `match` pattern, and its names are bound in the block only. One
|
||||
line: `if let Some(g) = o then g else 0`. A pattern that cannot fail, a
|
||||
plain name or `_`, is refused toward `let`. **Built.**
|
||||
line: `if let Some(g) = o then g else 0`. A plain name, `if let g = o`,
|
||||
binds what an Option holds (`if let Some(g) = o`), or a dyn when it is not
|
||||
`nil`; over any other type, and for `_`, it cannot fail and is refused
|
||||
toward `let`. **Built.**
|
||||
- **`while c`, `until c`**, optional label first: `while :outer c`. **Built.**
|
||||
- **`for i in range(n)`**, `range(a, b)`, `range(a, b, step)` read as
|
||||
`dotimes`. `range` here is syntax, not a function. `..` is avoided because
|
||||
@ -417,7 +436,8 @@ piece at a time. **Built**; a header word glued to `(` is always this call,
|
||||
After `:` and `->`, a small type grammar that reads to today's type forms:
|
||||
`i32`, `$t`, `()`, `[T]`, `[const T]`, `[n T]`, `Vec(T)`, `Map(K, V)`,
|
||||
`Option(T)`, `Ptr(T)`, `Ptr(const T)`, `Fn(A, B) -> R`, `CFn(A) -> R`,
|
||||
`rl/Vector2`. **Built** (the arrow is read only in a type position; inside a
|
||||
`rl/Vector2`. `T?` is `Option(T)` anywhere a type is written: `[i32?]`,
|
||||
`Vec(Shape?)`, `Option(i32)?`. **Built** (the arrow is read only in a type position; inside a
|
||||
value, `vec-new(Fn([i32], i32))` is the call spelling).
|
||||
|
||||
### Macro templates
|
||||
|
||||
@ -4,7 +4,7 @@
|
||||
{:name "goblin"
|
||||
:hp 12
|
||||
:speed 1.5
|
||||
:boss? false
|
||||
:is-boss false
|
||||
:drops [3 1 4 1 5]
|
||||
:hitbox {:w 16
|
||||
:h 24
|
||||
|
||||
@ -34,7 +34,7 @@
|
||||
;; to (a bare 0 is an i32 until something wants it as dyn).
|
||||
(defn box [x] dyn x)
|
||||
|
||||
(defn truthy? [x] dyn (if x "truthy" "falsey"))
|
||||
(defn is-truthy [x] dyn (if x "truthy" "falsey"))
|
||||
|
||||
;; Prints its tag, then answers its value unchanged. An operand written this
|
||||
;; way leaves a mark when it is evaluated, which is how the short-circuit
|
||||
@ -45,21 +45,21 @@
|
||||
;; nil and false: the only two falsey dyn values. Everything else Clojure
|
||||
;; calls truthy that C or Python would not: 0, "", an empty vec, an empty
|
||||
;; map, a keyword.
|
||||
(println (truthy? nil))
|
||||
(println (truthy? false))
|
||||
(println (truthy? true))
|
||||
(println (truthy? 0))
|
||||
(println (truthy? 7))
|
||||
(println (truthy? ""))
|
||||
(println (truthy? "x"))
|
||||
(println (truthy? (vec-new dyn)))
|
||||
(println (is-truthy nil))
|
||||
(println (is-truthy false))
|
||||
(println (is-truthy true))
|
||||
(println (is-truthy 0))
|
||||
(println (is-truthy 7))
|
||||
(println (is-truthy ""))
|
||||
(println (is-truthy "x"))
|
||||
(println (is-truthy (vec-new dyn)))
|
||||
(let [xs (vec-new dyn)]
|
||||
(push xs 1)
|
||||
(println (truthy? xs)))
|
||||
(println (is-truthy xs)))
|
||||
(let [m {}]
|
||||
(println (truthy? m)))
|
||||
(println (truthy? {:a 1}))
|
||||
(println (truthy? :kw))
|
||||
(println (is-truthy m)))
|
||||
(println (is-truthy {:a 1}))
|
||||
(println (is-truthy :kw))
|
||||
|
||||
;; when: sugar for a one-armed if, so nil/false skip the body and every
|
||||
;; other dyn value -- 0 and "" included -- runs it.
|
||||
|
||||
@ -46,7 +46,7 @@
|
||||
(println (.name t))
|
||||
(println (.hp t))
|
||||
(println (.speed t))
|
||||
(println (if (.boss? t) "yes" "no"))
|
||||
(println (if (.is-boss t) "yes" "no"))
|
||||
(println (length (.drops t)))
|
||||
;; 3 + 1 + 4 + 1 + 5. A vector read that stopped at the first element would
|
||||
;; still have a plausible length from a zeroed Vec, so the sum is the claim.
|
||||
@ -63,16 +63,16 @@
|
||||
|
||||
;; ── Drift ───────────────────────────────────────────────────────────
|
||||
;;
|
||||
;; The struct says :name :hp :speed :boss? :drops :hitbox. These bytes have no
|
||||
;; The struct says :name :hp :speed :is-boss :drops :hitbox. These bytes have no
|
||||
;; :speed and have a :level the struct has never heard of, which is what a
|
||||
;; tuning file looks like a month after the program was built.
|
||||
(defconst drifted str
|
||||
"{:name \"imp\" :hp 3 :level 7 :boss? true :drops [1] :hitbox {:w 1 :h 1 :offset {:x 0 :y 0}}}")
|
||||
"{:name \"imp\" :hp 3 :level 7 :is-boss true :drops [1] :hitbox {:w 1 :h 1 :offset {:x 0 :y 0}}}")
|
||||
|
||||
(defn show-drift [a Allocator] ()
|
||||
(handler-bind
|
||||
[(edn/SchemaDrift [d]
|
||||
(do (print (if (.extra? d) "extra " "missing "))
|
||||
(do (print (if (.is-extra d) "extra " "missing "))
|
||||
(print (.field d))
|
||||
(print " in ")
|
||||
(println (.struct d))))]
|
||||
|
||||
@ -30,7 +30,7 @@
|
||||
;;;; What dyn cannot say and the old (Option Value) could: `read` answers nil
|
||||
;;;; both for malformed input and for the document `nil`. The distinction did
|
||||
;;;; not vanish — it moved to the cursor, where the error position has always
|
||||
;;;; lived, and `malformed?` below is the three lines it costs.
|
||||
;;;; lived, and `is-malformed` below is the three lines it costs.
|
||||
|
||||
(import edn "vendor:edn")
|
||||
|
||||
@ -59,7 +59,7 @@
|
||||
|
||||
;; Malformed input, told apart from the document `nil` by the cursor — the
|
||||
;; return value alone cannot say it, and this is the spelling that can.
|
||||
(defn malformed? [src str] bool
|
||||
(defn is-malformed [src str] bool
|
||||
(let [c (edn/cursor (bytes-view src))
|
||||
t (edn/next (addr c))
|
||||
v (edn/read-value (addr c) t)] ; the value is not the question here
|
||||
@ -141,8 +141,8 @@
|
||||
|
||||
(survives-its-buffer)
|
||||
;; And the refusal, told apart from the document that is literally nil.
|
||||
(println (malformed? "#{1 2"))
|
||||
(println (malformed? "nil"))
|
||||
(println (is-malformed "#{1 2"))
|
||||
(println (is-malformed "nil"))
|
||||
(println "")
|
||||
|
||||
(by-path)
|
||||
|
||||
@ -77,7 +77,7 @@
|
||||
[name [const u8]
|
||||
hp i32
|
||||
speed f32
|
||||
boss? bool])
|
||||
is-boss bool])
|
||||
|
||||
;; The shape the compiler-emitted version will have: open the map, loop on the
|
||||
;; keys, dispatch each known one onto its field, and skip whatever is left over
|
||||
@ -85,7 +85,7 @@
|
||||
;; rather than being returned, which is why this can be a straight line of
|
||||
;; assignments with one test at the end.
|
||||
(defn read-enemy [c (Ptr edn/Cursor)] Enemy
|
||||
(let [e (Enemy {.hp 0 .speed 0.0 .boss? false})]
|
||||
(let [e (Enemy {.hp 0 .speed 0.0 .is-boss false})]
|
||||
(edn/expect c edn/tok-map-open)
|
||||
(while (edn/is-ok c)
|
||||
(let [k (edn/next c)]
|
||||
@ -111,8 +111,8 @@
|
||||
(Some x) (set (.speed e) (f32 x))
|
||||
None (edn/fail c edn/err-unexpected-token (.pos v))))
|
||||
|
||||
(edn/is-keyword-equal k "boss?")
|
||||
(set (.boss? e) (match (edn/bool-of (edn/expect c edn/tok-bool))
|
||||
(edn/is-keyword-equal k "is-boss")
|
||||
(set (.is-boss e) (match (edn/bool-of (edn/expect c edn/tok-bool))
|
||||
(Some v) v None false))
|
||||
|
||||
;; An unknown key: read past its value, however big it is.
|
||||
@ -134,7 +134,7 @@
|
||||
(print " speed=")
|
||||
(print (.speed e))
|
||||
(print " boss=")
|
||||
(print (if (.boss? e) "yes" "no")))
|
||||
(print (if (.is-boss e) "yes" "no")))
|
||||
(do
|
||||
(print "ERR@")
|
||||
(print (edn/error-pos (addr c)))
|
||||
@ -243,10 +243,10 @@
|
||||
(println "")
|
||||
|
||||
;; ── The struct reader ─────────────────────────────────────────────
|
||||
(show-enemy "{:name \"goblin\" :hp 12 :speed 1.5 :boss? false}")
|
||||
(show-enemy "{:name \"goblin\" :hp 12 :speed 1.5 :is-boss false}")
|
||||
;; Fields in a different order, one missing (zeroed), one unknown key whose
|
||||
;; value is a whole nested collection that skip-value has to walk past.
|
||||
(show-enemy "{:boss? true :loot [:gold {:n 3} [[]]] :hp 40 :name \"dragon\"}")
|
||||
(show-enemy "{:is-boss true :loot [:gold {:n 3} [[]]] :hp 40 :name \"dragon\"}")
|
||||
;; An unknown key whose value is a set, which skip-value has to walk past on
|
||||
;; the balance stack like any other collection — and a set nested in it, so
|
||||
;; that a `#{` pushing nothing would leave the map open and swallow :hp.
|
||||
|
||||
@ -8,18 +8,18 @@
|
||||
|
||||
(defstruct S [k K])
|
||||
|
||||
(defn eq? [k K] bool (= k :mid))
|
||||
(defn below? [k K] bool (< k :mid))
|
||||
(defn is-eq [k K] bool (= k :mid))
|
||||
(defn is-below [k K] bool (< k :mid))
|
||||
|
||||
(defn main [] i32
|
||||
;; Equality, both ways round.
|
||||
(println (if (eq? :mid) "eq yes" "eq no"))
|
||||
(println (if (eq? :hi) "eq yes" "eq no"))
|
||||
(println (if (is-eq :mid) "eq yes" "eq no"))
|
||||
(println (if (is-eq :hi) "eq yes" "eq no"))
|
||||
|
||||
;; Ordering, and signed: lo is -1, so an unsigned compare would call it the
|
||||
;; largest member and answer the other way.
|
||||
(println (if (below? :lo) "lo below mid" "lo not below mid"))
|
||||
(println (if (below? :hi) "hi below mid" "hi not below mid"))
|
||||
(println (if (is-below :lo) "lo below mid" "lo not below mid"))
|
||||
(println (if (is-below :hi) "hi below mid" "hi not below mid"))
|
||||
|
||||
;; And through a struct field, which is a different path to the same compare.
|
||||
(let [s (S {.k :hi})]
|
||||
|
||||
@ -9,11 +9,11 @@
|
||||
{:where (is-enum $t)}
|
||||
(i32 x))
|
||||
|
||||
(defn later? [a $t b $t] bool
|
||||
(defn is-later [a $t b $t] bool
|
||||
{:where (is-enum $t)}
|
||||
(> a b))
|
||||
|
||||
(defn same? [a $t b $t] bool
|
||||
(defn is-same [a $t b $t] bool
|
||||
{:where (is-enum $t)}
|
||||
(and (= a b) (<= a b)))
|
||||
|
||||
@ -22,7 +22,7 @@
|
||||
s (Size 20)]
|
||||
(println (code c)) ; 2
|
||||
(println (code s)) ; 20
|
||||
(println (later? c (Color 0))) ; true
|
||||
(println (same? (Color 1) (Color 1))) ; true
|
||||
(println (is-later c (Color 0))) ; true
|
||||
(println (is-same (Color 1) (Color 1))) ; true
|
||||
(println (f64 (code s)))) ; 20
|
||||
0)
|
||||
|
||||
@ -30,10 +30,10 @@
|
||||
;; A comparator, which is the other half of what was blocked: a sort that is
|
||||
;; told the order rather than having it written in. Insertion sort, because the
|
||||
;; point here is the parameter and not the algorithm.
|
||||
(defn insertion-by [xs [i32] before? (Fn [i32 i32] bool)] ()
|
||||
(defn insertion-by [xs [i32] is-before (Fn [i32 i32] bool)] ()
|
||||
(dotimes [i (length xs)]
|
||||
(let [j i]
|
||||
(while (and (> j 0) (before? (at xs j) (at xs (- j 1))))
|
||||
(while (and (> j 0) (is-before (at xs j) (at xs (- j 1))))
|
||||
(swap xs j (- j 1))
|
||||
(set j (- j 1))))))
|
||||
|
||||
|
||||
@ -13,7 +13,7 @@
|
||||
;;;; author wrote down, at the call that asked for it. A float is that type:
|
||||
;;;; NaN is not equal to itself, and 0.0 and -0.0 are equal while differing
|
||||
;;;; bytewise.
|
||||
(defn seen? [k $t] bool
|
||||
(defn is-seen [k $t] bool
|
||||
{:where (is-hashable $t)}
|
||||
(let [m (map-new t i32)]
|
||||
(put m k 1)
|
||||
@ -22,5 +22,5 @@
|
||||
answer)))
|
||||
|
||||
(defn main [] ()
|
||||
(println (seen? 3))
|
||||
(println (seen? 1.5)))
|
||||
(println (is-seen 3))
|
||||
(println (is-seen 1.5)))
|
||||
|
||||
@ -67,9 +67,9 @@
|
||||
;; The -t? suffix is because the prelude now carries pos?/neg?/is-zero itself.
|
||||
;; These are the same three bodies written in an ordinary program, which is
|
||||
;; what says the machinery belongs to the language and not to the prelude.
|
||||
(defn pos-t? [x $t] bool {:where (is-numeric $t)} (> x 0))
|
||||
(defn neg-t? [x $t] bool {:where (is-numeric $t)} (< x 0))
|
||||
(defn zero-t? [x $t] bool {:where (is-numeric $t)} (= x 0))
|
||||
(defn is-pos-t [x $t] bool {:where (is-numeric $t)} (> x 0))
|
||||
(defn is-neg-t [x $t] bool {:where (is-numeric $t)} (< x 0))
|
||||
(defn is-zero-t [x $t] bool {:where (is-numeric $t)} (= x 0))
|
||||
|
||||
;; The same literal in arithmetic rather than comparison, and answering $t
|
||||
;; rather than bool, so the placeholder has to survive being the operand of a
|
||||
@ -165,12 +165,12 @@
|
||||
;; The literal-at-a-type-variable family, at six numeric types from three
|
||||
;; written bodies. i32, i64, u8, u16, f32 and f64 all reach the same 0 and
|
||||
;; the same 1.
|
||||
(println (pos-t? 3))
|
||||
(println (neg-t? (i8 -3)))
|
||||
(println (zero-t? (u8 0)))
|
||||
(println (zero-t? 0.0))
|
||||
(println (pos-t? (u16 1)))
|
||||
(println (neg-t? (f32 -0.5)))
|
||||
(println (is-pos-t 3))
|
||||
(println (is-neg-t (i8 -3)))
|
||||
(println (is-zero-t (u8 0)))
|
||||
(println (is-zero-t 0.0))
|
||||
(println (is-pos-t (u16 1)))
|
||||
(println (is-neg-t (f32 -0.5)))
|
||||
(println (next-after 3))
|
||||
(println (next-after (i64 10)))
|
||||
(println (next-after 2.5))
|
||||
|
||||
@ -5,11 +5,11 @@
|
||||
;; name or written inline.
|
||||
|
||||
(defn triple [x i32] i32 (* x 3))
|
||||
(defn odd? [x i32] bool (= (% x 2) 1))
|
||||
(defn is-odd [x i32] bool (= (% x 2) 1))
|
||||
(defn adds [a i32 b i32] i32 (+ a b))
|
||||
(defn longer-first [a i32 b i32] bool (> a b))
|
||||
(defn halve [x f32] f32 (/ x 2.0))
|
||||
(defn big? [x f32] bool (> x 1.0))
|
||||
(defn is-big [x f32] bool (> x 1.0))
|
||||
|
||||
(defn main [] i32
|
||||
;; map-in-place writes back into the slice it was handed.
|
||||
@ -25,7 +25,7 @@
|
||||
(print (reduce s 1 (fn [a b] (* a b)))) (println "")
|
||||
|
||||
;; filter allocates and the caller frees.
|
||||
(let [v (filter s odd?)]
|
||||
(let [v (filter s is-odd)]
|
||||
(print (length v)) (print " ") (print (at v 0)) (println "")
|
||||
(free v))
|
||||
|
||||
@ -42,7 +42,7 @@
|
||||
(map-in-place t halve)
|
||||
(print (at t 0)) (print " ") (print (at t 2)) (println "")
|
||||
(print (reduce t 0.0 (fn [a b] (+ a b)))) (println "")
|
||||
(let [w (filter t big?)]
|
||||
(let [w (filter t is-big)]
|
||||
(print (length w)) (println "")
|
||||
(free w))
|
||||
(sort-by t (fn [a b] (> a b)))
|
||||
|
||||
@ -22,7 +22,7 @@
|
||||
(bit-and x (- (<< 1 n) 1)))
|
||||
|
||||
;; Truncated %, the semantics everywhere in the language, in a generic body.
|
||||
(defn even? [x $t] bool
|
||||
(defn is-even [x $t] bool
|
||||
{:where (is-integer $t)}
|
||||
(= (% x 2) 0))
|
||||
|
||||
@ -45,8 +45,8 @@
|
||||
{:where (is-integer $t)}
|
||||
(+ x 300))
|
||||
|
||||
;; The join family. eq2? is the pair the refusal used to be pinned on.
|
||||
(defn eq2? [a $t b $t] bool
|
||||
;; The join family. is-eq2 is the pair the refusal used to be pinned on.
|
||||
(defn is-eq2 [a $t b $t] bool
|
||||
{:where (is-equal $t)}
|
||||
(= a b))
|
||||
|
||||
@ -115,9 +115,9 @@
|
||||
(println (low-bits 255 3))
|
||||
(println (low-bits (u16 65535) (u16 4)))
|
||||
(println (low-bits (i64 1023) (i64 5)))
|
||||
(println (even? 4))
|
||||
(println (even? (u8 3)))
|
||||
(println (even? (i64 -2)))
|
||||
(println (is-even 4))
|
||||
(println (is-even (u8 3)))
|
||||
(println (is-even (i64 -2)))
|
||||
(println (toggle (u8 255) (u8 15)))
|
||||
(println (with-flag 8 1))
|
||||
(println (halve (u64 10)))
|
||||
@ -128,8 +128,8 @@
|
||||
;; The join: both orders, one copy, one answer.
|
||||
(let [a (i8 3)
|
||||
b (i64 3)]
|
||||
(println (eq2? a b))
|
||||
(println (eq2? b a)))
|
||||
(println (is-eq2 a b))
|
||||
(println (is-eq2 b a)))
|
||||
(let [x (u32 1)
|
||||
y (i32 2)
|
||||
z (i64 3)]
|
||||
|
||||
@ -4,7 +4,7 @@
|
||||
;;;; comes out is one loop, and the values it produces are the ones the chain
|
||||
;;;; describes in the order it was written.
|
||||
;;;;
|
||||
;;;; 1. The order of the transforms is the order of the stages. (filter even?)
|
||||
;;;; 1. The order of the transforms is the order of the stages. (filter is-even)
|
||||
;;;; before (map double) is not the same program as after it, and both are
|
||||
;;;; here with different answers.
|
||||
;;;; 2. There is no intermediate collection. `pulls` counts every call to the
|
||||
@ -21,7 +21,7 @@
|
||||
(set pulls (+ pulls 1))
|
||||
(* x 2))
|
||||
|
||||
(defn even? [x i32] bool
|
||||
(defn is-even [x i32] bool
|
||||
(set pulls (+ pulls 1))
|
||||
(= (% x 2) 0))
|
||||
|
||||
@ -36,7 +36,7 @@
|
||||
(slice xs 0 (length xs)))
|
||||
|
||||
(defn wide [x i32] f32 (f32 x))
|
||||
(defn bigf? [x f32] bool (> x 2.5))
|
||||
(defn is-bigf [x f32] bool (> x 2.5))
|
||||
|
||||
(defn show [v [i32]] ()
|
||||
(dotimes [i (length v)] (print (at v i)) (print " "))
|
||||
@ -51,14 +51,14 @@
|
||||
|
||||
;; map then filter.
|
||||
(let [xs [1 2 3 4 5 6]
|
||||
v (into xs (vec-new i32) (map double) (filter even?))]
|
||||
v (into xs (vec-new i32) (map double) (filter is-even))]
|
||||
(show (slice v)) ; 2 4 6 8 10 12
|
||||
(free v))
|
||||
|
||||
;; filter then map, over the same source: a different answer, because the
|
||||
;; stages are in the order they were written.
|
||||
(let [xs [1 2 3 4 5 6]
|
||||
v (into xs (vec-new i32) (filter even?) (map double))]
|
||||
v (into xs (vec-new i32) (filter is-even) (map double))]
|
||||
(show (slice v)) ; 4 8 12
|
||||
(free v))
|
||||
|
||||
@ -79,7 +79,7 @@
|
||||
;; shadowed — a let binding's value is checked before its name is bound, so
|
||||
;; each stage reads the stage before it.
|
||||
(let [xs [1 2 3 4]
|
||||
v (into xs (vec-new f32) (map wide) (filter bigf?))]
|
||||
v (into xs (vec-new f32) (map wide) (filter is-bigf))]
|
||||
(dotimes [i (length v)] (print (at v i)) (print " "))
|
||||
(println "") ; 3 4
|
||||
(free v))
|
||||
@ -87,7 +87,7 @@
|
||||
;; A source that is a call is bound once, so it is made once however many
|
||||
;; elements come out of it.
|
||||
(let [xs [1 2 3 4]
|
||||
v (into (source (slice xs 0 4)) (vec-new i32) (filter even?))]
|
||||
v (into (source (slice xs 0 4)) (vec-new i32) (filter is-even))]
|
||||
(show (slice v)) ; 2 4
|
||||
(free v))
|
||||
(print builds) (println "") ; 1
|
||||
|
||||
@ -41,7 +41,7 @@
|
||||
;; and these bytes do not, and they carry a "host" it has never heard of.
|
||||
(handler-bind
|
||||
[(json/SchemaDrift [d]
|
||||
(do (print (if (.extra? d) "extra " "missing "))
|
||||
(do (print (if (.is-extra d) "extra " "missing "))
|
||||
(print (.field d))
|
||||
(print " in ")
|
||||
(println (.struct d))))]
|
||||
|
||||
@ -49,10 +49,10 @@
|
||||
;; An infinity is a value that equals its own double and is not zero — the
|
||||
;; same test format-f64 in the prelude uses, and the only one available with
|
||||
;; no infinity literal to compare against.
|
||||
(defn inf-f64? [x f64] bool
|
||||
(defn is-inf-f64 [x f64] bool
|
||||
(and (= x (* x 2.0)) (!= x 0.0)))
|
||||
|
||||
(defn inf-f32? [x f32] bool
|
||||
(defn is-inf-f32 [x f32] bool
|
||||
(and (= x (* x (f32 2.0))) (!= x (f32 0.0))))
|
||||
|
||||
(defn say [name str ok bool] ()
|
||||
@ -112,8 +112,8 @@
|
||||
;; finite above it.
|
||||
(say "f32-max" (= f32-max (* (p2-f32 127) (- (f32 2.0) (p2-f32 -23)))))
|
||||
(say "f64-max" (= f64-max (* (p2-f64 1023) (- 2.0 (p2-f64 -52)))))
|
||||
(say "f32-max is the last finite f32" (inf-f32? (* f32-max (f32 2.0))))
|
||||
(say "f64-max is the last finite f64" (inf-f64? (* f64-max 2.0)))
|
||||
(say "f32-max is the last finite f32" (is-inf-f32 (* f32-max (f32 2.0))))
|
||||
(say "f64-max is the last finite f64" (is-inf-f64 (* f64-max 2.0)))
|
||||
|
||||
;; And the two the language does not need a constant for, said once so that
|
||||
;; the absence is recorded rather than merely unmentioned: a float's least
|
||||
|
||||
@ -4,7 +4,7 @@
|
||||
|
||||
(defn truth [n i32] bool (> n 0))
|
||||
|
||||
(defn same? [a bool b bool] bool (= a b))
|
||||
(defn is-same [a bool b bool] bool (= a b))
|
||||
|
||||
;; Exhaustive without a _ arm: true and false are every bool.
|
||||
(defn word [b bool] str
|
||||
@ -37,8 +37,8 @@
|
||||
(let [f (Flag {.on true})
|
||||
g (Flag {.on false})
|
||||
flags [true false true]]
|
||||
(print (same? true true)) (print " ")
|
||||
(print (same? true false)) (print " ")
|
||||
(print (is-same true true)) (print " ")
|
||||
(print (is-same true false)) (print " ")
|
||||
(print (!= true false)) (print " ")
|
||||
(print (= (.on f) (truth 3))) (print " ")
|
||||
(print (= (.on g) (truth 3))) (print " ")
|
||||
|
||||
38
test/programs/optionals-dyn.fln
Normal file
38
test/programs/optionals-dyn.fln
Normal file
@ -0,0 +1,38 @@
|
||||
;; Swift optionals over dyn values: nil is the absence. ??, !, if let over a
|
||||
;; plain name, and chaining through a map's field.
|
||||
|
||||
let calls = 0
|
||||
|
||||
fn fallback(v)
|
||||
calls += 1
|
||||
v
|
||||
|
||||
fn describe(o, p)
|
||||
if let g = o
|
||||
g + 100
|
||||
elif let h = p
|
||||
h + 200
|
||||
else
|
||||
0
|
||||
|
||||
;; A kept if let with no else: the value, or nil.
|
||||
fn kept(o) -> dyn
|
||||
if let g = o then g * 2
|
||||
|
||||
fn power(car) = car.engine?.power
|
||||
|
||||
fn run(a, n)
|
||||
println(a ?? 7, n ?? 7)
|
||||
println(n ?? n ?? 9)
|
||||
println(a ?? fallback(1), n ?? fallback(2), calls)
|
||||
println(a!)
|
||||
println(describe(a, n), describe(n, a), describe(n, n))
|
||||
println(kept(a), kept(n))
|
||||
let car = {:name "a" :engine {:power 90}}
|
||||
let bare = {:name "b" :engine nil}
|
||||
println(power(car), power(bare))
|
||||
println(power(car) ?? -1, power(bare) ?? -1)
|
||||
println(car.engine?.power ?? -1)
|
||||
|
||||
fn main()
|
||||
run(3, nil)
|
||||
17
test/programs/optionals-trap.fln
Normal file
17
test/programs/optionals-trap.fln
Normal file
@ -0,0 +1,17 @@
|
||||
;; x! over nothing traps at its own site and names the expression: 1 is a
|
||||
;; typed Option that is None, 2 a dyn that is nil.
|
||||
|
||||
struct Cfg
|
||||
port: i32?
|
||||
|
||||
fn nothing(x) = x
|
||||
|
||||
fn main(args: [str]) -> i32
|
||||
let k = if length(args) > 1 then bytes->i64(bytes-view(args[1])) else 0
|
||||
println("before")
|
||||
let cfg = Cfg{.port None}
|
||||
if k == 1
|
||||
println(cfg.port!)
|
||||
if k == 2
|
||||
println(nothing(nil)!)
|
||||
0
|
||||
65
test/programs/optionals.fln
Normal file
65
test/programs/optionals.fln
Normal file
@ -0,0 +1,65 @@
|
||||
;; Swift optionals over typed values: T?, ??, !, if let over a plain name,
|
||||
;; and chaining through a field and a function held in a field.
|
||||
|
||||
struct Engine
|
||||
power: i32
|
||||
boost: CFn(i32) -> i32
|
||||
|
||||
struct Car
|
||||
name: str
|
||||
engine: Engine?
|
||||
spare: i32?
|
||||
|
||||
fn twice(x: i32) -> i32 = x * 2
|
||||
|
||||
fn find(xs: [2 i32?], i: i32) -> i32?
|
||||
if i < length(xs) then xs[i] else None
|
||||
|
||||
;; Counts the defaults evaluated, to show ?? evaluates its right side only
|
||||
;; when the left holds nothing.
|
||||
let calls = 0
|
||||
|
||||
fn fallback(v: i32) -> i32
|
||||
calls += 1
|
||||
v
|
||||
|
||||
fn describe(o: i32?) -> i32
|
||||
if let g = o
|
||||
g + 100
|
||||
elif let h = find([None, Some(5)], 1)
|
||||
h
|
||||
else
|
||||
0
|
||||
|
||||
fn main()
|
||||
let a: i32? = Some(3)
|
||||
let n: i32? = None
|
||||
println(a ?? 7, n ?? 7)
|
||||
;; A chain of defaults is read from the right; an Option default keeps it
|
||||
;; an Option.
|
||||
println(n ?? n ?? 9)
|
||||
let still: i32? = n ?? a
|
||||
println(still!)
|
||||
;; Short-circuit: fallback runs once, for n.
|
||||
println(a ?? fallback(1), n ?? fallback(2), calls)
|
||||
;; Above the comparisons, below arithmetic.
|
||||
println(n ?? 1 + 1 == 2)
|
||||
println(a!)
|
||||
println(describe(Some(1)), describe(None))
|
||||
let cs: [Car] = [Car{.name "a" .engine Some(Engine{.power 90 .boost twice}) .spare Some(1)},
|
||||
Car{.name "b" .engine None .spare None}]
|
||||
for i in range(2)
|
||||
let c = cs[i]
|
||||
let p = c.engine?.power
|
||||
let b = c.engine?.boost(21)
|
||||
println(c.name, p ?? -1, b ?? -1)
|
||||
;; Flat: a field that is itself an Option is not wrapped again.
|
||||
let s: i32? = Some(c)?.spare
|
||||
println(s ?? -1)
|
||||
let xs = [Some(4), None]
|
||||
println(xs[0]!, xs[1] ?? 0)
|
||||
;; Nested types.
|
||||
let v: Vec(i32?) = vec-new(i32?)
|
||||
push(v, Some(1))
|
||||
push(v, None)
|
||||
println(length(v), v[0] ?? 0, v[1] ?? 0)
|
||||
@ -6,4 +6,4 @@
|
||||
(import shape "../shape")
|
||||
|
||||
(defn describe [b shape/Box] i32
|
||||
(if (shape/wide? b) (.w b) (.h b)))
|
||||
(if (shape/is-wide b) (.w b) (.h b)))
|
||||
|
||||
@ -9,4 +9,4 @@
|
||||
|
||||
(defn box [w i32 h i32] Box (Box {.w w .h h}))
|
||||
|
||||
(defn wide? [b Box] bool (> (.w b) (.h b)))
|
||||
(defn is-wide [b Box] bool (> (.w b) (.h b)))
|
||||
|
||||
@ -7,12 +7,12 @@
|
||||
(defstruct k [x i32])
|
||||
(defenum v [lo hi])
|
||||
|
||||
(defn even? [x i32] bool (= (% x 2) 0))
|
||||
(defn is-even [x i32] bool (= (% x 2) 0))
|
||||
|
||||
(defn main [] i32
|
||||
(set (at t 0) 7)
|
||||
(let [xs [1 2 3 4 5 6]
|
||||
evens (filter (slice xs) even?)]
|
||||
evens (filter (slice xs) is-even)]
|
||||
(println (length evens)) ; 3
|
||||
(println (at evens 2)) ; 6
|
||||
(free evens))
|
||||
|
||||
@ -94,7 +94,7 @@
|
||||
;; levels, so printing the float would pin raylib's choice of divisor rather
|
||||
;; than Flan's field order. Nothing is lost: a permuted layout is not out by a
|
||||
;; rounding step, it reads a different buffer.
|
||||
(defn near? [a f32 b f32] bool
|
||||
(defn is-near [a f32 b f32] bool
|
||||
(let [d (- a b)]
|
||||
(< (if (< d 0.0) (- 0.0 d) d) 0.0005)))
|
||||
|
||||
@ -122,7 +122,7 @@
|
||||
v)))
|
||||
|
||||
(defn show-frame [name str w rl/Wave i i32 want f32] ()
|
||||
(show-bool name (near? (frame-at w i) want)))
|
||||
(show-bool name (is-near (frame-at w i) want)))
|
||||
|
||||
(defn main [] i32
|
||||
(rl/set-trace-log-level :log-warning)
|
||||
|
||||
@ -67,13 +67,13 @@
|
||||
;; risk worth naming: a permuted layout is out by whole units. Swapping x and
|
||||
;; y in Vector2 makes this print "rotated bad" — the same camera then reads
|
||||
;; back as (-12,24).
|
||||
(defn near? [a f32 b f32] bool
|
||||
(defn is-near [a f32 b f32] bool
|
||||
(let [d (- a b)]
|
||||
(< (if (< d 0.0) (- 0.0 d) d) 0.0001)))
|
||||
|
||||
(defn show-near [name str v rl/Vector2 x f32 y f32] ()
|
||||
(print name)
|
||||
(println (if (and (near? (.x v) x) (near? (.y v) y)) " ok" " bad")))
|
||||
(println (if (and (is-near (.x v) x) (is-near (.y v) y)) " ok" " bad")))
|
||||
|
||||
(defn main [] i32
|
||||
(rl/set-trace-log-level :log-warning)
|
||||
|
||||
@ -20,14 +20,14 @@
|
||||
(declare-c c-where2 [s str c Ch] i64 "__xpg_basename")
|
||||
(declare-c c-puts [s str] i32 "puts")
|
||||
|
||||
(defn far? [a i64 b i64] bool
|
||||
(defn is-far [a i64 b i64] bool
|
||||
(let [d (- a b)]
|
||||
(> (if (< d 0) (- 0 d) d) 1048576)))
|
||||
|
||||
(defn main [] i32
|
||||
(let [s "hello"]
|
||||
(println (far? (c-where "hello") (c-where s)))
|
||||
(println (far? (c-where2 "hello" (Ch {.c 104})) (c-where2 s (Ch {.c 104}))))
|
||||
(println (is-far (c-where "hello") (c-where s)))
|
||||
(println (is-far (c-where2 "hello" (Ch {.c 104})) (c-where2 s (Ch {.c 104}))))
|
||||
(c-puts "hello")
|
||||
(c-puts "")
|
||||
(c-puts (str (slice (bytes-view "hello world") 0 3))))
|
||||
|
||||
@ -15,10 +15,10 @@
|
||||
;; Reading it here is a borrow. So is reading it in [total] below, which is the
|
||||
;; case the old rule could not express: two functions holding the same global
|
||||
;; at once is fine exactly because neither of them can free it.
|
||||
(defn loaded? [] bool (> (length the-data) 0))
|
||||
(defn is-loaded [] bool (> (length the-data) 0))
|
||||
|
||||
(defn load [] ()
|
||||
(when (not (loaded?))
|
||||
(when (not (is-loaded))
|
||||
(set the-data (vec-new u8))
|
||||
(dotimes [i 5] (push the-data (u8 (* i 3))))))
|
||||
|
||||
|
||||
@ -1,10 +1,10 @@
|
||||
(defn fizz? [n i32] bool
|
||||
(defn is-fizz [n i32] bool
|
||||
(= 0 (% n 3)))
|
||||
|
||||
(defn main [] i32
|
||||
(dotimes [i 15]
|
||||
(let [n (+ i 1)]
|
||||
(if (fizz? n)
|
||||
(if (is-fizz n)
|
||||
(print "fizz")
|
||||
(print n))
|
||||
(println "")))
|
||||
|
||||
@ -43,19 +43,19 @@ fn line(it: stock/Item) -> ()
|
||||
print(".")
|
||||
println(str(slice(price)))
|
||||
|
||||
fn low?(it: stock/Item) -> bool = it.count < reorder-below
|
||||
fn is-low(it: stock/Item) -> bool = it.count < reorder-below
|
||||
|
||||
fn count-if(items: [stock/Item], keep?: Fn(stock/Item) -> bool) -> i32
|
||||
fn count-if(items: [stock/Item], is-keep: Fn(stock/Item) -> bool) -> i32
|
||||
let n = 0
|
||||
for i in range(length(items))
|
||||
if keep?(items[i])
|
||||
if is-keep(items[i])
|
||||
++(n)
|
||||
n
|
||||
|
||||
fn main() -> i32
|
||||
let items = [stock/item("bolts", 12, 400), stock/item("nuts", 5, 3),
|
||||
stock/item("gears", 1250, 7), stock/item("belts", 899, 0)]
|
||||
let rules = [Rule{.label "reorder", .applies low?},
|
||||
let rules = [Rule{.label "reorder", .applies is-low},
|
||||
Rule{.label "valuable", .applies fn(it) => stock/value(it) > 5000}]
|
||||
let frame = arena-new(4096)
|
||||
repeat(pass, 2):
|
||||
|
||||
@ -11,7 +11,7 @@ struct Reading
|
||||
sensor: u8
|
||||
value: i32
|
||||
|
||||
fn push-ring!(r: Ptr(Ring($n, $t)), x: $t) -> ()
|
||||
fn push-ring(r: Ptr(Ring($n, $t)), x: $t) -> ()
|
||||
r.items[r.head] = x
|
||||
r.head = (r.head + 1) % n
|
||||
if r.count < n
|
||||
@ -68,7 +68,7 @@ fn main() -> i32
|
||||
for :fill i in range(length(samples))
|
||||
if samples[i] > 10
|
||||
continue :fill
|
||||
push-ring!(addr(r), samples[i])
|
||||
push-ring(addr(r), samples[i])
|
||||
let kept = copy-out(addr(r))
|
||||
defer free(kept)
|
||||
println("kept", slice(kept))
|
||||
|
||||
@ -40,7 +40,7 @@ fn next-token(src: [const u8], pos: Ptr(i32)) -> Token
|
||||
else
|
||||
Token.Word{.w text}
|
||||
|
||||
fn push!(m: Ptr(Machine), v: i64) -> ()
|
||||
fn push-num(m: Ptr(Machine), v: i64) -> ()
|
||||
m.stack[m.depth] = v
|
||||
m.depth += 1
|
||||
|
||||
@ -65,16 +65,16 @@ fn run(src: str) -> i64
|
||||
while :tokens true
|
||||
match next-token(text, addr(pos))
|
||||
End -> break :tokens
|
||||
Num(n) -> push!(addr(m), n)
|
||||
Num(n) -> push-num(addr(m), n)
|
||||
Op(c) ->
|
||||
let b = small-pop(addr(m), c)
|
||||
let a = small-pop(addr(m), c)
|
||||
push!(addr(m), apply(c, a, b))
|
||||
push-num(addr(m), apply(c, a, b))
|
||||
Word(w) ->
|
||||
if is-bytes-equal(w, bytes-view("dup"))
|
||||
let v = small-pop(addr(m), \d)
|
||||
push!(addr(m), v)
|
||||
push!(addr(m), v)
|
||||
push-num(addr(m), v)
|
||||
push-num(addr(m), v)
|
||||
elif is-bytes-equal(w, bytes-view("drop"))
|
||||
small-pop(addr(m), \d)
|
||||
continue
|
||||
|
||||
@ -10,7 +10,7 @@ struct Count
|
||||
word: [const u8]
|
||||
n: i32
|
||||
|
||||
fn letter?(c: u8) -> bool
|
||||
fn is-letter(c: u8) -> bool
|
||||
(c >= \a and c <= \z)
|
||||
or (c >= \A and c <= \Z)
|
||||
or c == \'
|
||||
@ -23,12 +23,12 @@ fn words(text: [const u8]) -> Vec([const u8])
|
||||
i = 0
|
||||
n = length(lower)
|
||||
while :scan i < n
|
||||
until i >= n or letter?(lower[i])
|
||||
until i >= n or is-letter(lower[i])
|
||||
i += 1
|
||||
if i >= n
|
||||
break :scan
|
||||
let start = i
|
||||
while i < n and letter?(lower[i])
|
||||
while i < n and is-letter(lower[i])
|
||||
i += 1
|
||||
push(out, slice(lower, start, i))
|
||||
out
|
||||
|
||||
@ -3,14 +3,14 @@
|
||||
|
||||
import geo "geo"
|
||||
|
||||
fn far?(a: geo/Pt, b: geo/Pt, limit: i32) -> bool = geo/dist2(a, b) > limit * limit
|
||||
fn is-far(a: geo/Pt, b: geo/Pt, limit: i32) -> bool = geo/dist2(a, b) > limit * limit
|
||||
|
||||
fn main() -> i32
|
||||
let a = geo/pt(1, 2)
|
||||
let b = geo/Pt{.x 4, .y 6}
|
||||
println(geo/dist2(a, b))
|
||||
println(a.x + b.y)
|
||||
if far?(a, b, 4)
|
||||
if is-far(a, b, 4)
|
||||
println("far")
|
||||
else
|
||||
println("near")
|
||||
|
||||
@ -58,13 +58,13 @@ fn settle(row: i32, col: i32) -> ()
|
||||
velocity[y, col] = vel
|
||||
velocity[row, col] = 0.0
|
||||
return
|
||||
let left? = col > 0 and 0 == grid[y, col - 1]
|
||||
let right? = col < cols - 1 and 0 == grid[y, col + 1]
|
||||
if left? or right?
|
||||
let is-left = col > 0 and 0 == grid[y, col - 1]
|
||||
let is-right = col < cols - 1 and 0 == grid[y, col + 1]
|
||||
if is-left or is-right
|
||||
let side =
|
||||
if not left?
|
||||
if not is-left
|
||||
1
|
||||
elif not right?
|
||||
elif not is-right
|
||||
-1
|
||||
else
|
||||
if f32(rand()) < 0.5 then 1 else -1
|
||||
|
||||
@ -1694,7 +1694,7 @@ let () =
|
||||
is written and not freed on purpose — a read of released memory can pass
|
||||
by luck, and this cannot.
|
||||
|
||||
Then true/false from malformed?, which is the distinction the old
|
||||
Then true/false from is-malformed, which is the distinction the old
|
||||
(Option Value) return carried, moved to the cursor now that read
|
||||
answers nil for malformed input: the truncated set #{1 2 leaves the
|
||||
cursor not-ok and the document nil leaves it clean.
|
||||
@ -2264,6 +2264,32 @@ let () =
|
||||
(try Sys.remove exe with Sys_error _ -> ()));
|
||||
outputs ~opt:"-O0" "if let, -O0" "programs/if-let.fln" if_let_out;
|
||||
outputs ~x86:true "if let, --x86" "programs/if-let.fln" if_let_out;
|
||||
(* Swift optionals, typed and over a dyn: T?, ??, !, if let over a plain
|
||||
name, and ?. through a field and a function held in one. *)
|
||||
let optionals_out = "3 7\n9\n3\n3 2 1\ntrue\n3\n101 5\na 90 42\n1\nb -1 -1\n-1\n4 0\n2 1 0\n" in
|
||||
let optionals_dyn_out = "3 7\n9\n3 2 1\n3\n103 203 0\n6 nil\n90 nil\n90 -1\n90\n" in
|
||||
List.iter
|
||||
(fun (path, want) ->
|
||||
outputs path ("programs/" ^ path) want;
|
||||
outputs ~opt:"-O0" (path ^ ", -O0") ("programs/" ^ path) want;
|
||||
outputs ~x86:true (path ^ ", --x86") ("programs/" ^ path) want)
|
||||
[ ("optionals.fln", optionals_out); ("optionals-dyn.fln", optionals_dyn_out) ];
|
||||
(* x! over nothing traps at its site and names the expression. *)
|
||||
List.iter
|
||||
(fun (x86, arg, want) ->
|
||||
let exe = compile ~x86 "programs/optionals-trap.fln" in
|
||||
let code, text = run exe (Some arg) in
|
||||
if code <> 134 || not (contains text "before\n") || not (contains text want)
|
||||
then begin
|
||||
incr failures;
|
||||
Printf.printf "FAIL x! traps %s%s\n got: %S (exit %d)\n wanted: %S\n"
|
||||
arg (if x86 then ", --x86" else "") text code want
|
||||
end;
|
||||
(try Sys.remove exe with Sys_error _ -> ()))
|
||||
[ (false, "1", "optionals-trap.fln:14:13: cfg.port is None, so cfg.port! has no value to give");
|
||||
(true, "1", "optionals-trap.fln:14:13: cfg.port is None, so cfg.port! has no value to give");
|
||||
(false, "2", "optionals-trap.fln:16:13: nothing(nil) is nil, so nothing(nil)! has no value to give");
|
||||
(true, "2", "optionals-trap.fln:16:13: nothing(nil) is nil, so nothing(nil)! has no value to give") ];
|
||||
(* format-f64, the first number formatter a caller can steer. The three
|
||||
lines that would ship wrong are pinned deliberately: 0.999995 at five
|
||||
places, where the rounded fraction equals the scale and is the next
|
||||
|
||||
@ -2894,8 +2894,8 @@ let () =
|
||||
|
||||
(* ── Names, order-independence, entry point ────────────────────── *)
|
||||
accepts "mutually recursive, no forward declaration"
|
||||
"(defn even? [n i32] bool (if (= n 0) true (odd? (- n 1)))) \
|
||||
(defn odd? [n i32] bool (if (= n 0) false (even? (- n 1))))";
|
||||
"(defn is-even [n i32] bool (if (= n 0) true (is-odd (- n 1)))) \
|
||||
(defn is-odd [n i32] bool (if (= n 0) false (is-even (- n 1))))";
|
||||
rejects_check "unknown name" "(defn f [] i32 nope)" ~needle:"unknown name";
|
||||
rejects_check "unknown function" "(defn f [] i32 (nope 1))"
|
||||
~needle:"unknown function";
|
||||
@ -6842,12 +6842,12 @@ let () =
|
||||
accepts "is-integer admits <, via the entailment"
|
||||
"(defn small? [x $t] bool {:where (is-integer $t)} (< x 10))";
|
||||
accepts "is-integer admits bit-and"
|
||||
"(defn low? [x $t] bool {:where (is-integer $t)} (= (bit-and x 1) 1))";
|
||||
"(defn is-low [x $t] bool {:where (is-integer $t)} (= (bit-and x 1) 1))";
|
||||
accepts "is-integer admits the shifts"
|
||||
"(defn dbl [x $t] $t {:where (is-integer $t)} (<< x 1))";
|
||||
rejects_check "is-numeric does not admit bit-and"
|
||||
~needle:"nothing declares $t is-integer"
|
||||
"(defn low? [x $t] bool {:where (is-numeric $t)} (= (bit-and x 1) 1))";
|
||||
"(defn is-low [x $t] bool {:where (is-numeric $t)} (= (bit-and x 1) 1))";
|
||||
rejects_check "nor the shifts"
|
||||
~needle:"nothing declares $t is-integer"
|
||||
"(defn dbl [x $t] $t {:where (is-numeric $t)} (<< x 1))";
|
||||
@ -6937,7 +6937,7 @@ let () =
|
||||
accepts "is-enum admits the conversion from an enum"
|
||||
"(defn code [x $t] i32 {:where (is-enum $t)} (i32 x))";
|
||||
accepts "and compares, being is-ordered and is-equal"
|
||||
"(defn later? [a $t b $t] bool {:where (is-enum $t)} (and (> a b) (= a b)))";
|
||||
"(defn is-later [a $t b $t] bool {:where (is-enum $t)} (and (> a b) (= a b)))";
|
||||
rejects_check "but is not a number"
|
||||
~needle:"$t"
|
||||
"(defn sum [a $t b $t] $t {:where (is-enum $t)} (+ a b))";
|
||||
@ -7157,42 +7157,42 @@ let () =
|
||||
every value of both. TODO.org, "abs is one generic, and a bound joins to
|
||||
the wider type". *)
|
||||
accepts "a scalar pair at one $t joins at the wider type"
|
||||
"(defn eq2? [a $t b $t] bool {:where (is-equal $t)} (= a b))\n\
|
||||
(defn main [] () (println (eq2? (i64 3) (i8 3))))";
|
||||
"(defn is-eq2 [a $t b $t] bool {:where (is-equal $t)} (= a b))\n\
|
||||
(defn main [] () (println (is-eq2 (i64 3) (i8 3))))";
|
||||
accepts "and the other argument order joins identically"
|
||||
"(defn eq2? [a $t b $t] bool {:where (is-equal $t)} (= a b))\n\
|
||||
(defn main [] () (println (eq2? (i8 3) (i64 3))))";
|
||||
"(defn is-eq2 [a $t b $t] bool {:where (is-equal $t)} (= a b))\n\
|
||||
(defn main [] () (println (is-eq2 (i8 3) (i64 3))))";
|
||||
(* Order-independence, pinned on the copies and not only on acceptance:
|
||||
both orders in one program make exactly one instantiation, at i64, and
|
||||
none at i8. *)
|
||||
(let syms order_a order_b =
|
||||
match
|
||||
checked
|
||||
("(defn eq2? [a $t b $t] bool {:where (is-equal $t)} (= a b))\n\
|
||||
(defn main [] () (do (println (eq2? " ^ order_a ^ "))\
|
||||
(println (eq2? " ^ order_b ^ "))))")
|
||||
("(defn is-eq2 [a $t b $t] bool {:where (is-equal $t)} (= a b))\n\
|
||||
(defn main [] () (do (println (is-eq2 " ^ order_a ^ "))\
|
||||
(println (is-eq2 " ^ order_b ^ "))))")
|
||||
with
|
||||
| p ->
|
||||
List.filter_map
|
||||
(fun (f : Tast.fn) ->
|
||||
if String.length f.Tast.name >= 4
|
||||
&& String.sub f.Tast.name 0 4 = "eq2?" then Some f.Tast.name
|
||||
if String.length f.Tast.name >= 6
|
||||
&& String.sub f.Tast.name 0 6 = "is-eq2" then Some f.Tast.name
|
||||
else None)
|
||||
p.Tast.fns
|
||||
| exception _ -> [ "did not check" ]
|
||||
in
|
||||
check "both orders share one copy, at the wider type"
|
||||
(syms "(i8 3) (i64 4)" "(i64 5) (i8 6)" = [ "eq2?-i64" ]);
|
||||
(syms "(i8 3) (i64 4)" "(i64 5) (i8 6)" = [ "is-eq2-i64" ]);
|
||||
check "and the reversed program instantiates the same one copy"
|
||||
(syms "(i64 5) (i8 6)" "(i8 3) (i64 4)" = [ "eq2?-i64" ]));
|
||||
(syms "(i64 5) (i8 6)" "(i8 3) (i64 4)" = [ "is-eq2-i64" ]));
|
||||
(* The pair that meets at no type is the refusal that stays: neither u64
|
||||
nor i64 holds every value of the other, and inventing a third type
|
||||
would be picking one neither argument was written at. *)
|
||||
rejects_check "u64 and i64 meet at no type"
|
||||
~needle:"neither holds every value of the other"
|
||||
"(defn eq2? [a $t b $t] bool {:where (is-equal $t)} (= a b))\n\
|
||||
"(defn is-eq2 [a $t b $t] bool {:where (is-equal $t)} (= a b))\n\
|
||||
(defonce u u64 3)\n(defonce i i64 3)\n\
|
||||
(defn main [] () (println (eq2? u i)))";
|
||||
(defn main [] () (println (is-eq2 u i)))";
|
||||
(* And a later, wider argument settles a pair that had no join of its own:
|
||||
u32 and i32 meet nowhere, but all three meet at the i64 that arrives
|
||||
third — in either order, which is what the deferred re-ask is for. *)
|
||||
@ -7223,8 +7223,8 @@ let () =
|
||||
(* The written conversion is what the message asks for, and it is accepted:
|
||||
the refusal is about the *implicit* step, not about reaching i64. *)
|
||||
accepts "the written conversion is accepted"
|
||||
"(defn eq2? [a $t b $t] bool {:where (is-equal $t)} (= a b))\n\
|
||||
(defn main [] () (println (eq2? (i64 3) (i64 (i8 3)))))";
|
||||
"(defn is-eq2 [a $t b $t] bool {:where (is-equal $t)} (= a b))\n\
|
||||
(defn main [] () (println (is-eq2 (i64 3) (i64 (i8 3)))))";
|
||||
(* An untyped constant has no type of its own to keep, so it still takes the
|
||||
variable's. Nothing is converted here — three i64s were written. *)
|
||||
accepts "an untyped literal still takes a bound type variable's type"
|
||||
@ -7236,8 +7236,8 @@ let () =
|
||||
so a variable bound inside a slice or a function type leaves a parameter
|
||||
no widening applied to in the first place. *)
|
||||
accepts "a variable bound inside a constructor is unaffected"
|
||||
"(defn sort2 [s [$t] before? (Fn [$t $t] bool)] () \
|
||||
(sort-by s before?))\n\
|
||||
"(defn sort2 [s [$t] is-before (Fn [$t $t] bool)] () \
|
||||
(sort-by s is-before))\n\
|
||||
(defn main [] () (let [ns [5 3 9 1]] \
|
||||
(sort2 (slice ns 0 4) (fn [a b] (< a b))) (println (at ns 0))))";
|
||||
(* A form with no type of its own is still checked against the parameter:
|
||||
@ -8322,13 +8322,16 @@ let () =
|
||||
parse_rejects "_ in a defgeneric's return slot"
|
||||
~needle:"defgeneric's methods each have their own"
|
||||
"(defgeneric area [s] _)";
|
||||
(* if-let refuses a pattern that cannot fail, toward let; the program half
|
||||
is programs/if-let.flan. *)
|
||||
rejects_check "if-let over a plain name"
|
||||
~needle:"the pattern g is a plain name, which always matches"
|
||||
(* A plain name binds what an Option or a dyn holds; over anything else
|
||||
it cannot fail, and is refused toward let. The program half is
|
||||
programs/if-let.flan and programs/optionals.fln. *)
|
||||
accepts "if-let over a plain name and an Option"
|
||||
"(defn main [] () (if-let [g (Some 1)] (println g)))";
|
||||
rejects_check "if-let over a plain name and an i32"
|
||||
~needle:"which always holds a value, so this if let has nothing to test"
|
||||
"(defn main [] () (if-let [g 1] (println g)))";
|
||||
rejects_check "and says let" ~needle:"(let [g ...] ...)"
|
||||
"(defn main [] () (if-let [g (Some 1)] (println g)))";
|
||||
"(defn main [] () (if-let [g 1] (println g)))";
|
||||
rejects_check "if-let over _" ~needle:"the pattern _ always matches"
|
||||
"(defn main [] () (if-let [_ (Some 1)] (println 1)))";
|
||||
accepts "if-let over a case with no fields"
|
||||
|
||||
@ -1396,7 +1396,7 @@ let () =
|
||||
if not (has got want) then
|
||||
fail "expanding a defedn: %S is not in\n%s" want got)
|
||||
[ (* The struct, with a type per field derived from the value. *)
|
||||
"(defstruct Tuning [name str hp i64 speed f64 boss? bool";
|
||||
"(defstruct Tuning [name str hp i64 speed f64 is-boss bool";
|
||||
(* The vector, and the constructor that states its type so that
|
||||
(vec-new) has something to take it from. *)
|
||||
"drops (Vec i64)";
|
||||
|
||||
@ -1078,7 +1078,7 @@ let () =
|
||||
^ " let b = compute-something-long(5, 6, 7, 8, 9)\n a")
|
||||
"(let [a (compute-something-long 1 2 3 4 5)\n b (compute-something-long 5 6 7 8 9)]";
|
||||
back "a label stays with its test"
|
||||
"fn f() -> ()\n while :outer some-long-condition?(1, 2, 3) and another-long-one?(4, 5, 6)\n g()"
|
||||
"fn f() -> ()\n while :outer is-some-long-condition(1, 2, 3) and is-another-long-one(4, 5, 6)\n g()"
|
||||
"(while :outer";
|
||||
back "a call's arguments fill the line"
|
||||
"fn f() -> ()\n println(\"alpha\", \"beta\", \"gamma\", \"delta\", \"epsilon\", \"zeta\", \"eta\", \"theta\", \"iota\", g(1))"
|
||||
@ -1383,6 +1383,41 @@ let checks name text =
|
||||
| _ -> ()
|
||||
| exception e -> fail "%s does not check: %s" name (diag_text e)
|
||||
|
||||
(* Names carry no ? or !; the forms that read them instead. *)
|
||||
let () =
|
||||
refuses "a ? ends no name" "fn empty-cell?(c: i32) -> bool = c == 0"
|
||||
"indent/question-name" "starts with is- or has- instead: is-empty-cell";
|
||||
refuses "a ? in a call's name" "rl/key-pressed?(k)"
|
||||
"indent/question-name" "rl/is-key-pressed";
|
||||
refuses "a renamed prelude question" "starts-with?(a, b)"
|
||||
"indent/question-name" "has-prefix";
|
||||
refuses "a ? in a binding" "let ok? = 1" "indent/question-name" "is-ok";
|
||||
refuses "a ? on a field" "x.done?" "indent/question-name" "is-done";
|
||||
refuses "a ! in a name" "set!(x)" "indent/mark-in-name" "Leave it out: set";
|
||||
refuses "a ? inside a name" "a?b" "indent/mark-in-name" "cannot contain ?";
|
||||
refuses "a glued ??" "x??y" "indent/unspaced-operator" "x ?? y";
|
||||
refuses "a glued !=" "x!=y" "indent/unspaced-operator" "x != y";
|
||||
reads "T? is Option(T)" "fn f(a: i32?, b: [i32?], c: Vec(Shape?), d: rl/Vector2?) -> $t? = a"
|
||||
"(defn f [a (Option i32) b [(Option i32)] c (Vec (Option Shape)) d (Option rl/Vector2)] (Option $t) a)";
|
||||
reads "?? is variadic and above the comparisons" "x = a ?? b ?? c == d + 1"
|
||||
"(set x (= (?? a b c) (+ d 1)))";
|
||||
reads "! unwraps, and a chain goes on after it" "x = a!.b + c!"
|
||||
"(set x (+ (.b (!! a)) (!! c)))";
|
||||
reads "?. reads the rest over a fresh name" "x = a?.b.c(1)?.d"
|
||||
"(set x (?. [~o1 a] (?. [~o2 ((.c (.b ~o1)) 1)] (.d ~o2))))";
|
||||
reads "?[ indexes" "x = f(a)?[2]" "(set x (?. [~o1 (f a)] (at ~o1 2)))";
|
||||
reads "if let over a plain name" "if let g = x\n g\nelif let h = y\n h"
|
||||
"(if-let [g x] g (if-let [h y] h))";
|
||||
refused "if-let-name-i32.fln"
|
||||
"fn main()\n let x = 5\n if let g = x\n println(g)\n"
|
||||
[ "always holds a value"; "let g = ..." ];
|
||||
refused "coalesce-i32.fln"
|
||||
"fn main()\n let x = 5\n println(x ?? 1)\n"
|
||||
[ "the left side of ?? is i32, which always holds a value" ];
|
||||
refused "chain-i32.fln"
|
||||
"struct P\n x: i32\n\nfn main()\n let p = P{.x 1}\n println(p?.x)\n"
|
||||
[ "?. has nothing to test. Write . instead" ]
|
||||
|
||||
(* A kept if-let chain whose arm gives no value is a statement, refused as a
|
||||
plain if's is; one whose arm returns stays Never, in both syntaxes. *)
|
||||
let () =
|
||||
|
||||
6
vendor/edn/provide.flan
vendored
6
vendor/edn/provide.flan
vendored
@ -180,7 +180,7 @@
|
||||
(defstruct SchemaDrift
|
||||
[field str
|
||||
struct str
|
||||
extra? bool
|
||||
is-extra bool
|
||||
pos i32])
|
||||
|
||||
;; ── And the one a file that does not parse signals ──────────────────
|
||||
@ -444,7 +444,7 @@
|
||||
`(when (= (bit-and seen ~bit) 0)
|
||||
(signal (SchemaDrift {.field ~lit
|
||||
.struct ~(Form.Str {.s name})
|
||||
.extra? false
|
||||
.is-extra false
|
||||
.pos (.pos k)})))))
|
||||
(set idx (+ idx 1)))))
|
||||
(expect c tok-map-close)
|
||||
@ -457,7 +457,7 @@
|
||||
(push clauses
|
||||
`(do (signal (SchemaDrift {.field (copy-text (.text k))
|
||||
.struct ~(Form.Str {.s name})
|
||||
.extra? true
|
||||
.is-extra true
|
||||
.pos (.pos k)}))
|
||||
(when (not (skip-value c))
|
||||
(return out))))
|
||||
|
||||
8
vendor/json/json.flan
vendored
8
vendor/json/json.flan
vendored
@ -374,7 +374,7 @@
|
||||
(defn- read-number [c (Ptr Cursor) lo i32] Token
|
||||
(let [s (.src c)
|
||||
i lo
|
||||
float? false]
|
||||
is-float false]
|
||||
(when (= (at s lo) \+)
|
||||
(set (.pos c) (+ lo 1)) (fail c err-leading-plus lo) (return (error-token c)))
|
||||
(when (= (at s lo) \.)
|
||||
@ -402,7 +402,7 @@
|
||||
;; The fraction. A dot with no digit after it is `1.` or `1.e3`, both of
|
||||
;; which JSON5 accepts and JSON does not.
|
||||
(when (and (< i (length s)) (= (at s i) \.))
|
||||
(set float? true)
|
||||
(set is-float true)
|
||||
(set i (+ i 1))
|
||||
(when (or (>= i (length s)) (not (is-digit (at s i))))
|
||||
(set (.pos c) (scan-atom c lo)) (fail c err-trailing-dot lo) (return (error-token c)))
|
||||
@ -413,7 +413,7 @@
|
||||
;; not, which is JSON's rule and reads like an inconsistency until you have
|
||||
;; seen 1e+3 in a file written by a serialiser.
|
||||
(when (and (< i (length s)) (or (= (at s i) \e) (= (at s i) \E)))
|
||||
(set float? true)
|
||||
(set is-float true)
|
||||
(set i (+ i 1))
|
||||
(when (and (< i (length s)) (or (= (at s i) \+) (= (at s i) \-)))
|
||||
(set i (+ i 1)))
|
||||
@ -430,7 +430,7 @@
|
||||
|
||||
(set (.pos c) i)
|
||||
(let [text (slice s lo i)]
|
||||
(when (not float?)
|
||||
(when (not is-float)
|
||||
;; Grammar-legal and still not representable: an i64 has 19 digits and
|
||||
;; JSON's integers have no bound. It is a number, so it becomes a float
|
||||
;; rather than an error — which loses precision and says so here, since
|
||||
|
||||
6
vendor/json/provide.flan
vendored
6
vendor/json/provide.flan
vendored
@ -156,7 +156,7 @@
|
||||
(defstruct SchemaDrift
|
||||
[field str
|
||||
struct str
|
||||
extra? bool
|
||||
is-extra bool
|
||||
pos i32])
|
||||
|
||||
;; And the one a file that does not parse signals. A generated reader
|
||||
@ -306,7 +306,7 @@
|
||||
`(when (= (bit-and seen ~bit) 0)
|
||||
(signal (SchemaDrift {.field ~lit
|
||||
.struct ~(Form.Str {.s name})
|
||||
.extra? false
|
||||
.is-extra false
|
||||
.pos (.pos close)})))))
|
||||
(comma c)
|
||||
(set idx (+ idx 1))))))
|
||||
@ -318,7 +318,7 @@
|
||||
(push clauses
|
||||
`(do (signal (SchemaDrift {.field (match (string-of k) (Some s) s None "")
|
||||
.struct ~(Form.Str {.s name})
|
||||
.extra? true
|
||||
.is-extra true
|
||||
.pos (.pos k)}))
|
||||
(when (not (skip-value c))
|
||||
(return out))))
|
||||
|
||||
Loading…
x
Reference in New Issue
Block a user