JosephFerano/flan
1
0
Fork 0
Code Issues Pull Requests Packages Projects Releases Wiki Activity

A .fln name carries no ? or !, and .fln has T?, x ?? d, x!, if let over a plain name and a?.b chaining.

Browse Source
This commit is contained in:
Joseph Ferano 2026-09-26 14:54:58 +07:00
parent 7db1a81d1f
commit 178c129c97
59 changed files with 914 additions and 255 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

7
TODO.org
View File

@ -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 (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=; 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 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 ** WAIT A cheap front for dyn sequences
Decided 2026-09-26 (128) to pause: dyn vectors are mutable, so taking from the front 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 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 ** DONE if let
CLOSED: [2026-09-26] CLOSED: [2026-09-26]
=(if-let [P v] then else)= in paren syntax; an elif chain is the else. With no else it =(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 is a statement unless kept, when it is an Option as =when= is. A plain name binds what an
=_= as the pattern (use =let=). 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 ** DONE when as a value, and get as a checked lookup
CLOSED: [2026-09-26] CLOSED: [2026-09-26]
Every one-armed =if= (and a =cond= with no =:else=) is a =when=; kept — a =let= value, a Every one-armed =if= (and a =cond= with no =:else=) is a =when=; kept — a =let= value, a

2
docs/BUILT.md
View File

@ -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`, 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 Source, destination, then any number of transforms — the shape of the `into->` macro the author already uses in

4
docs/SPIKE-GENERICS.md
View File

@ -80,11 +80,11 @@ is the `is_polymorphic_type_assignable` walk rather than a name match.
```lisp ```lisp
(defn swap! [xs [$t] i i32 j i32] () ...) (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] (let [i 1]
(while (< i (length s)) (while (< i (length s))
(let [j i] (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) (swap! s (- j 1) j)
(set j (- j 1)))) (set j (- j 1))))
(set i (+ i 1))))) (set i (+ i 1)))))

17
emacs/flan-fln-mode.el
View File

@ -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 ;; that starts with one, or follows a line that ends with one, continues the
;; line above. ;; line above.
(defconst flan-fln--binops (defconst flan-fln--binops
'("or" "and" "==" "!=" "<" "<=" ">" ">=" "||" "^^" "&&" "<<" ">>" "+" "-" "*" '("or" "and" "==" "!=" "??" "<" "<=" ">" ">=" "||" "^^" "&&" "<<" ">>" "+" "-"
"/" "%")) "*" "/" "%"))
(defconst flan-fln--binop-re (regexp-opt flan-fln--binops)) (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' ;; 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 ;; in lib/reader.ml), so `is-key-pressed', `dyn->f64' and `rl/draw-fps' are
;; one symbol each. ;; one symbol each.
(dolist (c '(?- ?_ ?? ?! ?/ ?. ?$ ?& ?* ?+ ?< ?> ?= ?% ?@ ?# ?^ ?| ?~)) (dolist (c '(?- ?_ ?/ ?. ?$ ?& ?* ?+ ?< ?> ?= ?% ?@ ?# ?^ ?| ?~))
(modify-syntax-entry c "_" table)) (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 ;; 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 ;; otherwise read as `x:', a name nothing defines. A `:key' keyword is
;; drawn by its own font-lock rule instead. ;; 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. ;; `where' constraint.
("[ \t]\\(then\\|else\\|in\\|where\\)[ \t]" 1 font-lock-keyword-face) ("[ \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 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) ("[ \t=(,]\\(if\\|when\\)[ \t]" 1 font-lock-keyword-face)
;; The operator words. ;; The operator words.
("\\_<\\(and\\|or\\|not\\)\\_>" 1 font-lock-keyword-face) ("\\_<\\(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) "\\_>") (,(concat "\\_<" (regexp-opt flan--constants t) "\\_>")
1 font-lock-constant-face) 1 font-lock-constant-face)
;; A keyword. `x:' is a name with a colon glued on, not one. ;; A keyword. `x:' is a name with a colon glued on, not one.

60
emacs/test-flan-fln.el
View File

@ -88,12 +88,12 @@
; a comment inside the body ; a comment inside the body
return return
let left? = col > 0 let is-left = col > 0
if left? or right? if is-left or is-right
let side = let side =
if not left? if not is-left
1 1
elif not right? elif not is-right
-1 -1
else else
if f32(rand()) < 0.5 then 1 else -1 if f32(rand()) < 0.5 then 1 else -1
@ -132,18 +132,18 @@ fn step() -> ()
return")) 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--is "on a clause, the statement is its header's, clauses and all"
(test-flan-fln--thing 'flan-fln-statement) (test-flan-fln--thing 'flan-fln-statement)
"if not left? "if not is-left
1 1
elif not right? elif not is-right
-1 -1
else else
if f32(rand()) < 0.5 then 1 else -1") 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--is "and the clause is its own line and block"
(test-flan-fln--thing 'flan-fln-clause) (test-flan-fln--thing 'flan-fln-clause)
"elif not right? "elif not is-right
-1")) -1"))
(test-flan-fln--in (test-flan-fln--at test-flan-fln--settle "1\n elif") (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--is "let x = with the value as a block"
(test-flan-fln--thing 'flan-fln-statement) (test-flan-fln--thing 'flan-fln-statement)
"let side = "let side =
if not left? if not is-left
1 1
elif not right? elif not is-right
-1 -1
else else
if f32(rand()) < 0.5 then 1 else -1")) if f32(rand()) < 0.5 then 1 else -1"))
@ -261,7 +261,7 @@ fn step() -> ()
;;; Statement motion ;;; 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) (flan-fln-backward-statement)
(test-flan--check "M-a at a statement's start goes to the one before at its level" (test-flan--check "M-a at a statement's start goes to the one before at its level"
(looking-at "if 0 == grid")) (looking-at "if 0 == grid"))
@ -277,7 +277,7 @@ fn step() -> ()
(test-flan-fln--in (test-flan-fln--at test-flan-fln--settle " -1") (test-flan-fln--in (test-flan-fln--at test-flan-fln--settle " -1")
(flan-fln-up) (flan-fln-up)
(test-flan--check "C-M-u goes to the line that owns the block" (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) (flan-fln-up)
(test-flan--check "and from there to its owner's" (looking-at "let side"))) (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 "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 "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))) (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--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--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" (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))) (load-path (append dirs load-path)))
(if (not (require 'expand-region nil t)) (if (not (require 'expand-region nil t))
(message " skip expand-region (not installed)") (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) (transient-mark-mode 1)
(let ((steps nil)) (let ((steps nil))
(dotimes (_ 6) (dotimes (_ 6)
@ -1279,8 +1307,8 @@ its line with AT-END."
(setq steps (nreverse steps)) (setq steps (nreverse steps))
(test-flan-fln--is "term, then statement's clause, then statement, then out" (test-flan-fln--is "term, then statement's clause, then statement, then out"
(mapcar (lambda (s) (car (split-string s "\n"))) steps) (mapcar (lambda (s) (car (split-string s "\n"))) steps)
'("right?" "elif not right?" "if not left?" "let side =" '("is-right" "elif not is-right" "if not is-left" "let side ="
"if left? or right?" "let left? = col > 0")))))) "if is-left or is-right" "let is-left = col > 0"))))))
;;; smartparens, where it is installed ;;; 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") "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") ("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") " 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") " 1\n")
("yik" ,(test-flan-fln--at test-flan-fln--settle "if f32(rand())") ("yik" ,(test-flan-fln--at test-flan-fln--settle "if f32(rand())")
" if f32(rand()) < 0.5 then 1 else -1\n") " if f32(rand()) < 0.5 then 1 else -1\n")

4
emacs/test-flan-mode.el
View File

@ -312,7 +312,7 @@
;; still two in from `defn'. ;; still two in from `defn'.
(test-flan-mode--check (test-flan-mode--check
"a where clause sits in the body column and does not move the body" "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)} {:where (is-hashable $t)}
(let [m (map-new t i32)] (let [m (map-new t i32)]
(put m k 1)))") (put m k 1)))")
@ -483,7 +483,7 @@
font-lock-type-face "Fn") font-lock-type-face "Fn")
("(declare call [(CFn [i64] i64)] i64)" "CFn" ("(declare call [(CFn [i64] i64)] i64)" "CFn"
font-lock-type-face "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") "a type variable")
;; The package alias of a qualified name, `clojure-mode''s ;; The package alias of a qualified name, `clojure-mode''s
;; rule for a namespace. ;; rule for a namespace.

24
examples/core-input-gestures-testbed.flan
View File

@ -88,18 +88,18 @@
;; call site says nothing, and because a gesture raylib adds later lands in ;; call site says nothing, and because a gesture raylib adds later lands in
;; the right family without this file being edited. ;; 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)) (> (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)) (> (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)) (< (i32 g) 3))
;; Two orderings these impose, both of them the C's as well. A pinch is above ;; 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 ;; 255 and therefore above 15, so is-swipe has to be asked after the pinches
;; rather than before; and tapish? admits :gesture-none, which is 0, so it ;; 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 ;; belongs under a :gesture-none guard. The C's switch over single members
;; hides both; a range test cannot. ;; hides both; a range test cannot.
@ -123,12 +123,12 @@
(= g :gesture-tap) rl/blue (= g :gesture-tap) rl/blue
(= g :gesture-double-tap) rl/skyblue (= g :gesture-double-tap) rl/skyblue
(= g :gesture-drag) rl/lime (= 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 ;; range test and has to be asked after them, not before. The C gets this
;; for free by being a switch over single members. ;; for free by being a switch over single members.
(= g :gesture-pinch-in) rl/violet (= g :gesture-pinch-in) rl/violet
(= g :gesture-pinch-out) rl/orange (= g :gesture-pinch-out) rl/orange
(swipe? g) rl/red (is-swipe g) rl/red
:else rl/black)) :else rl/black))
;; ── The log ───────────────────────────────────────────────────────── ;; ── The log ─────────────────────────────────────────────────────────
@ -138,11 +138,11 @@
;; 1 hides repeated events ;; 1 hides repeated events
;; 2 shows repeated events but hides hold ;; 2 shows repeated events but hides hold
;; 3 hides repeated events and 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 (cond
(= g :gesture-none) false (= g :gesture-none) false
(= log-mode 3) (or (and (not (= g :gesture-hold)) (not (= g previous-gesture))) (= 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 2) (not (= g :gesture-hold))
(= log-mode 1) (not (= g previous-gesture)) (= log-mode 1) (not (= g previous-gesture))
:else true)) :else true))
@ -312,15 +312,15 @@
(= log-mode 1) 3 (= log-mode 1) 3
:else 2))))) :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 ;; 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 ;; 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 ;; `> 255` / `> 15` / `> 0` — see the header for why they are spelled
;; this way. ;; this way.
(cond (cond
(pinch? g) (set current-angle (rl/get-gesture-pinch-angle)) (is-pinch g) (set current-angle (rl/get-gesture-pinch-angle))
(swipe? g) (set current-angle (rl/get-gesture-drag-angle)) (is-swipe g) (set current-angle (rl/get-gesture-drag-angle))
(not (= g :gesture-none)) (set current-angle 0.0) (not (= g :gesture-none)) (set current-angle 0.0)
:else (do)) :else (do))

4
examples/text-codepoints-loading.flan
View File

@ -94,7 +94,7 @@
(defonce unique-count i32) (defonce unique-count i32)
;; Is `cp` already in the first `n` of the table? ;; 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] (let [found false]
(dotimes [i n] (dotimes [i n]
(when (= (at unique-codepoints i) cp) (set found true))) (when (= (at unique-codepoints i) cp) (set found true)))
@ -113,7 +113,7 @@
(set unique-count 0) (set unique-count 0)
(dotimes [i (length codepoints)] (dotimes [i (length codepoints)]
(let [cp (at codepoints i)] (let [cp (at codepoints i)]
(when (and (not (seen? cp unique-count)) (when (and (not (is-seen cp unique-count))
(< unique-count max-codepoints)) (< unique-count max-codepoints))
(set (at unique-codepoints unique-count) cp) (set (at unique-codepoints unique-count) cp)
(set unique-count (+ unique-count 1)))))) (set unique-count (+ unique-count 1))))))

30
examples/text-rectangle-bounds.flan
View File

@ -57,14 +57,14 @@
(defconst measure 0) (defconst measure 0)
(defconst draw 1) (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; ;; 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 ;; 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 ;; index comes from raylib's own get-glyph-index so it is in range by
;; construction. ;; construction.
(defn draw-text-boxed [font rl/Font text [const u8] rec rl/Rectangle (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] () tint rl/Color] ()
(let [glyphs (rl/font-glyphs font) (let [glyphs (rl/font-glyphs font)
recs (rl/font-recs font) recs (rl/font-recs font)
@ -73,7 +73,7 @@
line-h (* (f32 (+ (.base-size font) (/ (.base-size font) 2))) scale) line-h (* (f32 (+ (.base-size font) (/ (.base-size font) 2))) scale)
off-x (f32 0.0) off-x (f32 0.0)
off-y (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. ;; 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 ;; -1 is "not decided yet", which is why end-line is compared against 1
;; rather than 0 below — the C's `(endLine < 1)`. ;; rather than 0 below — the C's `(endLine < 1)`.
@ -130,11 +130,11 @@
(do (do
(if (= cp (i32 \newline)) (if (= cp (i32 \newline))
(when (not word-wrap?) (when (not is-word-wrap)
(set off-y (+ off-y line-h)) (set off-y (+ off-y line-h))
(set off-x 0.0)) (set off-x 0.0))
(do (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-y (+ off-y line-h))
(set off-x 0.0)) (set off-x 0.0))
;; Out of vertical room: stop, rather than drawing outside. ;; Out of vertical room: stop, rather than drawing outside.
@ -147,7 +147,7 @@
(rl/Vector2 {.x (+ (.x rec) off-x) (rl/Vector2 {.x (+ (.x rec) off-x)
.y (+ (.y rec) off-y)}) .y (+ (.y rec) off-y)})
font-size tint)))) 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-y (+ off-y line-h))
(set off-x 0.0) (set off-x 0.0)
(set start-line end-line) (set start-line end-line)
@ -166,8 +166,8 @@
(defer (rl/close-window)) (defer (rl/close-window))
(let [text (bytes-view message) (let [text (bytes-view message)
resizing? false is-resizing false
word-wrap? true is-word-wrap true
container (rl/Rectangle {.x 25.0 .y 25.0 container (rl/Rectangle {.x 25.0 .y 25.0
.width (- (f32 screen-width) 50.0) .width (- (f32 screen-width) 50.0)
.height (- (f32 screen-height) 250.0)}) .height (- (f32 screen-height) 250.0)})
@ -184,18 +184,18 @@
(rl/set-target-fps 60) (rl/set-target-fps 60)
(until (rl/window-should-close) (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)] (let [mouse (rl/get-mouse-position)]
;; The border fades while the pointer is over the container. ;; The border fades while the pointer is over the container.
(cond (cond
(rl/check-collision-point-rec mouse container) (rl/check-collision-point-rec mouse container)
(set border (rl/fade rl/maroon 0.4)) (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 (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))) (let [w (+ (.width container) (- (.x mouse) (.x last-mouse)))
h (+ (.height container) (- (.y mouse) (.y last-mouse)))] h (+ (.height container) (- (.y mouse) (.y last-mouse)))]
(set (.width container) (set (.width container)
@ -204,7 +204,7 @@
(clamp h min-height max-height)))) (clamp h min-height max-height))))
(when (and (rl/is-mouse-button-down :mouse-left) (when (and (rl/is-mouse-button-down :mouse-left)
(rl/check-collision-point-rec mouse resizer)) (rl/check-collision-point-rec mouse resizer))
(set resizing? true))) (set is-resizing true)))
(set (.x resizer) (- (+ (.x container) (.width container)) 17.0)) (set (.x resizer) (- (+ (.x container) (.width container)) 17.0))
(set (.y resizer) (- (+ (.y container) (.height container)) 17.0)) (set (.y resizer) (- (+ (.y container) (.height container)) 17.0))
@ -221,7 +221,7 @@
.y (+ (.y container) 4.0) .y (+ (.y container) 4.0)
.width (- (.width container) 4.0) .width (- (.width container) 4.0)
.height (- (.height 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) (rl/draw-rectangle-rec resizer border)
@ -232,7 +232,7 @@
rl/maroon) rl/maroon)
(rl/draw-text "Word Wrap: " 313 (- screen-height 115) 20 rl/black) (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 "ON" 447 (- screen-height 115) 20 rl/red)
(rl/draw-text "OFF" 447 (- screen-height 115) 20 rl/black)) (rl/draw-text "OFF" 447 (- screen-height 115) 20 rl/black))

5
lib/ast.ml
View File

@ -83,6 +83,10 @@ and expr_kind =
A two-arm [match]: the arm is the pattern with [then] as its body, and 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. *) the else is the [_] arm. With no else it is a statement. *)
| IfLet of expr * arm * expr option | 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}) *) | 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 (* {.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 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) | Call (fn, args) -> Call (ex fn, List.map ex args)
| Match (s, arms) -> Match (ex s, List.map arm arms) | Match (s, arms) -> Match (ex s, List.map arm arms)
| IfLet (s, a, e) -> IfLet (ex s, arm a, Option.map ex e) | 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) | 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) | 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) | MapLit (tag, kvs) -> MapLit (tag, List.map (fun (k, v) -> (ex k, ex v)) kvs)

206
lib/check.ml
View File

@ -3264,6 +3264,10 @@ let close_over ~fname (octx : ctx) (fctx : ctx) loc =
crosses as ptr+len like any other. *) crosses as ptr+len like any other. *)
let here loc = mk loc Types.String (Tast.Str (Loc.to_string loc)) 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: (* 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 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 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.Match (scrutinee, arms) -> check_match ctx ~tail ~used ?want loc scrutinee arms
| Ast.IfLet (scrutinee, arm, els) -> | Ast.IfLet (scrutinee, arm, els) ->
check_if_let ctx ~tail ~used ?want loc 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 (* Constant integer arithmetic where a type variable is wanted is folded to
the literal it computes first, so [(+ x (+ 1 2))] is admitted wherever 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 [(+ 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. \ "the pattern _ always matches, so this if let has nothing to test. \
Use the value directly, or match on it" Use the value directly, or match on it"
in in
(match arm.Ast.pat with match arm.Ast.pat with
| Ast.Pwild -> irrefutable None | Ast.Pwild -> irrefutable None
| Ast.Pctor (n, []) when not (is_case n) -> irrefutable (Some n) | 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 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 (* 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 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 expect ctx loc ~want
(check_match ctx ~tail ~stmt:true loc scrutinee [ arm; wild [] ]) (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 ────────────────────────────────────────────────────────── *) (* ── Places ────────────────────────────────────────────────────────── *)
(* The fields a name has, whether it is a struct or an untagged union. The two (* 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. *) defn has everywhere else. *)
| _ when (not qualified) && shadows_builtin ctx loc name -> | _ when (not qualified) && shadows_builtin ctx loc name ->
ordinary_call ctx ~want loc name args 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 ─────────────────────────────────── *) (* ── arithmetic and comparison ─────────────────────────────────── *)
(* (- x) negates, Clojure's rule. A literal operand is the negative literal, (* (- 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 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 walked back on 2026-09-20, by the author: a numeric argument at a
variable an earlier argument already bound resolves the variable variable an earlier argument already bound resolves the variable
to whichever of the pair the other widens into, value-preserving 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 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 refused: there is no type that holds every value of both, and
inventing one would be picking a type neither argument was 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 \ "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) \ is the whole of map iteration: (while (map-next m (addr cur) (addr k) \
(addr v)) ...)."); (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", ("has-key", "has-key [(Map K V) K] bool",
"Whether the key is present, copying no value — the form a condition \ "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 \ 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) -> | Ast.IfLet (_, a, b) ->
(match List.rev a.Ast.body with x :: _ -> tails x | [] -> ()); (match List.rev a.Ast.body with x :: _ -> tails x | [] -> ());
Option.iter tails b Option.iter tails b
| Ast.Chain (_, _, b) -> tails b
| Ast.Match (_, arms) -> | Ast.Match (_, arms) ->
List.iter List.iter
(fun (a : Ast.arm) -> (fun (a : Ast.arm) ->

1
lib/emit.ml
View File

@ -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_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_restart_unarmed(ptr, i64, ptr, i64, ptr, i64) noreturn cold
declare void @flan_transfer_fail(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 ; Not noreturn: each signals BoundsError and returns when something answered
; it, which is the one path out. The trailing ptr is the transfer channel. ; 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 declare void @flan_bounds_error(ptr, i64, i64, i64, ptr) cold

228
lib/indent_reader.ml
View File

@ -25,6 +25,8 @@ type tok =
| UNQ | SPLICE (* ~ and ~@ *) | UNQ | SPLICE (* ~ and ~@ *)
| BNOT (* ~~, bit-not; a nested unquote is ~(~x) *) | BNOT (* ~~, bit-not; a nested unquote is ~(~x) *)
| NEG (* the - glued to the front of a name *) | 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 | NEWLINE | INDENT | DEDENT | EOF
type token = { tok : tok; loc : Loc.t; sp : bool (* whitespace before it *) } 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 | DATUM f -> Form.to_source f
| LP -> "(" | RP -> ")" | LB -> "[" | RB -> "]" | LC -> "{" | RC -> "}" | LP -> "(" | RP -> ")" | LB -> "[" | RB -> "]" | LC -> "{" | RC -> "}"
| COMMA -> "," | COLON -> ":" | UNQ -> "~" | SPLICE -> "~@" | BNOT -> "~~" | NEG -> "-" | COMMA -> "," | COLON -> ":" | UNQ -> "~" | SPLICE -> "~@" | BNOT -> "~~" | NEG -> "-"
| QUEST -> "?" | BANG -> "!"
| NEWLINE -> "the end of the line" | NEWLINE -> "the end of the line"
| INDENT -> "an indented line" | INDENT -> "an indented line"
| DEDENT -> "the end of the block" | 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_n = ref 0
let cmp_fresh () = incr cmp_n; Printf.sprintf "~cmp%d" !cmp_n 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 (* A [-] glued to one of these starts a negation: [-x] is [(- x)]. Anything
else keeps the Lisp reading, so [--], [->] and [-=] stay names. *) else keeps the Lisp reading, so [--], [->] and [-=] stay names. *)
let is_neg_char c = let is_neg_char c =
@ -168,6 +174,62 @@ let split_fields text =
then [ text ] then [ text ]
else segs 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 ────────────────────────────────────────────────────────── *) (* ── Lexing ────────────────────────────────────────────────────────── *)
let lex ?(line = 1) ?(col = 1) ~file src : token list = 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) if text.[n - 1] = ':' then (String.sub text 0 (n - 1), true)
else (text, false) else (text, false)
in in
let bn = String.length body in let plain col body =
let bcol, body = let bn = String.length body in
if bn > 1 && body.[0] = '-' && is_neg_char body.[1] then begin let bcol, body =
emit NEG (piece line col 1); if bn > 1 && body.[0] = '-' && is_neg_char body.[1] then begin
(col + 1, String.sub body 1 (bn - 1)) emit NEG (piece line col 1);
end (col + 1, String.sub body 1 (bn - 1))
else (col, body) 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 in
let off = ref 0 in (* [.b.c] after a [?] or a [!]: one field access per segment. *)
List.iteri let fields col s =
(fun i seg -> let segs = String.split_on_char '.' (String.sub s 1 (String.length s - 1)) in
let s = if i = 0 then seg else "." ^ seg in if List.mem "" segs then emit (NAME s) (piece line col (String.length s))
emit (NAME s) (piece line (bcol + !off) (String.length s)); else
off := !off + String.length s) List.fold_left
(split_fields body); (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) if colon then emit COLON (piece line (col + n - 1) 1)
end end
in in
@ -866,7 +1005,7 @@ and binary p lvl : Form.t * int =
else if lvl > 10 then unary p else if lvl > 10 then unary p
else else
let l0 = (peek p).loc in 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 = let close op operands =
match List.rev operands with match List.rev operands with
| [ x ] -> (x, lvl) | [ 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 \ "%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" side: a %s b. Without them a-b is one name"
s s; s s;
let rhs, _ = binary p (lvl + 1) in let rhs, _ = operand p lvl in
(ot, rhs) (ot, rhs)
in in
let rec run op operands = 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 ] | NAME s when binary_here s -> run s [ first ]
| _ -> fst_ | _ -> 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 = and not_ p =
let t = peek p in let t = peek p in
match t.tok with match t.tok with
@ -987,6 +1151,33 @@ and postfix p =
ignore (advance p); ignore (advance p);
let m = map_items p t.loc in 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) 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 | _ -> fp
in in
loop (primary p) 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 snippet = col <> None in
let col = Option.value col ~default:1 in let col = Option.value col ~default:1 in
let saved = !source 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; cmp_n := 0;
opt_n := 0;
(* The quoted text is indexed by the buffer's lines, so a snippet that (* The quoted text is indexed by the buffer's lines, so a snippet that
starts on line 40 is padded to start there. *) starts on line 40 is padded to start there. *)
source := source :=
(file, Array.of_list (String.split_on_char '\n' (file, Array.of_list (String.split_on_char '\n'
(String.make (line - 1) '\n' ^ String.make (col - 1) ' ' ^ src))); (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 toks = layout ~snippet ~base:col ?indent (lex ~line ~col ~file src) in
let s = { p = { toks; i = 0; closed = -1 }; lets = [] } 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 (* At the top level, a [let] is a global, [(def x dyn v)]: a let there has

10
lib/load.ml
View File

@ -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 with Ast.body = List.map (rename_expr owned alias bound)
a.Ast.body }) arms) a.Ast.body }) arms)
| Ast.IfLet (sc, a, e') -> | Ast.IfLet (sc, a, e') ->
(* A plain name, [if let g = x], binds [g] as [Some g] would. *)
let inner = 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 in
Ast.IfLet (go sc, Ast.IfLet (go sc,
{ a with Ast.body = List.map (rename_expr owned alias inner) { a with Ast.body = List.map (rename_expr owned alias inner)
a.Ast.body }, a.Ast.body },
Option.map go e') 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. (* A quoted symbol naming something the package declares.
[(Form.Sym {.s "Cursor"})] is what a quasiquote desugars to, and it is [(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 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) -> | Ast.Match (sc, arms) ->
go sc; List.iter (fun (a : Ast.arm) -> gos a.Ast.body) 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.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) -> | Ast.Struct (n, kvs) ->
acc := (n, e.Ast.loc) :: !acc; acc := (n, e.Ast.loc) :: !acc;
List.iter (fun (_, v) -> go v) kvs List.iter (fun (_, v) -> go v) kvs

6
lib/parse.ml
View File

@ -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 \ fail f "if-let is (if-let [pattern value] then) or \
(if-let [pattern value] then else)") (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. *) (* Short-circuiting, so they cannot be ordinary calls. *)
| Sym "and" -> shortcircuit f args ~is_and:true | Sym "and" -> shortcircuit f args ~is_and:true
| Sym "or" -> shortcircuit f args ~is_and:false | Sym "or" -> shortcircuit f args ~is_and:false

16
lib/prelude.ml
View File

@ -430,12 +430,12 @@ let source = {flan|
(set i (+ i 1))))) (set i (+ i 1)))))
;; The same insertion sort, with the one comparison it had written in replaced ;; 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 ;; (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. ;; 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 ;; 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 before? that is not a ;; 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 ;; 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 ;; 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. ;; 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 ;; 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 ;; predicates existed, and it stays because passing a comparison is a real
;; thing to want and not only a workaround. ;; 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] (let [i 1]
(while (< i (length s)) (while (< i (length s))
(let [j i] (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) (swap s (- j 1) j)
(set j (- j 1)))) (set j (- j 1))))
(set i (+ i 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 ;; 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 ;; runtime needed no change at all, because SizeOf and AlignOf are computed at
;; the instantiation site, where the element type is concrete. ;; 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)] (let [v (vec-new $t)]
(dotimes [i (length s)] (dotimes [i (length s)]
(when (keep? (at s i)) (when (is-keep (at s i))
(push v (at s i)))) (push v (at s i))))
v)) v))
@ -2375,7 +2375,7 @@ let source = {flan|
;; ── into: a fused transformation, and not a transducer ──────────────── ;; ── 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 ;; 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 ;; — take this, put it there, doing these — and the variadic tail has to trail

9
runtime/flan_rt.c
View File

@ -2462,6 +2462,15 @@ _Noreturn void flan_free_all_fail(const uint8_t *loc, int64_t loclen) {
rt_trap((const uint8_t *)"NoFreeAll", 9); 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 ─────────────── /* ── The region requirement, spec-memory.md's arena rule ───────────────
* *
* A container whose elements themselves own storage — a `(Vec Value)` where a * A container whose elements themselves own storage — a `(Vec Value)` where a

10
sand.flan
View File

@ -55,12 +55,12 @@
(set (at velocity y col) vel) (set (at velocity y col) vel)
(set (at velocity row col) 0.0) (set (at velocity row col) 0.0)
(return)) (return))
(let [left? (and (> col 0) (= 0 (at grid y (- col 1)))) (let [is-left (and (> col 0) (= 0 (at grid y (- col 1))))
right? (and (< col (- cols 1)) (= 0 (at grid y (+ col 1))))] is-right (and (< col (- cols 1)) (= 0 (at grid y (+ col 1))))]
(when (or left? right?) (when (or is-left is-right)
(let [side (cond (let [side (cond
(not left?) 1 (not is-left) 1
(not right?) -1 (not is-right) -1
:else (if (< (f32 (rand)) 0.5) 1 -1))] :else (if (< (f32 (rand)) 0.5) 1 -1))]
(set (at grid y (+ col side)) (at grid row col)) (set (at grid y (+ col side)) (at grid row col))
(set (at grid row col) 0) (set (at grid row col) 0)

30
spec-syntax.md
View File

@ -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 rename). `a - b` is subtraction. `a -1` is an error: "separate with a comma or
space the minus". **Built.** space the minus". **Built.**
- **`->` needs spaces as the return arrow.** `dyn->f64` stays a name. **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: - **Character literals stay `\c`**, lexed before brackets and operators:
`\(`, `\,`, `\space`. 277 uses, many of them delimiters of the new syntax. `\(`, `\,`, `\space`. 277 uses, many of them delimiters of the new syntax.
**Built.** **Built.**
@ -159,8 +164,8 @@ Each item: the proposal, then the reason in one line.
### Expressions ### Expressions
- **Precedence**, low to high: `or` < `and` < `not` < comparisons - **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 glued to `(` is always a call. The bit operators sit where Python and Rust
put them, so `x && mask == 0` is `(x && mask) == 0`. put them, so `x && mask == 0` is `(x && mask) == 0`.
- **The bit operators** are `a && b`, `a || b`, `a ^^ b` and `~~a`, reading - **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.** - **`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` 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. `(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)`, - **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 `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.** 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. `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. 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 `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 line: `if let Some(g) = o then g else 0`. A plain name, `if let g = o`,
plain name or `_`, is refused toward `let`. **Built.** 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.** - **`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 - **`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 `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: 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)`, `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`, `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). value, `vec-new(Fn([i32], i32))` is the call spelling).
### Macro templates ### Macro templates

2
test/programs/assets/edn/tuning.edn
View File

@ -4,7 +4,7 @@
{:name "goblin" {:name "goblin"
:hp 12 :hp 12
:speed 1.5 :speed 1.5
:boss? false :is-boss false
:drops [3 1 4 1 5] :drops [3 1 4 1 5]
:hitbox {:w 16 :hitbox {:w 16
:h 24 :h 24

26
test/programs/dyn-if-truthy.flan
View File

@ -34,7 +34,7 @@
;; to (a bare 0 is an i32 until something wants it as dyn). ;; to (a bare 0 is an i32 until something wants it as dyn).
(defn box [x] dyn x) (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 ;; 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 ;; 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 ;; 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 ;; calls truthy that C or Python would not: 0, "", an empty vec, an empty
;; map, a keyword. ;; map, a keyword.
(println (truthy? nil)) (println (is-truthy nil))
(println (truthy? false)) (println (is-truthy false))
(println (truthy? true)) (println (is-truthy true))
(println (truthy? 0)) (println (is-truthy 0))
(println (truthy? 7)) (println (is-truthy 7))
(println (truthy? "")) (println (is-truthy ""))
(println (truthy? "x")) (println (is-truthy "x"))
(println (truthy? (vec-new dyn))) (println (is-truthy (vec-new dyn)))
(let [xs (vec-new dyn)] (let [xs (vec-new dyn)]
(push xs 1) (push xs 1)
(println (truthy? xs))) (println (is-truthy xs)))
(let [m {}] (let [m {}]
(println (truthy? m))) (println (is-truthy m)))
(println (truthy? {:a 1})) (println (is-truthy {:a 1}))
(println (truthy? :kw)) (println (is-truthy :kw))
;; when: sugar for a one-armed if, so nil/false skip the body and every ;; when: sugar for a one-armed if, so nil/false skip the body and every
;; other dyn value -- 0 and "" included -- runs it. ;; other dyn value -- 0 and "" included -- runs it.

8
test/programs/edn-provide.flan
View File

@ -46,7 +46,7 @@
(println (.name t)) (println (.name t))
(println (.hp t)) (println (.hp t))
(println (.speed t)) (println (.speed t))
(println (if (.boss? t) "yes" "no")) (println (if (.is-boss t) "yes" "no"))
(println (length (.drops t))) (println (length (.drops t)))
;; 3 + 1 + 4 + 1 + 5. A vector read that stopped at the first element would ;; 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. ;; still have a plausible length from a zeroed Vec, so the sum is the claim.
@ -63,16 +63,16 @@
;; ── Drift ─────────────────────────────────────────────────────────── ;; ── 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 ;; :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. ;; tuning file looks like a month after the program was built.
(defconst drifted str (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] () (defn show-drift [a Allocator] ()
(handler-bind (handler-bind
[(edn/SchemaDrift [d] [(edn/SchemaDrift [d]
(do (print (if (.extra? d) "extra " "missing ")) (do (print (if (.is-extra d) "extra " "missing "))
(print (.field d)) (print (.field d))
(print " in ") (print " in ")
(println (.struct d))))] (println (.struct d))))]

8
test/programs/edn-read.flan
View File

@ -30,7 +30,7 @@
;;;; What dyn cannot say and the old (Option Value) could: `read` answers nil ;;;; 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 ;;;; 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 ;;;; 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") (import edn "vendor:edn")
@ -59,7 +59,7 @@
;; Malformed input, told apart from the document `nil` by the cursor — the ;; 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. ;; 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)) (let [c (edn/cursor (bytes-view src))
t (edn/next (addr c)) t (edn/next (addr c))
v (edn/read-value (addr c) t)] ; the value is not the question here v (edn/read-value (addr c) t)] ; the value is not the question here
@ -141,8 +141,8 @@
(survives-its-buffer) (survives-its-buffer)
;; And the refusal, told apart from the document that is literally nil. ;; And the refusal, told apart from the document that is literally nil.
(println (malformed? "#{1 2")) (println (is-malformed "#{1 2"))
(println (malformed? "nil")) (println (is-malformed "nil"))
(println "") (println "")
(by-path) (by-path)

14
test/programs/edn.flan
View File

@ -77,7 +77,7 @@
[name [const u8] [name [const u8]
hp i32 hp i32
speed f32 speed f32
boss? bool]) is-boss bool])
;; The shape the compiler-emitted version will have: open the map, loop on the ;; 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 ;; 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 ;; rather than being returned, which is why this can be a straight line of
;; assignments with one test at the end. ;; assignments with one test at the end.
(defn read-enemy [c (Ptr edn/Cursor)] Enemy (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) (edn/expect c edn/tok-map-open)
(while (edn/is-ok c) (while (edn/is-ok c)
(let [k (edn/next c)] (let [k (edn/next c)]
@ -111,8 +111,8 @@
(Some x) (set (.speed e) (f32 x)) (Some x) (set (.speed e) (f32 x))
None (edn/fail c edn/err-unexpected-token (.pos v)))) None (edn/fail c edn/err-unexpected-token (.pos v))))
(edn/is-keyword-equal k "boss?") (edn/is-keyword-equal k "is-boss")
(set (.boss? e) (match (edn/bool-of (edn/expect c edn/tok-bool)) (set (.is-boss e) (match (edn/bool-of (edn/expect c edn/tok-bool))
(Some v) v None false)) (Some v) v None false))
;; An unknown key: read past its value, however big it is. ;; An unknown key: read past its value, however big it is.
@ -134,7 +134,7 @@
(print " speed=") (print " speed=")
(print (.speed e)) (print (.speed e))
(print " boss=") (print " boss=")
(print (if (.boss? e) "yes" "no"))) (print (if (.is-boss e) "yes" "no")))
(do (do
(print "ERR@") (print "ERR@")
(print (edn/error-pos (addr c))) (print (edn/error-pos (addr c)))
@ -243,10 +243,10 @@
(println "") (println "")
;; ── The struct reader ───────────────────────────────────────────── ;; ── 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 ;; 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. ;; 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 ;; 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 ;; 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. ;; that a `#{` pushing nothing would leave the map open and swallow :hp.

12
test/programs/enum-compare.flan
View File

@ -8,18 +8,18 @@
(defstruct S [k K]) (defstruct S [k K])
(defn eq? [k K] bool (= k :mid)) (defn is-eq [k K] bool (= k :mid))
(defn below? [k K] bool (< k :mid)) (defn is-below [k K] bool (< k :mid))
(defn main [] i32 (defn main [] i32
;; Equality, both ways round. ;; Equality, both ways round.
(println (if (eq? :mid) "eq yes" "eq no")) (println (if (is-eq :mid) "eq yes" "eq no"))
(println (if (eq? :hi) "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 ;; Ordering, and signed: lo is -1, so an unsigned compare would call it the
;; largest member and answer the other way. ;; largest member and answer the other way.
(println (if (below? :lo) "lo below mid" "lo not below mid")) (println (if (is-below :lo) "lo below mid" "lo not below mid"))
(println (if (below? :hi) "hi below mid" "hi 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. ;; And through a struct field, which is a different path to the same compare.
(let [s (S {.k :hi})] (let [s (S {.k :hi})]

8
test/programs/enum-generic.flan
View File

@ -9,11 +9,11 @@
{:where (is-enum $t)} {:where (is-enum $t)}
(i32 x)) (i32 x))
(defn later? [a $t b $t] bool (defn is-later [a $t b $t] bool
{:where (is-enum $t)} {:where (is-enum $t)}
(> a b)) (> a b))
(defn same? [a $t b $t] bool (defn is-same [a $t b $t] bool
{:where (is-enum $t)} {:where (is-enum $t)}
(and (= a b) (<= a b))) (and (= a b) (<= a b)))
@ -22,7 +22,7 @@
s (Size 20)] s (Size 20)]
(println (code c)) ; 2 (println (code c)) ; 2
(println (code s)) ; 20 (println (code s)) ; 20
(println (later? c (Color 0))) ; true (println (is-later c (Color 0))) ; true
(println (same? (Color 1) (Color 1))) ; true (println (is-same (Color 1) (Color 1))) ; true
(println (f64 (code s)))) ; 20 (println (f64 (code s)))) ; 20
0) 0)

4
test/programs/fn-values.flan
View File

@ -30,10 +30,10 @@
;; A comparator, which is the other half of what was blocked: a sort that is ;; 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 ;; told the order rather than having it written in. Insertion sort, because the
;; point here is the parameter and not the algorithm. ;; 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)] (dotimes [i (length xs)]
(let [j i] (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)) (swap xs j (- j 1))
(set j (- j 1)))))) (set j (- j 1))))))

6
test/programs/generic-map-reject.flan
View File

@ -13,7 +13,7 @@
;;;; author wrote down, at the call that asked for it. A float is that type: ;;;; 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 ;;;; NaN is not equal to itself, and 0.0 and -0.0 are equal while differing
;;;; bytewise. ;;;; bytewise.
(defn seen? [k $t] bool (defn is-seen [k $t] bool
{:where (is-hashable $t)} {:where (is-hashable $t)}
(let [m (map-new t i32)] (let [m (map-new t i32)]
(put m k 1) (put m k 1)
@ -22,5 +22,5 @@
answer))) answer)))
(defn main [] () (defn main [] ()
(println (seen? 3)) (println (is-seen 3))
(println (seen? 1.5))) (println (is-seen 1.5)))

18
test/programs/generics.flan
View File

@ -67,9 +67,9 @@
;; The -t? suffix is because the prelude now carries pos?/neg?/is-zero itself. ;; 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 ;; 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. ;; 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 is-pos-t [x $t] bool {:where (is-numeric $t)} (> x 0))
(defn neg-t? [x $t] bool {:where (is-numeric $t)} (< x 0)) (defn is-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-zero-t [x $t] bool {:where (is-numeric $t)} (= x 0))
;; The same literal in arithmetic rather than comparison, and answering $t ;; 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 ;; 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 ;; 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 ;; written bodies. i32, i64, u8, u16, f32 and f64 all reach the same 0 and
;; the same 1. ;; the same 1.
(println (pos-t? 3)) (println (is-pos-t 3))
(println (neg-t? (i8 -3))) (println (is-neg-t (i8 -3)))
(println (zero-t? (u8 0))) (println (is-zero-t (u8 0)))
(println (zero-t? 0.0)) (println (is-zero-t 0.0))
(println (pos-t? (u16 1))) (println (is-pos-t (u16 1)))
(println (neg-t? (f32 -0.5))) (println (is-neg-t (f32 -0.5)))
(println (next-after 3)) (println (next-after 3))
(println (next-after (i64 10))) (println (next-after (i64 10)))
(println (next-after 2.5)) (println (next-after 2.5))

8
test/programs/higher-order.flan
View File

@ -5,11 +5,11 @@
;; name or written inline. ;; name or written inline.
(defn triple [x i32] i32 (* x 3)) (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 adds [a i32 b i32] i32 (+ a b))
(defn longer-first [a i32 b i32] bool (> a b)) (defn longer-first [a i32 b i32] bool (> a b))
(defn halve [x f32] f32 (/ x 2.0)) (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 (defn main [] i32
;; map-in-place writes back into the slice it was handed. ;; 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 "") (print (reduce s 1 (fn [a b] (* a b)))) (println "")
;; filter allocates and the caller frees. ;; 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 "") (print (length v)) (print " ") (print (at v 0)) (println "")
(free v)) (free v))
@ -42,7 +42,7 @@
(map-in-place t halve) (map-in-place t halve)
(print (at t 0)) (print " ") (print (at t 2)) (println "") (print (at t 0)) (print " ") (print (at t 2)) (println "")
(print (reduce t 0.0 (fn [a b] (+ a b)))) (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 "") (print (length w)) (println "")
(free w)) (free w))
(sort-by t (fn [a b] (> a b))) (sort-by t (fn [a b] (> a b)))

16
test/programs/int-generic.flan
View File

@ -22,7 +22,7 @@
(bit-and x (- (<< 1 n) 1))) (bit-and x (- (<< 1 n) 1)))
;; Truncated %, the semantics everywhere in the language, in a generic body. ;; 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)} {:where (is-integer $t)}
(= (% x 2) 0)) (= (% x 2) 0))
@ -45,8 +45,8 @@
{:where (is-integer $t)} {:where (is-integer $t)}
(+ x 300)) (+ x 300))
;; The join family. eq2? is the pair the refusal used to be pinned on. ;; The join family. is-eq2 is the pair the refusal used to be pinned on.
(defn eq2? [a $t b $t] bool (defn is-eq2 [a $t b $t] bool
{:where (is-equal $t)} {:where (is-equal $t)}
(= a b)) (= a b))
@ -115,9 +115,9 @@
(println (low-bits 255 3)) (println (low-bits 255 3))
(println (low-bits (u16 65535) (u16 4))) (println (low-bits (u16 65535) (u16 4)))
(println (low-bits (i64 1023) (i64 5))) (println (low-bits (i64 1023) (i64 5)))
(println (even? 4)) (println (is-even 4))
(println (even? (u8 3))) (println (is-even (u8 3)))
(println (even? (i64 -2))) (println (is-even (i64 -2)))
(println (toggle (u8 255) (u8 15))) (println (toggle (u8 255) (u8 15)))
(println (with-flag 8 1)) (println (with-flag 8 1))
(println (halve (u64 10))) (println (halve (u64 10)))
@ -128,8 +128,8 @@
;; The join: both orders, one copy, one answer. ;; The join: both orders, one copy, one answer.
(let [a (i8 3) (let [a (i8 3)
b (i64 3)] b (i64 3)]
(println (eq2? a b)) (println (is-eq2 a b))
(println (eq2? b a))) (println (is-eq2 b a)))
(let [x (u32 1) (let [x (u32 1)
y (i32 2) y (i32 2)
z (i64 3)] z (i64 3)]

14
test/programs/into.flan
View File

@ -4,7 +4,7 @@
;;;; comes out is one loop, and the values it produces are the ones the chain ;;;; comes out is one loop, and the values it produces are the ones the chain
;;;; describes in the order it was written. ;;;; 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 ;;;; before (map double) is not the same program as after it, and both are
;;;; here with different answers. ;;;; here with different answers.
;;;; 2. There is no intermediate collection. `pulls` counts every call to the ;;;; 2. There is no intermediate collection. `pulls` counts every call to the
@ -21,7 +21,7 @@
(set pulls (+ pulls 1)) (set pulls (+ pulls 1))
(* x 2)) (* x 2))
(defn even? [x i32] bool (defn is-even [x i32] bool
(set pulls (+ pulls 1)) (set pulls (+ pulls 1))
(= (% x 2) 0)) (= (% x 2) 0))
@ -36,7 +36,7 @@
(slice xs 0 (length xs))) (slice xs 0 (length xs)))
(defn wide [x i32] f32 (f32 x)) (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]] () (defn show [v [i32]] ()
(dotimes [i (length v)] (print (at v i)) (print " ")) (dotimes [i (length v)] (print (at v i)) (print " "))
@ -51,14 +51,14 @@
;; map then filter. ;; map then filter.
(let [xs [1 2 3 4 5 6] (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 (show (slice v)) ; 2 4 6 8 10 12
(free v)) (free v))
;; filter then map, over the same source: a different answer, because the ;; filter then map, over the same source: a different answer, because the
;; stages are in the order they were written. ;; stages are in the order they were written.
(let [xs [1 2 3 4 5 6] (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 (show (slice v)) ; 4 8 12
(free v)) (free v))
@ -79,7 +79,7 @@
;; shadowed — a let binding's value is checked before its name is bound, so ;; shadowed — a let binding's value is checked before its name is bound, so
;; each stage reads the stage before it. ;; each stage reads the stage before it.
(let [xs [1 2 3 4] (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 " ")) (dotimes [i (length v)] (print (at v i)) (print " "))
(println "") ; 3 4 (println "") ; 3 4
(free v)) (free v))
@ -87,7 +87,7 @@
;; A source that is a call is bound once, so it is made once however many ;; A source that is a call is bound once, so it is made once however many
;; elements come out of it. ;; elements come out of it.
(let [xs [1 2 3 4] (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 (show (slice v)) ; 2 4
(free v)) (free v))
(print builds) (println "") ; 1 (print builds) (println "") ; 1

2
test/programs/json-provide.flan
View File

@ -41,7 +41,7 @@
;; and these bytes do not, and they carry a "host" it has never heard of. ;; and these bytes do not, and they carry a "host" it has never heard of.
(handler-bind (handler-bind
[(json/SchemaDrift [d] [(json/SchemaDrift [d]
(do (print (if (.extra? d) "extra " "missing ")) (do (print (if (.is-extra d) "extra " "missing "))
(print (.field d)) (print (.field d))
(print " in ") (print " in ")
(println (.struct d))))] (println (.struct d))))]

8
test/programs/limits.flan
View File

@ -49,10 +49,10 @@
;; An infinity is a value that equals its own double and is not zero — the ;; 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 ;; same test format-f64 in the prelude uses, and the only one available with
;; no infinity literal to compare against. ;; 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))) (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)))) (and (= x (* x (f32 2.0))) (!= x (f32 0.0))))
(defn say [name str ok bool] () (defn say [name str ok bool] ()
@ -112,8 +112,8 @@
;; finite above it. ;; finite above it.
(say "f32-max" (= f32-max (* (p2-f32 127) (- (f32 2.0) (p2-f32 -23))))) (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 "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 "f32-max is the last finite f32" (is-inf-f32 (* f32-max (f32 2.0))))
(say "f64-max is the last finite f64" (inf-f64? (* f64-max 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 ;; 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 ;; the absence is recorded rather than merely unmentioned: a float's least

6
test/programs/match-bool.flan
View File

@ -4,7 +4,7 @@
(defn truth [n i32] bool (> n 0)) (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. ;; Exhaustive without a _ arm: true and false are every bool.
(defn word [b bool] str (defn word [b bool] str
@ -37,8 +37,8 @@
(let [f (Flag {.on true}) (let [f (Flag {.on true})
g (Flag {.on false}) g (Flag {.on false})
flags [true false true]] flags [true false true]]
(print (same? true true)) (print " ") (print (is-same true true)) (print " ")
(print (same? true false)) (print " ") (print (is-same true false)) (print " ")
(print (!= true false)) (print " ") (print (!= true false)) (print " ")
(print (= (.on f) (truth 3))) (print " ") (print (= (.on f) (truth 3))) (print " ")
(print (= (.on g) (truth 3))) (print " ") (print (= (.on g) (truth 3))) (print " ")

38
test/programs/optionals-dyn.fln Normal file
View 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
View 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
View 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)

2
test/programs/pkgs/draw/draw.flan
View File

@ -6,4 +6,4 @@
(import shape "../shape") (import shape "../shape")
(defn describe [b shape/Box] i32 (defn describe [b shape/Box] i32
(if (shape/wide? b) (.w b) (.h b))) (if (shape/is-wide b) (.w b) (.h b)))

2
test/programs/pkgs/shape/shape.flan
View File

@ -9,4 +9,4 @@
(defn box [w i32 h i32] Box (Box {.w w .h h})) (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)))

4
test/programs/prelude-names.flan
View File

@ -7,12 +7,12 @@
(defstruct k [x i32]) (defstruct k [x i32])
(defenum v [lo hi]) (defenum v [lo hi])
(defn even? [x i32] bool (= (% x 2) 0)) (defn is-even [x i32] bool (= (% x 2) 0))
(defn main [] i32 (defn main [] i32
(set (at t 0) 7) (set (at t 0) 7)
(let [xs [1 2 3 4 5 6] (let [xs [1 2 3 4 5 6]
evens (filter (slice xs) even?)] evens (filter (slice xs) is-even)]
(println (length evens)) ; 3 (println (length evens)) ; 3
(println (at evens 2)) ; 6 (println (at evens 2)) ; 6
(free evens)) (free evens))

4
test/programs/raylib-audio.flan
View File

@ -94,7 +94,7 @@
;; levels, so printing the float would pin raylib's choice of divisor rather ;; 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 ;; than Flan's field order. Nothing is lost: a permuted layout is not out by a
;; rounding step, it reads a different buffer. ;; 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)] (let [d (- a b)]
(< (if (< d 0.0) (- 0.0 d) d) 0.0005))) (< (if (< d 0.0) (- 0.0 d) d) 0.0005)))
@ -122,7 +122,7 @@
v))) v)))
(defn show-frame [name str w rl/Wave i i32 want f32] () (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 (defn main [] i32
(rl/set-trace-log-level :log-warning) (rl/set-trace-log-level :log-warning)

4
test/programs/raylib-ffi.flan
View File

@ -67,13 +67,13 @@
;; risk worth naming: a permuted layout is out by whole units. Swapping x and ;; 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 ;; y in Vector2 makes this print "rotated bad" — the same camera then reads
;; back as (-12,24). ;; back as (-12,24).
(defn near? [a f32 b f32] bool (defn is-near [a f32 b f32] bool
(let [d (- a b)] (let [d (- a b)]
(< (if (< d 0.0) (- 0.0 d) d) 0.0001))) (< (if (< d 0.0) (- 0.0 d) d) 0.0001)))
(defn show-near [name str v rl/Vector2 x f32 y f32] () (defn show-near [name str v rl/Vector2 x f32 y f32] ()
(print name) (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 (defn main [] i32
(rl/set-trace-log-level :log-warning) (rl/set-trace-log-level :log-warning)

6
test/programs/shim-literal.flan
View File

@ -20,14 +20,14 @@
(declare-c c-where2 [s str c Ch] i64 "__xpg_basename") (declare-c c-where2 [s str c Ch] i64 "__xpg_basename")
(declare-c c-puts [s str] i32 "puts") (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)] (let [d (- a b)]
(> (if (< d 0) (- 0 d) d) 1048576))) (> (if (< d 0) (- 0 d) d) 1048576)))
(defn main [] i32 (defn main [] i32
(let [s "hello"] (let [s "hello"]
(println (far? (c-where "hello") (c-where s))) (println (is-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-where2 "hello" (Ch {.c 104})) (c-where2 s (Ch {.c 104}))))
(c-puts "hello") (c-puts "hello")
(c-puts "") (c-puts "")
(c-puts (str (slice (bytes-view "hello world") 0 3)))) (c-puts (str (slice (bytes-view "hello world") 0 3))))

4
test/programs/vec-global.flan
View File

@ -15,10 +15,10 @@
;; Reading it here is a borrow. So is reading it in [total] below, which is the ;; 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 ;; 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. ;; 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 [] () (defn load [] ()
(when (not (loaded?)) (when (not (is-loaded))
(set the-data (vec-new u8)) (set the-data (vec-new u8))
(dotimes [i 5] (push the-data (u8 (* i 3)))))) (dotimes [i 5] (push the-data (u8 (* i 3))))))

4
test/programs/x86-p3-fizz.flan
View File

@ -1,10 +1,10 @@
(defn fizz? [n i32] bool (defn is-fizz [n i32] bool
(= 0 (% n 3))) (= 0 (% n 3)))
(defn main [] i32 (defn main [] i32
(dotimes [i 15] (dotimes [i 15]
(let [n (+ i 1)] (let [n (+ i 1)]
(if (fizz? n) (if (is-fizz n)
(print "fizz") (print "fizz")
(print n)) (print n))
(println ""))) (println "")))

8
test/syntax/handwritten/inventory.fln
View File

@ -43,19 +43,19 @@ fn line(it: stock/Item) -> ()
print(".") print(".")
println(str(slice(price))) 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 let n = 0
for i in range(length(items)) for i in range(length(items))
if keep?(items[i]) if is-keep(items[i])
++(n) ++(n)
n n
fn main() -> i32 fn main() -> i32
let items = [stock/item("bolts", 12, 400), stock/item("nuts", 5, 3), let items = [stock/item("bolts", 12, 400), stock/item("nuts", 5, 3),
stock/item("gears", 1250, 7), stock/item("belts", 899, 0)] 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}] Rule{.label "valuable", .applies fn(it) => stock/value(it) > 5000}]
let frame = arena-new(4096) let frame = arena-new(4096)
repeat(pass, 2): repeat(pass, 2):

4
test/syntax/handwritten/ring.fln
View File

@ -11,7 +11,7 @@ struct Reading
sensor: u8 sensor: u8
value: i32 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.items[r.head] = x
r.head = (r.head + 1) % n r.head = (r.head + 1) % n
if r.count < n if r.count < n
@ -68,7 +68,7 @@ fn main() -> i32
for :fill i in range(length(samples)) for :fill i in range(length(samples))
if samples[i] > 10 if samples[i] > 10
continue :fill continue :fill
push-ring!(addr(r), samples[i]) push-ring(addr(r), samples[i])
let kept = copy-out(addr(r)) let kept = copy-out(addr(r))
defer free(kept) defer free(kept)
println("kept", slice(kept)) println("kept", slice(kept))

10
test/syntax/handwritten/rpn.fln
View File

@ -40,7 +40,7 @@ fn next-token(src: [const u8], pos: Ptr(i32)) -> Token
else else
Token.Word{.w text} 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.stack[m.depth] = v
m.depth += 1 m.depth += 1
@ -65,16 +65,16 @@ fn run(src: str) -> i64
while :tokens true while :tokens true
match next-token(text, addr(pos)) match next-token(text, addr(pos))
End -> break :tokens End -> break :tokens
Num(n) -> push!(addr(m), n) Num(n) -> push-num(addr(m), n)
Op(c) -> Op(c) ->
let b = small-pop(addr(m), c) let b = small-pop(addr(m), c)
let a = 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) -> Word(w) ->
if is-bytes-equal(w, bytes-view("dup")) if is-bytes-equal(w, bytes-view("dup"))
let v = small-pop(addr(m), \d) let v = small-pop(addr(m), \d)
push!(addr(m), v) push-num(addr(m), v)
push!(addr(m), v) push-num(addr(m), v)
elif is-bytes-equal(w, bytes-view("drop")) elif is-bytes-equal(w, bytes-view("drop"))
small-pop(addr(m), \d) small-pop(addr(m), \d)
continue continue

6
test/syntax/handwritten/words.fln
View File

@ -10,7 +10,7 @@ struct Count
word: [const u8] word: [const u8]
n: i32 n: i32
fn letter?(c: u8) -> bool fn is-letter(c: u8) -> bool
(c >= \a and c <= \z) (c >= \a and c <= \z)
or (c >= \A and c <= \Z) or (c >= \A and c <= \Z)
or c == \' or c == \'
@ -23,12 +23,12 @@ fn words(text: [const u8]) -> Vec([const u8])
i = 0 i = 0
n = length(lower) n = length(lower)
while :scan i < n while :scan i < n
until i >= n or letter?(lower[i]) until i >= n or is-letter(lower[i])
i += 1 i += 1
if i >= n if i >= n
break :scan break :scan
let start = i let start = i
while i < n and letter?(lower[i]) while i < n and is-letter(lower[i])
i += 1 i += 1
push(out, slice(lower, start, i)) push(out, slice(lower, start, i))
out out

4
test/syntax/mixed/main.fln
View File

@ -3,14 +3,14 @@
import geo "geo" 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 fn main() -> i32
let a = geo/pt(1, 2) let a = geo/pt(1, 2)
let b = geo/Pt{.x 4, .y 6} let b = geo/Pt{.x 4, .y 6}
println(geo/dist2(a, b)) println(geo/dist2(a, b))
println(a.x + b.y) println(a.x + b.y)
if far?(a, b, 4) if is-far(a, b, 4)
println("far") println("far")
else else
println("near") println("near")

10
test/syntax/sand.fln
View File

@ -58,13 +58,13 @@ fn settle(row: i32, col: i32) -> ()
velocity[y, col] = vel velocity[y, col] = vel
velocity[row, col] = 0.0 velocity[row, col] = 0.0
return return
let left? = col > 0 and 0 == grid[y, col - 1] let is-left = col > 0 and 0 == grid[y, col - 1]
let right? = col < cols - 1 and 0 == grid[y, col + 1] let is-right = col < cols - 1 and 0 == grid[y, col + 1]
if left? or right? if is-left or is-right
let side = let side =
if not left? if not is-left
1 1
elif not right? elif not is-right
-1 -1
else else
if f32(rand()) < 0.5 then 1 else -1 if f32(rand()) < 0.5 then 1 else -1

28
test/test_acceptance.ml
View File

@ -1694,7 +1694,7 @@ let () =
is written and not freed on purpose — a read of released memory can pass is written and not freed on purpose — a read of released memory can pass
by luck, and this cannot. 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 (Option Value) return carried, moved to the cursor now that read
answers nil for malformed input: the truncated set #{1 2 leaves the answers nil for malformed input: the truncated set #{1 2 leaves the
cursor not-ok and the document nil leaves it clean. cursor not-ok and the document nil leaves it clean.
@ -2264,6 +2264,32 @@ let () =
(try Sys.remove exe with Sys_error _ -> ())); (try Sys.remove exe with Sys_error _ -> ()));
outputs ~opt:"-O0" "if let, -O0" "programs/if-let.fln" if_let_out; 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; 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 (* format-f64, the first number formatter a caller can steer. The three
lines that would ship wrong are pinned deliberately: 0.999995 at five lines that would ship wrong are pinned deliberately: 0.999995 at five
places, where the rounded fraction equals the scale and is the next places, where the rounded fraction equals the scale and is the next

57
test/test_flan.ml
View File

@ -2894,8 +2894,8 @@ let () =
(* ── Names, order-independence, entry point ────────────────────── *) (* ── Names, order-independence, entry point ────────────────────── *)
accepts "mutually recursive, no forward declaration" accepts "mutually recursive, no forward declaration"
"(defn even? [n i32] bool (if (= n 0) true (odd? (- n 1)))) \ "(defn is-even [n i32] bool (if (= n 0) true (is-odd (- n 1)))) \
(defn odd? [n i32] bool (if (= n 0) false (even? (- 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 name" "(defn f [] i32 nope)" ~needle:"unknown name";
rejects_check "unknown function" "(defn f [] i32 (nope 1))" rejects_check "unknown function" "(defn f [] i32 (nope 1))"
~needle:"unknown function"; ~needle:"unknown function";
@ -6842,12 +6842,12 @@ let () =
accepts "is-integer admits <, via the entailment" accepts "is-integer admits <, via the entailment"
"(defn small? [x $t] bool {:where (is-integer $t)} (< x 10))"; "(defn small? [x $t] bool {:where (is-integer $t)} (< x 10))";
accepts "is-integer admits bit-and" 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" accepts "is-integer admits the shifts"
"(defn dbl [x $t] $t {:where (is-integer $t)} (<< x 1))"; "(defn dbl [x $t] $t {:where (is-integer $t)} (<< x 1))";
rejects_check "is-numeric does not admit bit-and" rejects_check "is-numeric does not admit bit-and"
~needle:"nothing declares $t is-integer" ~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" rejects_check "nor the shifts"
~needle:"nothing declares $t is-integer" ~needle:"nothing declares $t is-integer"
"(defn dbl [x $t] $t {:where (is-numeric $t)} (<< x 1))"; "(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" accepts "is-enum admits the conversion from an enum"
"(defn code [x $t] i32 {:where (is-enum $t)} (i32 x))"; "(defn code [x $t] i32 {:where (is-enum $t)} (i32 x))";
accepts "and compares, being is-ordered and is-equal" 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" rejects_check "but is not a number"
~needle:"$t" ~needle:"$t"
"(defn sum [a $t b $t] $t {:where (is-enum $t)} (+ a b))"; "(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 every value of both. TODO.org, "abs is one generic, and a bound joins to
the wider type". *) the wider type". *)
accepts "a scalar pair at one $t joins at 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 is-eq2 [a $t b $t] bool {:where (is-equal $t)} (= a b))\n\
(defn main [] () (println (eq2? (i64 3) (i8 3))))"; (defn main [] () (println (is-eq2 (i64 3) (i8 3))))";
accepts "and the other argument order joins identically" accepts "and the other argument order joins identically"
"(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\
(defn main [] () (println (eq2? (i8 3) (i64 3))))"; (defn main [] () (println (is-eq2 (i8 3) (i64 3))))";
(* Order-independence, pinned on the copies and not only on acceptance: (* Order-independence, pinned on the copies and not only on acceptance:
both orders in one program make exactly one instantiation, at i64, and both orders in one program make exactly one instantiation, at i64, and
none at i8. *) none at i8. *)
(let syms order_a order_b = (let syms order_a order_b =
match match
checked checked
("(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\
(defn main [] () (do (println (eq2? " ^ order_a ^ "))\ (defn main [] () (do (println (is-eq2 " ^ order_a ^ "))\
(println (eq2? " ^ order_b ^ "))))") (println (is-eq2 " ^ order_b ^ "))))")
with with
| p -> | p ->
List.filter_map List.filter_map
(fun (f : Tast.fn) -> (fun (f : Tast.fn) ->
if String.length f.Tast.name >= 4 if String.length f.Tast.name >= 6
&& String.sub f.Tast.name 0 4 = "eq2?" then Some f.Tast.name && String.sub f.Tast.name 0 6 = "is-eq2" then Some f.Tast.name
else None) else None)
p.Tast.fns p.Tast.fns
| exception _ -> [ "did not check" ] | exception _ -> [ "did not check" ]
in in
check "both orders share one copy, at the wider type" 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" 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 (* 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 nor i64 holds every value of the other, and inventing a third type
would be picking one neither argument was written at. *) would be picking one neither argument was written at. *)
rejects_check "u64 and i64 meet at no type" rejects_check "u64 and i64 meet at no type"
~needle:"neither holds every value of the other" ~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\ (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: (* 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 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. *) 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 written conversion is what the message asks for, and it is accepted:
the refusal is about the *implicit* step, not about reaching i64. *) the refusal is about the *implicit* step, not about reaching i64. *)
accepts "the written conversion is accepted" accepts "the written conversion is accepted"
"(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\
(defn main [] () (println (eq2? (i64 3) (i64 (i8 3)))))"; (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 (* 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. *) variable's. Nothing is converted here — three i64s were written. *)
accepts "an untyped literal still takes a bound type variable's type" 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 so a variable bound inside a slice or a function type leaves a parameter
no widening applied to in the first place. *) no widening applied to in the first place. *)
accepts "a variable bound inside a constructor is unaffected" accepts "a variable bound inside a constructor is unaffected"
"(defn sort2 [s [$t] before? (Fn [$t $t] bool)] () \ "(defn sort2 [s [$t] is-before (Fn [$t $t] bool)] () \
(sort-by s before?))\n\ (sort-by s is-before))\n\
(defn main [] () (let [ns [5 3 9 1]] \ (defn main [] () (let [ns [5 3 9 1]] \
(sort2 (slice ns 0 4) (fn [a b] (< a b))) (println (at ns 0))))"; (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: (* 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" parse_rejects "_ in a defgeneric's return slot"
~needle:"defgeneric's methods each have their own" ~needle:"defgeneric's methods each have their own"
"(defgeneric area [s] _)"; "(defgeneric area [s] _)";
(* if-let refuses a pattern that cannot fail, toward let; the program half (* A plain name binds what an Option or a dyn holds; over anything else
is programs/if-let.flan. *) it cannot fail, and is refused toward let. The program half is
rejects_check "if-let over a plain name" programs/if-let.flan and programs/optionals.fln. *)
~needle:"the pattern g is a plain name, which always matches" accepts "if-let over a plain name and an Option"
"(defn main [] () (if-let [g (Some 1)] (println g)))"; "(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 ...] ...)" 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" rejects_check "if-let over _" ~needle:"the pattern _ always matches"
"(defn main [] () (if-let [_ (Some 1)] (println 1)))"; "(defn main [] () (if-let [_ (Some 1)] (println 1)))";
accepts "if-let over a case with no fields" accepts "if-let over a case with no fields"

2
test/test_session.ml
View File

@ -1396,7 +1396,7 @@ let () =
if not (has got want) then if not (has got want) then
fail "expanding a defedn: %S is not in\n%s" want got) fail "expanding a defedn: %S is not in\n%s" want got)
[ (* The struct, with a type per field derived from the value. *) [ (* 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 (* The vector, and the constructor that states its type so that
(vec-new) has something to take it from. *) (vec-new) has something to take it from. *)
"drops (Vec i64)"; "drops (Vec i64)";

37
test/test_syntax.ml
View File

@ -1078,7 +1078,7 @@ let () =
^ " let b = compute-something-long(5, 6, 7, 8, 9)\n a") ^ " 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)]"; "(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" 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"; "(while :outer";
back "a call's arguments fill the line" back "a call's arguments fill the line"
"fn f() -> ()\n println(\"alpha\", \"beta\", \"gamma\", \"delta\", \"epsilon\", \"zeta\", \"eta\", \"theta\", \"iota\", g(1))" "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) | 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 (* 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. *) plain if's is; one whose arm returns stays Never, in both syntaxes. *)
let () = let () =

6
vendor/edn/provide.flan vendored
View File

@ -180,7 +180,7 @@
(defstruct SchemaDrift (defstruct SchemaDrift
[field str [field str
struct str struct str
extra? bool is-extra bool
pos i32]) pos i32])
;; ── And the one a file that does not parse signals ────────────────── ;; ── And the one a file that does not parse signals ──────────────────
@ -444,7 +444,7 @@
`(when (= (bit-and seen ~bit) 0) `(when (= (bit-and seen ~bit) 0)
(signal (SchemaDrift {.field ~lit (signal (SchemaDrift {.field ~lit
.struct ~(Form.Str {.s name}) .struct ~(Form.Str {.s name})
.extra? false .is-extra false
.pos (.pos k)}))))) .pos (.pos k)})))))
(set idx (+ idx 1))))) (set idx (+ idx 1)))))
(expect c tok-map-close) (expect c tok-map-close)
@ -457,7 +457,7 @@
(push clauses (push clauses
`(do (signal (SchemaDrift {.field (copy-text (.text k)) `(do (signal (SchemaDrift {.field (copy-text (.text k))
.struct ~(Form.Str {.s name}) .struct ~(Form.Str {.s name})
.extra? true .is-extra true
.pos (.pos k)})) .pos (.pos k)}))
(when (not (skip-value c)) (when (not (skip-value c))
(return out)))) (return out))))

8
vendor/json/json.flan vendored
View File

@ -374,7 +374,7 @@
(defn- read-number [c (Ptr Cursor) lo i32] Token (defn- read-number [c (Ptr Cursor) lo i32] Token
(let [s (.src c) (let [s (.src c)
i lo i lo
float? false] is-float false]
(when (= (at s lo) \+) (when (= (at s lo) \+)
(set (.pos c) (+ lo 1)) (fail c err-leading-plus lo) (return (error-token c))) (set (.pos c) (+ lo 1)) (fail c err-leading-plus lo) (return (error-token c)))
(when (= (at s lo) \.) (when (= (at s lo) \.)
@ -402,7 +402,7 @@
;; The fraction. A dot with no digit after it is `1.` or `1.e3`, both of ;; The fraction. A dot with no digit after it is `1.` or `1.e3`, both of
;; which JSON5 accepts and JSON does not. ;; which JSON5 accepts and JSON does not.
(when (and (< i (length s)) (= (at s i) \.)) (when (and (< i (length s)) (= (at s i) \.))
(set float? true) (set is-float true)
(set i (+ i 1)) (set i (+ i 1))
(when (or (>= i (length s)) (not (is-digit (at s i)))) (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))) (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 ;; not, which is JSON's rule and reads like an inconsistency until you have
;; seen 1e+3 in a file written by a serialiser. ;; seen 1e+3 in a file written by a serialiser.
(when (and (< i (length s)) (or (= (at s i) \e) (= (at s i) \E))) (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)) (set i (+ i 1))
(when (and (< i (length s)) (or (= (at s i) \+) (= (at s i) \-))) (when (and (< i (length s)) (or (= (at s i) \+) (= (at s i) \-)))
(set i (+ i 1))) (set i (+ i 1)))
@ -430,7 +430,7 @@
(set (.pos c) i) (set (.pos c) i)
(let [text (slice s lo 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 ;; 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 ;; 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 ;; rather than an error — which loses precision and says so here, since

6
vendor/json/provide.flan vendored
View File

@ -156,7 +156,7 @@
(defstruct SchemaDrift (defstruct SchemaDrift
[field str [field str
struct str struct str
extra? bool is-extra bool
pos i32]) pos i32])
;; And the one a file that does not parse signals. A generated reader ;; And the one a file that does not parse signals. A generated reader
@ -306,7 +306,7 @@
`(when (= (bit-and seen ~bit) 0) `(when (= (bit-and seen ~bit) 0)
(signal (SchemaDrift {.field ~lit (signal (SchemaDrift {.field ~lit
.struct ~(Form.Str {.s name}) .struct ~(Form.Str {.s name})
.extra? false .is-extra false
.pos (.pos close)}))))) .pos (.pos close)})))))
(comma c) (comma c)
(set idx (+ idx 1)))))) (set idx (+ idx 1))))))
@ -318,7 +318,7 @@
(push clauses (push clauses
`(do (signal (SchemaDrift {.field (match (string-of k) (Some s) s None "") `(do (signal (SchemaDrift {.field (match (string-of k) (Some s) s None "")
.struct ~(Form.Str {.s name}) .struct ~(Form.Str {.s name})
.extra? true .is-extra true
.pos (.pos k)})) .pos (.pos k)}))
(when (not (skip-value c)) (when (not (skip-value c))
(return out)))) (return out))))