From 26c53e0a19e5cf55458c1e00c95f2a2ff24149db Mon Sep 17 00:00:00 2001 From: Joseph Ferano Date: Sat, 12 Sep 2026 23:06:40 +0700 Subject: [PATCH] Every defn in the tree states its return type, and Unit is written () The mechanical half, ahead of the parser change that needs it. tools/unit-return.py fills the empty slot with () and rewrites Unit as () wherever a type is spelled -- (Fn [i32] Unit), (Map i32 Unit), a return type written out. Deciding whether a defn already had a return type is the whole difficulty, and the script does it the way parse.ml did: is_type_form is transcribed rather than improved, because being identical to the parser it replaces is what makes the sweep meaning-preserving. It is re-runnable, so the lanes that branched before this can have the same pass at merge: python3 tools/unit-return.py . python3 tools/unit-return.py --in-strings test/test_flan.ml test/test_acceptance.ml \ test/test_session.ml emacs/test-flan-dev.el emacs/test-flan-mode.el python3 tools/unit-return.py --raw-ml lib/prelude.ml python3 tools/unit-return.py --in-html web/index.html -v logs every defn it saw and what it decided, which is how a sweep of 440 sites gets reviewed at all. Embedded modes pool a file's type declarations across all its fragments, because a snippet split across concatenation -- decls ^ "(defn f [s [u8]] Cursor ...)" -- cannot see the names the other half declared; pooled names count only in bare-symbol position, for the same reason the prelude's do. A fragment that cuts off mid-form is skipped rather than guessed at. Five sites in test_flan.ml still needed a hand, and they are in this commit. Two things ride along because the sweep needs them: parse.ml reads a lone () as the return type of a function with no body, which was not a shape the old optional slot could produce; and the map refusals name () rather than Unit, since that is now the spelling a caller wrote. --- calc-me.flan | 4 +- conditions-play.flan | 2 +- emacs/test-flan-mode.el | 6 +- examples/core-basic-window.flan | 2 +- examples/core-delta-time.flan | 2 +- examples/core-input-gamepad.flan | 8 +- examples/core-input-gestures-testbed.flan | 12 +- examples/core-input-gestures.flan | 2 +- examples/core-input-keys.flan | 2 +- examples/core-input-mouse-wheel.flan | 2 +- examples/core-input-mouse.flan | 2 +- examples/core-input-multitouch.flan | 2 +- examples/core-input-virtual-controls.flan | 6 +- lib/check.ml | 6 +- lib/parse.ml | 4 + lib/prelude.ml | 34 +- sand.flan | 56 +-- syntax-sketch.flan | 10 +- test/programs/algorithms.flan | 4 +- test/programs/bytes2.flan | 6 +- test/programs/cleanup.flan | 2 +- test/programs/conditions.flan | 2 +- test/programs/defer-let.flan | 8 +- test/programs/destructure.flan | 2 +- test/programs/edn.flan | 6 +- test/programs/fn-values.flan | 6 +- test/programs/format.flan | 2 +- test/programs/machine.flan | 2 +- test/programs/map-iter.flan | 10 +- test/programs/math.flan | 2 +- test/programs/math2.flan | 2 +- test/programs/println.flan | 2 +- test/programs/raylib-audio.flan | 8 +- test/programs/raylib-ffi.flan | 10 +- test/programs/raylib-font.flan | 10 +- test/programs/raylib-image.flan | 8 +- test/programs/slices.flan | 4 +- test/programs/string-of-bytes.flan | 2 +- test/programs/strings.flan | 2 +- test/programs/text.flan | 2 +- test/programs/unit-main.flan | 2 +- test/programs/utf8.flan | 10 +- test/test_acceptance.ml | 36 +- test/test_flan.ml | 148 +++--- test/test_session.ml | 4 +- tools/unit-return.py | 536 ++++++++++++++++++++++ vendor/edn/edn.flan | 4 +- web/examples/arrays.flan | 2 +- web/examples/boom.flan | 2 +- web/examples/bounds.flan | 2 +- web/examples/breakdemo.flan | 2 +- web/examples/conds.flan | 4 +- web/examples/control.flan | 4 +- web/examples/defer.flan | 2 +- web/examples/enums.flan | 2 +- web/examples/ffi.flan | 2 +- web/examples/globals.flan | 2 +- web/examples/hello.flan | 2 +- web/examples/option.flan | 2 +- web/examples/pkg.flan | 2 +- web/examples/places.flan | 2 +- web/examples/printing.flan | 2 +- web/examples/restart.flan | 2 +- web/examples/shimdemo.flan | 2 +- web/examples/structs.flan | 4 +- web/index.html | 38 +- 66 files changed, 814 insertions(+), 270 deletions(-) create mode 100755 tools/unit-return.py diff --git a/calc-me.flan b/calc-me.flan index bd099b7..f5fc8fb 100644 --- a/calc-me.flan +++ b/calc-me.flan @@ -27,10 +27,10 @@ (at (.src c) (.pos c)) 0)) ; 0 doubles as end-of-input -(defn advance [c (Ptr Cursor)] +(defn advance [c (Ptr Cursor)] () (set (.pos c) (+ (.pos c) 1))) ; field access auto-derefs one level -(defn skip-spaces [c (Ptr Cursor)] +(defn skip-spaces [c (Ptr Cursor)] () (while (= (peek c) \space) (advance c))) diff --git a/conditions-play.flan b/conditions-play.flan index 291598a..05e0451 100644 --- a/conditions-play.flan +++ b/conditions-play.flan @@ -29,7 +29,7 @@ (use-placeholder [] -1) (retry [] 7))) -(defn run-once [] +(defn run-once [] () (print (fetch 1)) (println "") (handler-bind [(AssetMissing [c] (set seen (+ seen (i64 (.id c)))))] diff --git a/emacs/test-flan-mode.el b/emacs/test-flan-mode.el index 37e5e42..25435c3 100644 --- a/emacs/test-flan-mode.el +++ b/emacs/test-flan-mode.el @@ -70,7 +70,7 @@ ;; the first argument — `(+ gravity …)' — instead of under `vel'. (test-flan-mode--check "a let's bindings align name under name" - "(defn settle [row i32 col i32] + "(defn settle [row i32 col i32] () (let [vel (+ gravity (at velocity row col)) y (min (- rows 1) (+ row (i32 vel)))] (while (> y row) @@ -117,7 +117,7 @@ (test-flan-mode--check "and a defn without one indents it the same" - "(defn show-trim [s string] + "(defn show-trim [s string] () (print s) (println \"\"))") @@ -127,7 +127,7 @@ "a wrapped parameter list aligns under the first parameter" "(defn move-grain [row i32 col i32 to-row i32 to-col i32 - vel f32] + vel f32] () (set moved true))") ;; `handler-bind' clauses: the vector is the special argument, and each clause diff --git a/examples/core-basic-window.flan b/examples/core-basic-window.flan index 6afbeec..811d2f0 100644 --- a/examples/core-basic-window.flan +++ b/examples/core-basic-window.flan @@ -17,7 +17,7 @@ (defconst screen-width 800) (defconst screen-height 450) -(defn main [] +(defn main [] () (rl/init-window screen-width screen-height "raylib [core] example - basic window") (defer (rl/close-window)) diff --git a/examples/core-delta-time.flan b/examples/core-delta-time.flan index dc24721..af61d90 100644 --- a/examples/core-delta-time.flan +++ b/examples/core-delta-time.flan @@ -35,7 +35,7 @@ (defvar frame-circle rl/Vector2) (defvar current-fps i32) -(defn main [] +(defn main [] () (rl/init-window screen-width screen-height "raylib [core] example - delta time") (defer (rl/close-window)) diff --git a/examples/core-input-gamepad.flan b/examples/core-input-gamepad.flan index 6e4b574..fdde691 100644 --- a/examples/core-input-gamepad.flan +++ b/examples/core-input-gamepad.flan @@ -90,7 +90,7 @@ (defn axis-at [pad i32 index i32] f32 (rl/get-gamepad-axis-movement pad (rl/GamepadAxis index))) -(defn draw-pad-background [] +(defn draw-pad-background [] () (rl/draw-rectangle-rounded (rl/Rectangle {.x 175.0 .y 110.0 .width 460.0 .height 220.0}) 0.3 16 rl/darkgray) @@ -119,7 +119,7 @@ (rl/Rectangle {.x 495.0 .y 98.0 .width 100.0 .height 10.0}) 0.5 16 rl/darkgray)) -(defn draw-pad-buttons [] +(defn draw-pad-buttons [] () (when (rl/gamepad-button-down? gamepad :middle-left) (rl/draw-circle 365 170 10.0 rl/red)) (when (rl/gamepad-button-down? gamepad :middle) @@ -153,13 +153,13 @@ (rl/Rectangle {.x 495.0 .y 98.0 .width 100.0 .height 10.0}) 0.5 16 rl/red))) -(defn draw-stick [cx i32 cy i32 ax f32 ay f32 thumb-down bool] +(defn draw-stick [cx i32 cy i32 ax f32 ay f32 thumb-down bool] () (rl/draw-circle cx cy 40.0 rl/black) (rl/draw-circle cx cy 35.0 rl/lightgray) (rl/draw-circle (+ cx (i32 (* ax 20.0))) (+ cy (i32 (* ay 20.0))) 25.0 (if thumb-down rl/red rl/black))) -(defn main [] +(defn main [] () ;; Before init-window, and it has to be: raylib reads the flags while it is ;; creating the context, so the same call afterwards is accepted, logged, and ;; has no effect on the window that already exists. diff --git a/examples/core-input-gestures-testbed.flan b/examples/core-input-gestures-testbed.flan index 833968c..3721bf9 100644 --- a/examples/core-input-gestures-testbed.flan +++ b/examples/core-input-gestures-testbed.flan @@ -147,7 +147,7 @@ (= log-mode 1) (not (= g previous-gesture)) :else true)) -(defn push-log [g rl/Gesture] +(defn push-log [g rl/Gesture] () (set previous-gesture g) (set gesture-color (gesture-color-of g)) (when (<= gesture-log-index 0) (set gesture-log-index gesture-log-size)) @@ -162,11 +162,11 @@ (defconst prot-y f32 315.0) (defconst angle-length f32 90.0) -(defn swipe-box [gx i32 gy i32 which rl/Gesture] +(defn swipe-box [gx i32 gy i32 which rl/Gesture] () (rl/draw-rectangle gx gy 20 20 (if (= last-gesture which) rl/red rl/lightgray))) -(defn draw-last-gesture [touch-count i32] +(defn draw-last-gesture [touch-count i32] () (rl/draw-text "Last gesture" (+ last-x 33) (- last-y 47) 20 rl/black) (rl/draw-text "Swipe Tap Pinch Touch" (+ last-x 17) (- last-y 18) 10 rl/black) @@ -213,7 +213,7 @@ (rl/draw-circle (+ last-x 180) (+ (+ last-y 7) (* i 15)) 5.0 (if (<= touch-count i) rl/lightgray gesture-color)))) -(defn draw-log [] +(defn draw-log [] () (rl/draw-text "Log" 10 10 20 rl/black) ;; Forward from the newest, wrapping — the inverted queue read the right way ;; round. @@ -234,7 +234,7 @@ (rl/draw-text "Hide" 115 10 10 rl/white) (rl/draw-text "Hold" 115 20 10 rl/white))) -(defn draw-protractor [] +(defn draw-protractor [] () (rl/draw-text "Angle" (+ (i32 prot-x) 55) (+ (i32 prot-y) 76) 10 rl/black) ;; The C's TextFormat/TextFindIndex/TextSubtext dance to get two decimals, ;; in one call. It rounds where the C truncated, so the last digit can @@ -272,7 +272,7 @@ .y (+ (* angle-length (cos-f32 rad)) prot-y)}) 3.0 gesture-color)))) -(defn main [] +(defn main [] () (rl/init-window screen-width screen-height "raylib [core] example - input gestures testbed") (defer (rl/close-window)) diff --git a/examples/core-input-gestures.flan b/examples/core-input-gestures.flan index 3c97431..5f9ac39 100644 --- a/examples/core-input-gestures.flan +++ b/examples/core-input-gestures.flan @@ -52,7 +52,7 @@ (= g :pinch-out) "GESTURE PINCH OUT" :else "")) -(defn main [] +(defn main [] () (rl/init-window screen-width screen-height "raylib [core] example - input gestures") (defer (rl/close-window)) diff --git a/examples/core-input-keys.flan b/examples/core-input-keys.flan index 6eabef1..635394a 100644 --- a/examples/core-input-keys.flan +++ b/examples/core-input-keys.flan @@ -21,7 +21,7 @@ (defvar ball rl/Vector2) -(defn main [] +(defn main [] () (rl/init-window screen-width screen-height "raylib [core] example - input keys") (defer (rl/close-window)) diff --git a/examples/core-input-mouse-wheel.flan b/examples/core-input-mouse-wheel.flan index 1cebf26..825fb92 100644 --- a/examples/core-input-mouse-wheel.flan +++ b/examples/core-input-mouse-wheel.flan @@ -27,7 +27,7 @@ (defvar box-y i32) -(defn main [] +(defn main [] () (rl/init-window screen-width screen-height "raylib [core] example - input mouse wheel") (defer (rl/close-window)) diff --git a/examples/core-input-mouse.flan b/examples/core-input-mouse.flan index a6d5d51..206d689 100644 --- a/examples/core-input-mouse.flan +++ b/examples/core-input-mouse.flan @@ -19,7 +19,7 @@ (defvar ball-color rl/Color) -(defn main [] +(defn main [] () (rl/init-window screen-width screen-height "raylib [core] example - input mouse") (defer (rl/close-window)) diff --git a/examples/core-input-multitouch.flan b/examples/core-input-multitouch.flan index 5345054..2bcad18 100644 --- a/examples/core-input-multitouch.flan +++ b/examples/core-input-multitouch.flan @@ -31,7 +31,7 @@ (defvar touch-positions [max-touch-points rl/Vector2]) -(defn main [] +(defn main [] () (rl/init-window screen-width screen-height "raylib [core] example - input multitouch") (defer (rl/close-window)) diff --git a/examples/core-input-virtual-controls.flan b/examples/core-input-virtual-controls.flan index aba327b..5fdff19 100644 --- a/examples/core-input-virtual-controls.flan +++ b/examples/core-input-virtual-controls.flan @@ -69,7 +69,7 @@ (defvar player rl/Vector2) -(defn reset-player [] +(defn reset-player [] () (set player (rl/Vector2 {.x (/ (f32 screen-width) 2.0) .y (/ (f32 screen-height) 2.0)}))) @@ -91,7 +91,7 @@ ;; The C's switch on the pressed button. Nothing moves for button-none, which ;; is the `default: break`. -(defn move-player [button i32 dt f32] +(defn move-player [button i32 dt f32] () (let [step (* player-speed dt)] (cond (= button button-up) (set (.y player) (- (.y player) step)) @@ -149,7 +149,7 @@ (rl/Color {.r 230 .g 41 .b 55 .a 255}) ; red, right (rl/Color {.r 0 .g 228 .b 48 .a 255})]) ; green, down -(defn main [] +(defn main [] () (rl/init-window screen-width screen-height "raylib [core] example - input virtual controls") (defer (rl/close-window)) diff --git a/lib/check.ml b/lib/check.ml index b07e489..d22ad87 100644 --- a/lib/check.ml +++ b/lib/check.ml @@ -326,17 +326,17 @@ let map_type loc (k : Types.t) (v : Types.t) = copying, and free would leak what they own. Owned entries arrive with \ drop (step 5 in NEXT.md)" (Types.to_string k) (Types.to_string v); - (* Unit has no bytes, so a slot for one is a slot of nothing: the cell + (* () has no bytes, so a slot for one is a slot of nothing: the cell geometry divides the cache line by the element size and there is nothing to divide by. It is also the natural spelling of a *set*, which is why someone will write it, so it is refused by name rather than by a crash. *) if Types.equal v Types.Unit then fail loc - "a map value cannot be Unit — there is nothing to store. A set of keys \ + "a map value cannot be () — there is nothing to store. A set of keys \ is not built yet; use (Map %s bool) and ignore the value" (Types.to_string k); if Types.equal k Types.Unit then - fail loc "a map key cannot be Unit — every key would be the same key"; + fail loc "a map key cannot be () — every key would be the same key"; (* The key, as far as the type alone can say. A struct passes here and is decided at the operation, by [key_pair], which walks its fields — the struct table is not necessarily complete while a type is being resolved, diff --git a/lib/parse.ml b/lib/parse.ml index 7d3153d..2963017 100644 --- a/lib/parse.ml +++ b/lib/parse.ml @@ -731,6 +731,10 @@ let rec decl types (f : Form.t) : Ast.decl = (* An omitted return type means Unit. A leading form that is a type and is not the whole body is the return type. *) | [] -> None, [] + (* A lone [()] is the return type and an empty body, never a body of + one form: [()] is not an expression, so there is nothing for the + [more <> []] guard below to protect here. *) + | [ ({ v = List []; _ } as only) ] -> Some (texpr only), [] | first :: more when more <> [] && is_type_form types first -> Some (texpr first), body_of more | _ -> None, body_of rest diff --git a/lib/prelude.ml b/lib/prelude.ml index 03b6c48..1e0b8b9 100644 --- a/lib/prelude.ml +++ b/lib/prelude.ml @@ -62,7 +62,7 @@ let source = {flan| ;; behaviour a release build wants and gets for free. (defstruct Pause []) -(defn pause [] +(defn pause [] () (restart-case (error (Pause {})) (continue [] (do)))) @@ -72,7 +72,7 @@ let source = {flan| ;; down to 32 bits by an xorshift and rotated by the state's top five bits. (defvar rand-state u64 6364136223846793005) -(defn rand-seed [seed u64] +(defn rand-seed [seed u64] () (set rand-state (+ (* seed 6364136223846793005) 1442695040888963407))) (defn rand-u32 [] u32 @@ -111,12 +111,12 @@ let source = {flan| ;; shape and the same argument — so the set is the same i32 and f32 the rest of ;; this family covers. -(defn swap-i32! [s [i32] i i32 j i32] +(defn swap-i32! [s [i32] i i32 j i32] () (let [t (at s i)] (set (at s i) (at s j)) (set (at s j) t))) -(defn reverse-i32! [s [i32]] +(defn reverse-i32! [s [i32]] () (let [i 0 j (- (len s) 1)] (while (< i j) @@ -128,7 +128,7 @@ let source = {flan| ;; comparison function — quicksort would want a stack and mergesort a buffer, ;; and neither exists. Ascending, and stable, though with no payload type to ;; carry that is not yet observable. -(defn sort-i32! [s [i32]] +(defn sort-i32! [s [i32]] () (let [i 1] (while (< i (len s)) (let [j i] @@ -190,12 +190,12 @@ let source = {flan| ;; also the only fix, since there is no ordering of the reals that a NaN sits ;; anywhere in. -(defn swap-f32! [s [f32] i i32 j i32] +(defn swap-f32! [s [f32] i i32 j i32] () (let [t (at s i)] (set (at s i) (at s j)) (set (at s j) t))) -(defn reverse-f32! [s [f32]] +(defn reverse-f32! [s [f32]] () (let [i 0 j (- (len s) 1)] (while (< i j) @@ -203,7 +203,7 @@ let source = {flan| (set i (+ i 1)) (set j (- j 1))))) -(defn sort-f32! [s [f32]] +(defn sort-f32! [s [f32]] () (let [i 1] (while (< i (len s)) (let [j i] @@ -268,11 +268,11 @@ let source = {flan| ;; lifted into a function of its own and sees its parameters and the globals ;; and nothing else. -(defn map-i32! [s [i32] f (Fn [i32] i32)] +(defn map-i32! [s [i32] f (Fn [i32] i32)] () (dotimes [i (len s)] (set (at s i) (f (at s i))))) -(defn map-f32! [s [f32] f (Fn [f32] f32)] +(defn map-f32! [s [f32] f (Fn [f32] f32)] () (dotimes [i (len s)] (set (at s i) (f (at s i))))) @@ -317,7 +317,7 @@ let source = {flan| ;; strict weak ordering — one answering true for both (a b) and (b a) — is the ;; caller's mistake and shows up as an order, not as a loop: the inner while is ;; bounded by j reaching 0 whatever the comparison says. -(defn sort-i32-by! [s [i32] before? (Fn [i32 i32] bool)] +(defn sort-i32-by! [s [i32] before? (Fn [i32 i32] bool)] () (let [i 1] (while (< i (len s)) (let [j i] @@ -327,7 +327,7 @@ let source = {flan| (set j (- j 1)))) (set i (+ i 1))))) -(defn sort-f32-by! [s [f32] before? (Fn [f32 f32] bool)] +(defn sort-f32-by! [s [f32] before? (Fn [f32 f32] bool)] () (let [i 1] (while (< i (len s)) (let [j i] @@ -996,7 +996,7 @@ let source = {flan| (return (< (at a i) (at b i))))) (< (len a) (len b)))) -(defn swap-bytes! [s [[u8]] i i32 j i32] +(defn swap-bytes! [s [[u8]] i i32 j i32] () (let [t (at s i)] (set (at s i) (at s j)) (set (at s j) t))) @@ -1006,7 +1006,7 @@ let source = {flan| ;; fields borrowed from one buffer without touching the buffer. Stable, and ;; here that is observable — two equal fields are two distinct slices of ;; different parts of the input, and a caller can see which one came first. -(defn sort-bytes! [s [[u8]]] +(defn sort-bytes! [s [[u8]]] () (let [i 1] (while (< i (len s)) (let [j i] @@ -1051,7 +1051,7 @@ let source = {flan| ;; It takes a (Ptr (Vec u8)) and not a (Vec u8), and the difference is not ;; style: a Vec parameter *moves*, so (append! b s) taking one by value would ;; consume the caller's builder on the first call and refuse the second. -(defn append! [b (Ptr (Vec u8)) s [u8]] +(defn append! [b (Ptr (Vec u8)) s [u8]] () (dotimes [i (len s)] (push (deref b) (at s i)))) @@ -1062,10 +1062,10 @@ let source = {flan| ;; views of the same bytes — the second call overwrote the first. These copy ;; out of that buffer before returning, so the hazard ends at the call: a ;; builder can hold as many numbers as it likes. -(defn append-i64! [b (Ptr (Vec u8)) n i64] +(defn append-i64! [b (Ptr (Vec u8)) n i64] () (append! b (i64->bytes n))) -(defn append-f64! [b (Ptr (Vec u8)) x f64] +(defn append-f64! [b (Ptr (Vec u8)) x f64] () (append! b (f64->bytes x))) ;; concat and join. Both take a slice of slices, which is the shape a caller diff --git a/sand.flan b/sand.flan index 7aff84f..3338764 100644 --- a/sand.flan +++ b/sand.flan @@ -59,20 +59,20 @@ ;; An index into colors, not a colour. (defvar current-color i32) -(defn clear-grid [] +(defn clear-grid [] () (set grid (zeroed)) (set velocity (zeroed))) (defn empty-at? [row i32 col i32] bool (= 0 (at grid row col))) -(defn next-color [] +(defn next-color [] () (set current-color (% (+ current-color 1) (len colors)))) ;; Drop a brush-sized cloud of grains centred on [row col]. This is what the ;; mouse drives interactively and what the headless run calls directly — the ;; only difference between the two is where the centre comes from. -(defn paint-at [row i32 col i32] +(defn paint-at [row i32 col i32] () (let [half (/ brush-size 2)] (dotimes [x brush-size] (dotimes [y brush-size] @@ -87,7 +87,7 @@ (defn move-grain [from-row i32 from-col i32 to-row i32 to-col i32 - vel f32] + vel f32] () (set (at grid to-row to-col) (at grid from-row from-col)) (set (at grid from-row from-col) 0) (set (at velocity to-row to-col) vel) @@ -99,7 +99,7 @@ ;; Imperative `while` with early `return`, not loop/recur — see plan.org ;; "Loop story". The recur version read as a tail call but was a countdown ;; over a mutable scan position, which is what a while loop is. -(defn settle [row i32 col i32] +(defn settle [row i32 col i32] () (let [vel (+ gravity (at velocity row col)) some-point (rl/Vector2 {.x 15.0 .y 12}) y (min (- rows 1) (+ row (i32 vel)))] @@ -122,7 +122,7 @@ (set (at velocity row col) 0.0))) ;; One frame of physics. Bottom-up, so a grain settles at most once per frame. -(defn step [] +(defn step [] () (let [row (- rows 2)] (while (>= row 0) (dotimes [col cols] @@ -193,7 +193,7 @@ ;; because ImageFlipHorizontal rewrites the buffer in place and the second ;; upload has to see the changed pixels — if the two badges look the same, ;; either the flip did nothing or the order here was swapped. -(defn load-brush [] +(defn load-brush [] () (let [sheet (rl/load-image-from-memory ".png" brush-png)] (when (rl/image-valid? sheet) (set brush (rl/load-texture-from-image sheet)) @@ -212,7 +212,7 @@ ;; needs a source rectangle; the three badges in the corner are the whole ;; sheet, at integer coordinates, at a Vector2 tinted with the current sand ;; colour, and scaled up — draw-texture, draw-texture-v and draw-texture-ex. -(defn draw-brush [] +(defn draw-brush [] () (when brush-ok (let [m (rl/get-mouse-position) frame (f32 (if (rl/mouse-button-down? :left) 8.0 0.0))] @@ -256,14 +256,14 @@ ;; a run-time number, and no Flan type says what the buffer holds. (defvar tone-pcm [8820 u8]) -(defn write-sample [i i32 v i32] +(defn write-sample [i i32 v i32] () (set (at tone-pcm (* i 2)) (u8 (bit-and v 255))) (set (at tone-pcm (+ (* i 2) 1)) (u8 (bit-and (>> v 8) 255)))) ;; A square wave that decays to nothing over its length, which is the ;; cheapest thing that sounds like a plink rather than a click. `period` is ;; the half-period in frames, so a smaller one is a higher note. -(defn build-tone [period i32] +(defn build-tone [period i32] () (dotimes [i tone-frames] (let [amp (/ (* 9000 (- tone-frames i)) tone-frames)] (write-sample i (if (= 0 (% (/ i period) 2)) amp (- 0 amp)))))) @@ -275,7 +275,7 @@ (defvar music-ok bool) (defvar music-on bool) -(defn start-audio [] +(defn start-audio [] () (rl/init-audio-device) (set audio-ok (rl/audio-device-ready?)) (unless audio-ok @@ -303,19 +303,19 @@ (rl/set-music-pitch music 0.5))))) (rl/set-master-volume 0.6)) -(defn stop-audio [] +(defn stop-audio [] () (when music-ok (rl/unload-music-stream music)) (when tone-ok (rl/unload-sound tone)) (rl/close-audio-device)) ;; Every plink goes through here, so a silent build — no device, or a wave ;; that would not load — is one branch and not a guard at every call site. -(defn plink [pitch f32] +(defn plink [pitch f32] () (when tone-ok (rl/set-sound-pitch tone pitch) (rl/play-sound tone))) -(defn toggle-music [] +(defn toggle-music [] () (when music-ok (set music-on (not music-on)) (if music-on @@ -339,7 +339,7 @@ (defvar scene rl/RenderTexture2D) (defvar scene-ok bool) -(defn load-scene [] +(defn load-scene [] () (set scene (rl/load-render-texture screen-width screen-height)) (set scene-ok (rl/render-texture-valid? scene)) (unless scene-ok @@ -357,7 +357,7 @@ (defvar hud-font rl/Font) (defvar hud-font-ok bool) -(defn load-hud-font [] +(defn load-hud-font [] () (set hud-font (rl/get-font-default)) (set hud-font-ok (rl/font-valid? hud-font))) @@ -375,13 +375,13 @@ ;; A fresh (Camera2D {}) has a zoom of 0, which is singular: both conversions ;; hand back NaN and nothing draws. 1.0 is the identity. -(defn reset-view [] +(defn reset-view [] () (set view (rl/Camera2D {.offset (rl/Vector2 {.x 0.0 .y 0.0}) .target (rl/Vector2 {.x 0.0 .y 0.0}) .rotation 0.0 .zoom 1.0}))) -(defn set-view [target-x f32 target-y f32 zoom f32] +(defn set-view [target-x f32 target-y f32 zoom f32] () (set view (rl/Camera2D {.offset (.offset view) .target (rl/Vector2 {.x target-x .y target-y}) .rotation (.rotation view) @@ -391,7 +391,7 @@ ;; neither changes with the frame rate. That is the whole of what ;; get-frame-time is for, and a loop that assumed it hit its target fps would ;; be a loop that moves differently on a slower machine. -(defn move-view [] +(defn move-view [] () (let [dt (rl/get-frame-time) pan (* (f32 600.0) dt) tx (.x (.target view)) @@ -414,7 +414,7 @@ ;; The mouse is in screen pixels and the grid is in world cells, and with a ;; camera in the way those stopped being the same thing — so this is the one ;; place get-screen-to-world-2d is not a test case but a requirement. -(defn paint [] +(defn paint [] () (let [m (rl/get-screen-to-world-2d (rl/get-mouse-position) view) row (/ (i32 (.y m)) cell-size) col (/ (i32 (.x m)) cell-size)] @@ -430,7 +430,7 @@ ;; `settle` while `game-update` is mid-frame is safe ;; because old code is never unloaded; changing its SIGNATURE is not, and the ;; reload rejects it. See plan.org "What redefinition cannot do". -(defn game-update [] +(defn game-update [] () (when (rl/key-pressed? :r) (clear-grid)) (move-view) ;; key-released? and mouse-button-pressed? were bound and called by nothing @@ -457,7 +457,7 @@ (step)) -(defn draw-grid [] +(defn draw-grid [] () (dotimes [row rows] (dotimes [col cols] (let [c (at grid row col)] @@ -471,7 +471,7 @@ ;; scales with the grid. That is the point: a shape binding that is subtly ;; wrong is easiest to see when it is supposed to sit exactly on the cursor ;; and does not. -(defn draw-world-cursor [] +(defn draw-world-cursor [] () (let [p (rl/get-screen-to-world-2d (rl/get-mouse-position) view) tint (rl/get-color (at colors current-color)) x (.x p) @@ -513,7 +513,7 @@ ;; so it is built to be *looked* at: every shape binding appears once, and each ;; one is asymmetric enough that a wrapper with its arguments crossed is ;; visible rather than merely different. -(defn draw-hud [] +(defn draw-hud [] () (let [title "SAND" keys "arrows pan , . zoom 0 reset r clear space colour m music" ;; measure-text is what sizes the panel, so the box fits the string @@ -619,7 +619,7 @@ ;; the marker. Every read-out below is asymmetric on purpose — the stick dot ;; is offset by x and y separately, and the trigger bars are different lengths ;; — so a crossed wrapper is visible rather than merely different. -(defn draw-input-state [] +(defn draw-input-state [] () (let [ox (f32 200.0) oy (f32 90.0) r (f32 34.0)] @@ -683,14 +683,14 @@ .y (+ oy (* (.y q) (f32 200.0)))}) (f32 4.0) rl/white)))))) -(defn draw-world [] +(defn draw-world [] () ;; Everything between these two is in world space and moves with the camera. (rl/begin-mode-2d view) (draw-grid) (draw-world-cursor) (rl/end-mode-2d)) -(defn game-draw [] +(defn game-draw [] () ;; The world goes into the render texture first, if there is one. Note the ;; clear inside the texture mode: the framebuffer keeps last frame's pixels ;; otherwise, which looks like a trail and not like a bug. @@ -718,7 +718,7 @@ (draw-input-state) (rl/draw-fps 20 20)) -(defn main [] +(defn main [] () (rl/set-trace-log-level :warning) (rl/init-window screen-width screen-height "SAND") (defer (rl/close-window)) diff --git a/syntax-sketch.flan b/syntax-sketch.flan index def2402..c783a5a 100644 --- a/syntax-sketch.flan +++ b/syntax-sketch.flan @@ -77,7 +77,7 @@ ;; a copy and `set` would mutate the copy. `resolve` yields (Option (Ptr a)) ;; instead, and the pointer is visible in the binding's type. `deref` is the ;; by-value counterpart. Both are overloaded on (Ptr a)/(Handle a). -(defn damage [w (Ptr World) h (Handle Enemy) amount i32] +(defn damage [w (Ptr World) h (Handle Enemy) amount i32] () (match (resolve w h) (Some e) (set (.hp e) (- (.hp e) amount)) ; e : (Ptr Enemy), field derefs None (log "stale enemy handle"))) @@ -134,7 +134,7 @@ ;; Intermediate frames say nothing about AssetMissing. Nothing to thread. ;; invoke-restart has type Never: it does not return to the handler. -(defn load-level [path string] Level +(defn load-level [path string] () Level (handler-bind [AssetMissing (fn [c] (log "missing asset:" (.path c)) (invoke-restart 'use-placeholder))] @@ -168,7 +168,7 @@ ;; `filter` allocates a (Vec Enemy) from the current allocator, which is why ;; this is wrapped: the frame arena is bulk-reset, so the Vec is never freed ;; individually. `each` borrows it as a slice. -(defn draw-frame [w (Ptr World) dt f32] +(defn draw-frame [w (Ptr World) dt f32] () (with-allocator context/temp (->> (as-slice (.enemies w)) (filter (fn [e] (on-screen? (.pos e)))) @@ -177,7 +177,7 @@ ;; ── defer for explicit resources ────────────────────────────────────── ;; defer DOES run when a restart transfer passes through this frame. -(defn save-world [w (Ptr World) path string] +(defn save-world [w (Ptr World) path string] () (let [f (open path :write)] (defer (close f)) (write-bytes f (serialize w)))) @@ -194,7 +194,7 @@ ;; An imperative loop, not (each (fn [p] (try ...))): `try` and `return` inside a ;; `fn` exit the FN, so a callback would swallow the Err instead of propagating ;; it out of preload. -(defn ^:async preload [paths [string]] (Result Unit) +(defn ^:async preload [paths [string]] (Result ()) (for [p paths] (try (await (load-texture-async p)))) (Ok unit)) diff --git a/test/programs/algorithms.flan b/test/programs/algorithms.flan index 8d59e43..04f3072 100644 --- a/test/programs/algorithms.flan +++ b/test/programs/algorithms.flan @@ -7,13 +7,13 @@ ;;;; honest form is the concrete one, and the claim this file makes is only ;;;; that the concrete ones are right. -(defn show-f32 [s [f32]] +(defn show-f32 [s [f32]] () (dotimes [i (len s)] (print (at s i)) (print " ")) (println "")) -(defn show-fields [s [[u8]]] +(defn show-fields [s [[u8]]] () (dotimes [i (len s)] (print (string (at s i))) (print " ")) diff --git a/test/programs/bytes2.flan b/test/programs/bytes2.flan index b05f5a7..5117785 100644 --- a/test/programs/bytes2.flan +++ b/test/programs/bytes2.flan @@ -11,17 +11,17 @@ ;;;; for and a caller cannot tell from a real one: "", "abc", "1x", ".", ;;;; "1e", " 1", "0x10" and "nan". Each must be None. -(defn show-idx [o (Option i32)] +(defn show-idx [o (Option i32)] () (print (match o (Some i) i None -1)) (print " ")) -(defn show-bool [b bool] +(defn show-bool [b bool] () (print (if b "t" "f"))) ;; Brackets around the result so an empty trim is visible as [] rather than ;; as nothing at all — the all-whitespace case is otherwise indistinguishable ;; from a trim that printed the wrong slice of length zero. -(defn show-trim [s string] +(defn show-trim [s string] () (print "[") (print (trim (bytes s))) (print "]")) diff --git a/test/programs/cleanup.flan b/test/programs/cleanup.flan index 4fa80d2..5e1f60d 100644 --- a/test/programs/cleanup.flan +++ b/test/programs/cleanup.flan @@ -11,7 +11,7 @@ (defvar order i64) (defvar seen i64) -(defn note [n i64] (set order (+ (* order 10) n))) +(defn note [n i64] () (set order (+ (* order 10) n))) ;;; (1) An early return must run the defers registered above it, and (2) it ;;; must run them innermost-first. A defer that (8) *calls* something is the diff --git a/test/programs/conditions.flan b/test/programs/conditions.flan index b2b24b8..c439cfd 100644 --- a/test/programs/conditions.flan +++ b/test/programs/conditions.flan @@ -12,7 +12,7 @@ (defvar other i64) ;;; Signals twice and keeps going both times — that is the whole of §1. -(defn load-all [] +(defn load-all [] () (signal (AssetMissing {.id 1})) (signal (AssetMissing {.id 2})) (signal (Corrupt {.id 3}))) diff --git a/test/programs/defer-let.flan b/test/programs/defer-let.flan index 49cf425..420bd13 100644 --- a/test/programs/defer-let.flan +++ b/test/programs/defer-let.flan @@ -11,7 +11,7 @@ (defvar order i64) -(defn note [n i32] (set order (+ (* order 10) (i64 n)))) +(defn note [n i32] () (set order (+ (* order 10) (i64 n)))) ;;; One defer in a let, with the acquisition it is paired with above it. This ;;; is the shape the relaxation exists for: acquire, defer the release beside @@ -25,7 +25,7 @@ ;;; Two resources in one let. This is the case a flag granted once per block ;;; instead of once per form gets wrong: the first defer registers and the ;;; second is refused. -(defn two [] +(defn two [] () (let [a 1 b 2] (defer (note a)) (defer (note b)) @@ -33,7 +33,7 @@ ;;; A nested let still has the function's extent, so a defer in it registers ;;; too — and it registers *later* than the outer one, so it runs first. -(defn nested [] +(defn nested [] () (let [a 1] (defer (note a)) (let [b 2] @@ -43,7 +43,7 @@ ;;; Registration order is one order across the boundary: a defer at the top ;;; level and a defer inside a let interleave by where they are written, not by ;;; which construct they are in. Written 1, 2, 3; run 3, 2, 1. -(defn mixed [] +(defn mixed [] () (defer (note 1)) (let [x 2] (defer (note x)) diff --git a/test/programs/destructure.flan b/test/programs/destructure.flan index 94ecd29..5ebf6be 100644 --- a/test/programs/destructure.flan +++ b/test/programs/destructure.flan @@ -22,7 +22,7 @@ (set calls (+ calls 1)) (Point {.x 3 .y 4})) -(defn show2 [label string a i32 b i32] +(defn show2 [label string a i32 b i32] () (print label) (print " ") (print a) diff --git a/test/programs/edn.flan b/test/programs/edn.flan index 000cfcc..b27b24f 100644 --- a/test/programs/edn.flan +++ b/test/programs/edn.flan @@ -37,7 +37,7 @@ (= k edn/tok-list-close) ")" :else "?")) -(defn dump [src string] +(defn dump [src string] () (let [b (bytes src) c (edn/cursor b) t (edn/next (addr c))] @@ -55,7 +55,7 @@ ;; The refusals. Asserted on the *reason*, not on the fact of failing: a ;; tokenizer that answered err-unexpected-byte for every one of these would ;; pass a test that only checked that it failed. -(defn refusal [src string] +(defn refusal [src string] () (let [b (bytes src) c (edn/cursor b)] (while (and (edn/ok? (addr c)) @@ -118,7 +118,7 @@ (return e))))) e)) -(defn show-enemy [src string] +(defn show-enemy [src string] () (let [b (bytes src) c (edn/cursor b) e (read-enemy (addr c))] diff --git a/test/programs/fn-values.flan b/test/programs/fn-values.flan index 212e595..fc001a6 100644 --- a/test/programs/fn-values.flan +++ b/test/programs/fn-values.flan @@ -10,7 +10,7 @@ ;; The shape map/filter/reduce want: the function arrives as a parameter, is ;; called, and is never stored. -(defn each! [xs [i32] f (Fn [i32] i32)] Unit +(defn each! [xs [i32] f (Fn [i32] i32)] () (dotimes [i (len xs)] (set (at xs i) (f (at xs i))))) @@ -23,7 +23,7 @@ ;; A comparator, which is the other half of what was blocked: a sort that is ;; told the order rather than having it written in. Insertion sort, because the ;; point here is the parameter and not the algorithm. -(defn sort-by! [xs [i32] before? (Fn [i32 i32] bool)] Unit +(defn sort-by! [xs [i32] before? (Fn [i32 i32] bool)] () (dotimes [i (len xs)] (let [j i] (while (and (> j 0) (before? (at xs j) (at xs (- j 1)))) @@ -52,7 +52,7 @@ ;; A handler-bind and an fn literal in *one* function, which is the case that ;; would catch the two lifted-function name sequences sharing a counter: both ;; are lifted out of [handles] and both are numbered within it. -(defn handles [] Unit +(defn handles [] () (handler-bind [(TooBig [c] (set seen (+ seen (.n c))))] (let [xs [5 200 7 300]] (println (fold (slice xs 0 4) checked)) diff --git a/test/programs/format.flan b/test/programs/format.flan index d6931b0..cfe4f53 100644 --- a/test/programs/format.flan +++ b/test/programs/format.flan @@ -9,7 +9,7 @@ ;;;; sign, which belongs to the number and not to its integer part, because ;;;; -0.5 has an integer part of 0 and 0 carries no sign. -(defn show [x f64 p i32] +(defn show [x f64 p i32] () (let [v (format-f64 x p)] (println (string (as-slice v))) (free v))) diff --git a/test/programs/machine.flan b/test/programs/machine.flan index 59027b7..c089a2c 100644 --- a/test/programs/machine.flan +++ b/test/programs/machine.flan @@ -9,7 +9,7 @@ (defstruct P [x i32 y i32]) (defstruct Line [a P b P]) -(defn bump [p (Ptr P)] +(defn bump [p (Ptr P)] () (set (.x p) (+ (.x p) 1))) (defn sum-grid [] i32 diff --git a/test/programs/map-iter.flan b/test/programs/map-iter.flan index c5718c1..9b69829 100644 --- a/test/programs/map-iter.flan +++ b/test/programs/map-iter.flan @@ -7,7 +7,7 @@ ;; membership test, all of them order-free. That is not a weakness of the test, ;; it is the contract — a caller that wants an order sorts what it collected. -(defn sum-and-count [] Unit +(defn sum-and-count [] () (let [m (map-new i32 i32)] (put m 1 10) (put m 2 20) @@ -29,7 +29,7 @@ ;; A map that never allocated has no block at all, and one that allocated and ;; holds nothing has a block of nothing but zeroed hashes. Both walk zero ;; times, and they are different code paths to get there. -(defn the-empty-cases [] Unit +(defn the-empty-cases [] () (let [m (map-new i32 i32) cur (i64 0) k 0 @@ -47,7 +47,7 @@ ;; A cursor left past the end keeps answering false rather than wrapping, so a ;; second loop over a spent cursor is empty and not a repeat. -(defn a-spent-cursor [] Unit +(defn a-spent-cursor [] () (let [m (map-new i32 i32)] (put m 5 50) (put m 6 60) @@ -64,7 +64,7 @@ ;; would catch the two runs being indexed with one geometry. (defstruct Point [x i32 y i32]) -(defn wider-entries [] Unit +(defn wider-entries [] () (let [m (map-new string Point)] (put m "a" (Point {.x 1 .y 2})) (put m "bb" (Point {.x 3 .y 4})) @@ -85,7 +85,7 @@ ;; Growth past the 75% threshold rehashes into a new block, so this walks a map ;; whose layout is nothing like its insertion order and at a capacity several ;; doublings past the minimum. -(defn after-growth [] Unit +(defn after-growth [] () (let [m (map-new i64 i64)] (dotimes [i 500] (put m (i64 i) (* (i64 i) 2))) diff --git a/test/programs/math.flan b/test/programs/math.flan index 811fb7c..5df607b 100644 --- a/test/programs/math.flan +++ b/test/programs/math.flan @@ -10,7 +10,7 @@ ;;;; past 2^24, where an f32 has no fractional bits and the guard, not the ;;;; cast, has to produce the answer. -(defn show [x f32] +(defn show [x f32] () (print x) (print " ")) diff --git a/test/programs/math2.flan b/test/programs/math2.flan index 145cbb0..56c2f48 100644 --- a/test/programs/math2.flan +++ b/test/programs/math2.flan @@ -13,7 +13,7 @@ ;;;; one copy per type. The proof that the macro is not one copy per type is ;;;; that the same three-word call below is made at i32, i64, u8 and f32. -(defn show [x f32] +(defn show [x f32] () (print x) (print " ")) diff --git a/test/programs/println.flan b/test/programs/println.flan index 2b252c7..1e105f7 100644 --- a/test/programs/println.flan +++ b/test/programs/println.flan @@ -34,7 +34,7 @@ (defstruct Long [s string]) (defvar long-one Long) -(defn nothing [] ) +(defn nothing [] () ) (defn find-it [s [i32] k i32] (Option i32) (dotimes [i (len s)] diff --git a/test/programs/raylib-audio.flan b/test/programs/raylib-audio.flan index dc29ff1..91c41f2 100644 --- a/test/programs/raylib-audio.flan +++ b/test/programs/raylib-audio.flan @@ -64,7 +64,7 @@ ;; different one. (defvar pcm [16 u8]) -(defn load-pcm [] +(defn load-pcm [] () (set (at pcm 0) 0x00) (set (at pcm 1) 0x00) ; 0 (set (at pcm 2) 0xE8) (set (at pcm 3) 0x03) ; 1000 (set (at pcm 4) 0xD0) (set (at pcm 5) 0x07) ; 2000 @@ -76,7 +76,7 @@ (defconst wav-path "/tmp/flan-raylib-audio.wav") -(defn show-wave [name string w rl/Wave] +(defn show-wave [name string w rl/Wave] () (print name) (print " ") (print (.frame-count w)) (print " ") (print (.sample-rate w)) @@ -84,7 +84,7 @@ (print " ") (print (.channels w)) (println "")) -(defn show-bool [name string b bool] +(defn show-bool [name string b bool] () (print name) (print " ") (println (if b "yes" "no"))) @@ -121,7 +121,7 @@ (rl/unload-wave one) v))) -(defn show-frame [name string w rl/Wave i i32 want f32] +(defn show-frame [name string w rl/Wave i i32 want f32] () (show-bool name (near? (frame-at w i) want))) (defn main [] i32 diff --git a/test/programs/raylib-ffi.flan b/test/programs/raylib-ffi.flan index 391d47b..a5a8400 100644 --- a/test/programs/raylib-ffi.flan +++ b/test/programs/raylib-ffi.flan @@ -11,14 +11,14 @@ ;; survives it unchanged. Every case below is asymmetric — raylib does ;; something to the fields that depends on which is which. -(defn show-texture [t rl/Texture2D] +(defn show-texture [t rl/Texture2D] () (print (.id t)) (println "") (print (.width t)) (println "") (print (.height t)) (println "") (print (.mipmaps t)) (println "") (print (.format t)) (println "")) -(defn show-rect [r rl/Rectangle] +(defn show-rect [r rl/Rectangle] () (print (.x r)) (println "") (print (.y r)) (println "") (print (.width r)) (println "") @@ -46,11 +46,11 @@ ;; ((140-100)/2)+8 = 28 and ((90-50)/2)+4 = 24. Swap offset and target in the ;; defstruct and this reads (143,-16); swap rotation and zoom and the zoom ;; becomes 0, the transform is singular, and both come back NaN. -(defn show-bool [name string b bool] +(defn show-bool [name string b bool] () (print name) (print " ") (println (if b "yes" "no"))) -(defn show-v [v rl/Vector2] +(defn show-v [v rl/Vector2] () (print (.x v)) (println "") (print (.y v)) (println "")) @@ -71,7 +71,7 @@ (let [d (- a b)] (< (if (< d 0.0) (- 0.0 d) d) 0.0001))) -(defn show-near [name string v rl/Vector2 x f32 y f32] +(defn show-near [name string v rl/Vector2 x f32 y f32] () (print name) (println (if (and (near? (.x v) x) (near? (.y v) y)) " ok" " bad"))) diff --git a/test/programs/raylib-font.flan b/test/programs/raylib-font.flan index 1f81afa..4ead0dd 100644 --- a/test/programs/raylib-font.flan +++ b/test/programs/raylib-font.flan @@ -67,7 +67,7 @@ ;; and glyph C answers with A's numbers. (defvar glyphs [3 rl/GlyphInfo]) -(defn build-glyphs [] +(defn build-glyphs [] () (set (at glyph-recs 0) (rl/Rectangle {.x 0.0 .y 0.0 .width 5.0 .height 10.0})) (set (at glyph-recs 1) (rl/Rectangle {.x 5.0 .y 0.0 .width 7.0 .height 10.0})) (set (at glyph-recs 2) (rl/Rectangle {.x 12.0 .y 0.0 .width 9.0 .height 10.0})) @@ -80,20 +80,20 @@ (set (at glyphs 2) (rl/GlyphInfo {.value 67 .offset-x 3 .offset-y 0 .advance-x 0 .image (rl/Image {})}))) -(defn show-bool [name string b bool] +(defn show-bool [name string b bool] () (print name) (print " ") (println (if b "yes" "no"))) -(defn show-i [name string v i32] +(defn show-i [name string v i32] () (print name) (print " ") (print v) (println "")) -(defn show-v [name string v rl/Vector2] +(defn show-v [name string v rl/Vector2] () (print name) (print " ") (print (.x v)) (print " ") (print (.y v)) (println "")) -(defn show-rect [name string r rl/Rectangle] +(defn show-rect [name string r rl/Rectangle] () (print name) (print " ") (print (.x r)) (print " ") (print (.y r)) diff --git a/test/programs/raylib-image.flan b/test/programs/raylib-image.flan index f59d914..8ac680a 100644 --- a/test/programs/raylib-image.flan +++ b/test/programs/raylib-image.flan @@ -34,7 +34,7 @@ ;; write identical bytes, so sharing one path between runs is harmless. (defconst png-path "/tmp/flan-raylib-image.png") -(defn show-image [name string i rl/Image] +(defn show-image [name string i rl/Image] () (print name) (print " ") (print (.width i)) (print " ") (print (.height i)) @@ -42,7 +42,7 @@ (print " ") (print (.format i)) (println "")) -(defn show-color [name string c rl/Color] +(defn show-color [name string c rl/Color] () (print name) (print " ") (print (.r c)) (print " ") (print (.g c)) @@ -50,13 +50,13 @@ (print " ") (print (.a c)) (println "")) -(defn show-bool [name string b bool] +(defn show-bool [name string b bool] () (print name) (print " ") (println (if b "yes" "no"))) ;; Every pixel read names its coordinates in the label, so a failure says ;; which one moved rather than only that something did. -(defn show-pixel [name string i rl/Image x i32 y i32] +(defn show-pixel [name string i rl/Image x i32 y i32] () (show-color name (rl/get-image-color i x y))) (defn main [] i32 diff --git a/test/programs/slices.flan b/test/programs/slices.flan index fd2d19f..ad66103 100644 --- a/test/programs/slices.flan +++ b/test/programs/slices.flan @@ -15,13 +15,13 @@ (defvar ys [5 i32]) (defvar zs [8 i32]) -(defn show [s [i32]] +(defn show [s [i32]] () (dotimes [i (len s)] (when (> i 0) (print " ")) (print (at s i))) (println "")) -(defn load-xs [] +(defn load-xs [] () (set (at xs 0) 5) (set (at xs 1) -3) (set (at xs 2) 5) diff --git a/test/programs/string-of-bytes.flan b/test/programs/string-of-bytes.flan index 9e218be..93a2ef8 100644 --- a/test/programs/string-of-bytes.flan +++ b/test/programs/string-of-bytes.flan @@ -20,7 +20,7 @@ ;; which shares stdout's buffer with puts, so the interleaving is stable. (declare-c c-puts [s string] i32 "puts") -(defn shows [s string] +(defn shows [s string] () (print "[") (print s) (print "] ") diff --git a/test/programs/strings.flan b/test/programs/strings.flan index 17d8929..7e2e989 100644 --- a/test/programs/strings.flan +++ b/test/programs/strings.flan @@ -11,7 +11,7 @@ ;;; A (Vec u8) printed as text, without the caller writing the two-step every ;;; time. as-slice borrows -- it copies ptr+len and never the elements -- so v ;;; is still the owner afterwards and is still free-able. -(defn show [v (Ptr (Vec u8))] +(defn show [v (Ptr (Vec u8))] () (println (string (as-slice (deref v))))) (defn main [] i32 diff --git a/test/programs/text.flan b/test/programs/text.flan index b4da894..5ca88ec 100644 --- a/test/programs/text.flan +++ b/test/programs/text.flan @@ -6,7 +6,7 @@ ;;;; end, and for parse-i64 every shape strtoll answers 0 for — "", "abc", ;;;; "12x", "-" — each of which a caller could not tell from a real 0. -(defn show-bool [b bool] +(defn show-bool [b bool] () (print (if b "t" "f"))) (defn main [] i32 diff --git a/test/programs/unit-main.flan b/test/programs/unit-main.flan index 8938a8e..9f86544 100644 --- a/test/programs/unit-main.flan +++ b/test/programs/unit-main.flan @@ -1,4 +1,4 @@ ;;;; The short entry point: both the parameter and the i32 status are optional, ;;;; and an omitted return type means Unit, so the process exits 0. -(defn main [] +(defn main [] () (println "ok")) diff --git a/test/programs/utf8.flan b/test/programs/utf8.flan index 41e5e9b..6ad4d8f 100644 --- a/test/programs/utf8.flan +++ b/test/programs/utf8.flan @@ -50,17 +50,17 @@ ;; code/width/ok, so a wrong answer names which of the three it got wrong ;; rather than just failing. -(defn show-dec [s [u8]] +(defn show-dec [s [u8]] () (let [r (decode-rune s)] (print (.code r)) (print "/") (print (.width r)) (print "/") (print (if (.ok r) "t" "f")) (print " "))) -(defn show-bool [b bool] +(defn show-bool [b bool] () (print (if b "t" "f"))) -(defn show-opt [o (Option i32)] +(defn show-opt [o (Option i32)] () (print (match o (Some v) v None -1)) (print " ")) @@ -74,11 +74,11 @@ (let [r (decode-rune (slice scratch 0 w))] (if (and (.ok r) (= (.width r) w)) (.code r) -1)))) -(defn show-i32 [x i32] +(defn show-i32 [x i32] () (print x) (print " ")) -(defn show-split [s [u8] sep u8] +(defn show-split [s [u8] sep u8] () (let [it (split-on-byte s sep) going true] (while going diff --git a/test/test_acceptance.ml b/test/test_acceptance.ml index 95a4fbe..54fd10b 100644 --- a/test/test_acceptance.ml +++ b/test/test_acceptance.ml @@ -382,7 +382,7 @@ let () = "a quoted restart name and then its arguments"; (* A clause parameter is a binding, so it needs something to hold. *) refuses_src "a restart parameter that is not a value" - "(defn main [] i32 (restart-case 0 (use-value [v Unit] 1)))" + "(defn main [] i32 (restart-case 0 (use-value [v ()] 1)))" "which is not a value"; (* And so does an argument: a [println] is Unit, and there would be nothing to store into the clause's buffer. *) @@ -1669,7 +1669,7 @@ ERR@7 unexpected token: not the kind the caller was reading "(declare-c name [] string \"Name\")" "a string only crosses as a parameter"; shim_refuses "declare-c: a callback" - "(declare-c each [f (Fn [i32] Unit)] \"Each\")" + "(declare-c each [f (Fn [i32] ())] \"Each\")" "a C callback is not implemented"; shim_refuses "declare-c: an unknown type" "(declare-c f [x Nope] \"F\")" @@ -1679,7 +1679,7 @@ ERR@7 unexpected token: not the kind the caller was reading "field xs of S is a slice"; shim_refuses "declare-c: the generated name is already taken" (v2 - ^ "(defn mid-c [a (Ptr Vector2) out (Ptr Vector2)])\n\ + ^ "(defn mid-c [a (Ptr Vector2) out (Ptr Vector2)] ())\n\ (declare-c mid [a Vector2] Vector2 \"Mid\")") "needs the name mid-c for the declaration it generates"; shim_refuses "declare-c: two Flan names for one C function" @@ -1724,19 +1724,19 @@ ERR@7 unexpected token: not the kind the caller was reading copied into every exit path cannot. A [let] inside either one inherits the refusal, not the permission: its extent is the loop's or the arm's. *) refuses_src "defer in a loop body" - "(defn g [] 0)\n(defn f [] (while true (defer (g))))" + "(defn g [] () 0)\n(defn f [] () (while true (defer (g))))" "not allowed inside a loop body"; refuses_src "defer in a dotimes body" - "(defn g [] 0)\n(defn f [] (dotimes [i 3] (defer (g))))" + "(defn g [] () 0)\n(defn f [] () (dotimes [i 3] (defer (g))))" "not allowed inside a loop body"; refuses_src "defer in a branch" - "(defn g [] 0)\n(defn f [] (if true (defer (g)) 0))" + "(defn g [] () 0)\n(defn f [] () (if true (defer (g)) 0))" "not allowed inside a branch"; refuses_src "defer in a let inside a loop" - "(defn g [] 0)\n(defn f [] (while true (let [x 1] (defer (g)))))" + "(defn g [] () 0)\n(defn f [] () (while true (let [x 1] (defer (g)))))" "not allowed inside a loop body"; refuses_src "defer in a let inside a branch" - "(defn g [] 0)\n(defn f [] (if true (let [x 1] (defer (g))) 0))" + "(defn g [] () 0)\n(defn f [] () (if true (let [x 1] (defer (g))) 0))" "not allowed inside a branch"; (* ── (Map K V), spec-memory.md step 4 ────────────────────────── @@ -1798,13 +1798,13 @@ ERR@7 unexpected token: not the kind the caller was reading Unit as a value is refused rather than dividing a cache line by zero, and it is named because it is the natural spelling of a set. *) refuses_src "a float is not a map key" - "(defn f [m (Map f32 i32)] 0)" "is not a map key"; + "(defn f [m (Map f32 i32)] () 0)" "is not a map key"; refuses_src "a Ptr is not a map key" - "(defn f [m (Map (Ptr i32) i32)] 0)" "hash an address"; + "(defn f [m (Map (Ptr i32) i32)] () 0)" "hash an address"; refuses_src "a map value may not own storage" - "(defn f [m (Map i32 (Vec i32))] 0)" "holds a move-only value"; - refuses_src "a map value may not be Unit" - "(defn f [m (Map i32 Unit)] 0)" "cannot be Unit"; + "(defn f [m (Map i32 (Vec i32))] () 0)" "holds a move-only value"; + refuses_src "a map value may not be ()" + "(defn f [m (Map i32 ())] () 0)" "cannot be ()"; refuses_src "map-new with nothing to say what it maps" "(defn main [] i32 (let [m (map-new)] (free m)) 0)" "nothing here says what (map-new) maps"; @@ -1967,16 +1967,16 @@ ERR@7 unexpected token: not the kind the caller was reading unions through each other. (Ptr T) breaks the cycle and is exercised in the program above -- it is the shape a Form has. *) refuses_src "a union that contains itself by value" - "(defunion T [Leaf (Node [l T r T])])\n(defn f [t T] 0)" + "(defunion T [Leaf (Node [l T r T])])\n(defn f [t T] () 0)" "T contains itself by value"; refuses_src "two unions that contain each other by value" - "(defunion A [(X [b B])])\n(defunion B [(Y [a A])])\n(defn f [a A] 0)" + "(defunion A [(X [b B])])\n(defunion B [(Y [a A])])\n(defn f [a A] () 0)" "contains itself by value"; refuses_src "a union with no cases" - "(defunion U [])\n(defn f [u U] 0)" + "(defunion U [])\n(defn f [u U] () 0)" "declares no cases"; refuses_src "a union case that owns a Vec" - "(defunion U [(A [v (Vec i32)])])\n(defn f [u U] 0)" + "(defunion U [(A [v (Vec i32)])])\n(defn f [u U] () 0)" "which is move-only"; (* At the operation, not at the type: a struct key is decided by walking its fields and the struct table is not necessarily complete while a @@ -1984,7 +1984,7 @@ ERR@7 unexpected token: not the kind the caller was reading pair is emitted. A union reaches the same place. *) refuses_src "a union is not a map key" "(defunion U [A B])\n\ - (defn f [m (Map U i32) k U] (put m k 1))" + (defn f [m (Map U i32) k U] () (put m k 1))" "the payload past the case in hand is indeterminate"; (* A global cannot hold a case, because writing one at link time means serialising the fields into the payload blob and a string field is a diff --git a/test/test_flan.ml b/test/test_flan.ml index 761458e..ff4a484 100644 --- a/test/test_flan.ml +++ b/test/test_flan.ml @@ -178,8 +178,8 @@ let () = reads "two discards" "(f #_#_a b c)" "(f c)"; reads "three discards" "(f #_#_#_a b c d)" "(f d)"; (* Every position a form can appear in. *) - reads "discard at top level" "#_(defn a [] 1) (defn b [] 2)" "(defn b [] 2)"; - reads "discard a whole file" "#_(defn a [] 1)" ""; + reads "discard at top level" "#_(defn a [] () 1) (defn b [] () 2)" "(defn b [] () 2)"; + reads "discard a whole file" "#_(defn a [] () 1)" ""; reads "discard before quote" "(f #_a 'b)" "(f (quote b))"; reads "discard of a quote" "(f #_'a b)" "(f b)"; (* Nested, which the recursive read gives for free. *) @@ -368,7 +368,7 @@ let () = (* ── Types: brackets mean different things by position ─────────── *) let ty src = - match parse_decl (Printf.sprintf "(defn f [x %s])" src) with + match parse_decl (Printf.sprintf "(defn f [x %s] ())" src) with | { d = Defn { params = [ { fty; _ } ]; _ }; _ } -> fty.t | _ -> failwith "bad type test" in @@ -389,10 +389,14 @@ let () = (match (parse_decl "(defn f [x i32] bool x)").d with | Defn { ret = Some _; params = [ _ ]; fbody = [ _ ]; _ } -> () | _ -> check "defn with return type" false); - (* An omitted return type means Unit — the body must not be eaten as a type *) - (match (parse_decl "(defn f [x i32] (g x))").d with - | Defn { ret = None; fbody = [ _ ]; _ } -> () - | _ -> check "defn without return type" false); + (* () is the unit return type, and the body is what follows it. *) + (match (parse_decl "(defn f [x i32] () (g x))").d with + | Defn { ret = Some { t = Tname "Unit"; _ }; fbody = [ _ ]; _ } -> () + | _ -> check "defn returning ()" false); + (* A lone () is the return type and an empty body, not a body of one form. *) + (match (parse_decl "(defn f [x i32] ())").d with + | Defn { ret = Some { t = Tname "Unit"; _ }; fbody = []; _ } -> () + | _ -> check "defn returning () with no body" false); (match (parse_decl "(defvar grid [4 u32])").d with | Defvar ("grid", Some _, Zeroed) -> () | _ -> check "defvar is ZII" false); @@ -429,7 +433,7 @@ let () = ~needle:"defmacro is (defmacro name [param ...] body ...)"; parse_rejects "defmacro with a non-name param" "(defmacro m [1] x)" ~needle:"expected a name"; - parse_rejects "defmacro in expression position" "(defn f [] (defmacro m [] 1))" + parse_rejects "defmacro in expression position" "(defn f [] () (defmacro m [] 1))" ~needle:"top-level declaration"; (* Quasiquote is a desugaring over Form, and it has already run by the time @@ -463,9 +467,9 @@ let () = ~needle:"quasiquote inside a quasiquote"; (* Not a missing feature — an unquote outside a quasiquote is a mistake, and the reader cannot catch it because it does not track where it is. *) - parse_rejects "unquote outside a quasiquote" "(defn f [] ~x)" + parse_rejects "unquote outside a quasiquote" "(defn f [] () ~x)" ~needle:"means nothing outside a quasiquote"; - parse_rejects "splice where a splice makes no sense" "(defn f [] (+ 1 ~@xs))" + parse_rejects "splice where a splice makes no sense" "(defn f [] () (+ 1 ~@xs))" ~needle:"splices only into a list or a vector"; (* A splice with no bracket around it. The quasiquote is real here, so this one is the desugaring's refusal and not the parser's. *) @@ -477,17 +481,17 @@ let () = parse_rejects "odd field pairs" "(defstruct S [a])"; parse_rejects "cond without body" "(cond a)"; parse_rejects "unknown top form" "(nope x)"; - parse_rejects "break takes only a label" "(defn f [] (break 1))" + parse_rejects "break takes only a label" "(defn f [] () (break 1))" ~needle:"break is (break) or (break :label)"; - parse_rejects "continue takes only a label" "(defn f [] (continue x))" + parse_rejects "continue takes only a label" "(defn f [] () (continue x))" ~needle:"continue is (continue) or (continue :label)"; - parse_rejects "a labelled while still needs a test" "(defn f [] (while :o))" + parse_rejects "a labelled while still needs a test" "(defn f [] () (while :o))" ~needle:"(while :label test body ...)"; - parse_rejects "array with no type" "(defn f [] (array 4))" + parse_rejects "array with no type" "(defn f [] () (array 4))" ~needle:"array is (array COUNT TYPE)"; - parse_rejects "array given a value, not a type" "(defn f [] (array 4 5))" + parse_rejects "array given a value, not a type" "(defn f [] () (array 4 5))" ~needle:"expected a type"; - parse_rejects "array with a non-constant count" "(defn f [] (array (+ 1 1) f32))" + parse_rejects "array with a non-constant count" "(defn f [] () (array (+ 1 1) f32))" ~needle:"an array length is an integer or a constant's name"; (* ── The corpus parses ─────────────────────────────────────────── *) @@ -664,11 +668,11 @@ let () = rejects_check "bare None has no type" "(defconst x None)" ~needle:"what None is an Option of"; accepts "param types the literal" - "(defn g [x u8]) (defn f [] (g 3))"; + "(defn g [x u8] ()) (defn f [] () (g 3))"; rejects_check "wrong argument type" - "(defn g [x u8]) (defn f [] (g 0.5))" ~needle:"expected u8"; + "(defn g [x u8] ()) (defn f [] () (g 0.5))" ~needle:"expected u8"; rejects_check "wrong arity" - "(defn g [x u8]) (defn f [] (g 1 2))" ~needle:"takes 1 argument"; + "(defn g [x u8] ()) (defn f [] () (g 1 2))" ~needle:"takes 1 argument"; rejects_check "wrong return type" "(defn f [] bool 1)" ~needle:"expected bool"; rejects_check "if branches disagree" @@ -678,18 +682,18 @@ let () = (* A lowercase name is a type variable (plan.org, Types), so a mistyped primitive would otherwise be reported as unimplemented generics and send you to plan.org instead of to the character you mistyped. *) - rejects_check "a mistyped primitive" "(defn f [x f65])" + rejects_check "a mistyped primitive" "(defn f [x f65] ())" ~needle:"did you mean f64?"; - rejects_check "a transposed primitive" "(defn f [x stirng])" + rejects_check "a transposed primitive" "(defn f [x stirng] ())" ~needle:"did you mean string?"; rejects_check "a mistyped struct" - "(defstruct Cursor [x i32]) (defn f [c Curser])" + "(defstruct Cursor [x i32]) (defn f [c Curser] ())" ~needle:"did you mean Cursor?"; (* Nothing close: the type-variable rule still applies, and still names the milestone. *) - rejects_check "a real type variable" "(defn f [x t])" + rejects_check "a real type variable" "(defn f [x t] ())" ~needle:"milestone 5"; - rejects_check "an unknown concrete type" "(defn f [x Widget])" + rejects_check "an unknown concrete type" "(defn f [x Widget] ())" ~needle:"unknown type Widget"; (* ── Static bounds ─────────────────────────────────────────────── *) @@ -746,7 +750,7 @@ let () = accepts "field through a pointer auto-derefs" (cursor ^ "(defn f [c (Ptr Cursor)] i32 (.pos c))"); accepts "set through a pointer" - (cursor ^ "(defn f [c (Ptr Cursor)] (set (.pos c) 1))"); + (cursor ^ "(defn f [c (Ptr Cursor)] () (set (.pos c) 1))"); rejects_check "field of a non-struct" "(defn f [x i32] i32 (.pos x))" ~needle:"is not a struct"; @@ -754,14 +758,14 @@ let () = accepts "a local is assignable" "(defn f [] i32 (let [x 1] (set x 2) x))"; rejects_check "a parameter is not assignable" - "(defn f [x i32] (set x 2))" ~needle:"parameters are not assignable"; + "(defn f [x i32] () (set x 2))" ~needle:"parameters are not assignable"; rejects_check "a constant is not assignable" - "(defconst k 1) (defn f [] (set k 2))" ~needle:"is a constant"; + "(defconst k 1) (defn f [] () (set k 2))" ~needle:"is a constant"; accepts "addr of a local gives a pointer" (cursor ^ "(defn g [c (Ptr Cursor)] i32 (.pos c)) \ (defn f [s [u8]] i32 (let [c (Cursor {.src s})] (g (addr c))))"); rejects_check "addr of a non-place" - "(defn f [] (addr (+ 1 2)))" ~needle:"addr takes the address of a place"; + "(defn f [] () (addr (+ 1 2)))" ~needle:"addr takes the address of a place"; (* ── Option, some, match ───────────────────────────────────────── *) accepts "some unwraps in an Option-returning function" @@ -787,11 +791,11 @@ let () = rejects_check "unknown name" "(defn f [] i32 nope)" ~needle:"unknown name"; rejects_check "unknown function" "(defn f [] i32 (nope 1))" ~needle:"unknown function"; - rejects_check "defined twice" "(defn f []) (defn f [])" + rejects_check "defined twice" "(defn f [] ()) (defn f [] ())" ~needle:"defined twice"; - accepts "main with no parameters and no return" "(defn main [])"; + accepts "main with no parameters and no return" "(defn main [] ())"; accepts "main with argv and a status" "(defn main [args [string]] i32 0)"; - rejects_check "main with a wrong parameter" "(defn main [n i32])" + rejects_check "main with a wrong parameter" "(defn main [n i32] ())" ~needle:"main takes no parameters"; rejects_check "main returning the wrong type" "(defn main [] bool true)" ~needle:"main returns i32"; @@ -802,14 +806,14 @@ let () = (* (Vec T) is built. What is still refused is the arity: one element type, and a near-miss there would otherwise resolve to a type variable and come back as generics. *) - rejects_check "Vec takes one type" "(defn f [x (Vec i32 i32)])" + rejects_check "Vec takes one type" "(defn f [x (Vec i32 i32)] ())" ~needle:"exactly one type"; (* {K V} resolves now — it is the Map type spelling, and the only one, since a bare map form in expression position is a struct literal's field list. What is still refused is the arity, for the same reason Vec's is: a near-miss would otherwise resolve to a type variable and come back as generics. *) - rejects_check "Map takes two types" "(defn f [x (Map i32)])" + rejects_check "Map takes two types" "(defn f [x (Map i32)] ())" ~needle:"exactly two types"; rejects_check "Result is milestone 6" "(defn f [] (Result i32 i32) None)" ~needle:"milestone 6"; @@ -823,10 +827,10 @@ let () = rather than once per iteration, and a branch cannot say "maybe registered". *) rejects_check "defer is refused in a loop body" - "(defn g [] 0) (defn f [] (while true (defer (g))))" + "(defn g [] () 0) (defn f [] () (while true (defer (g))))" ~needle:"a loop body"; rejects_check "defer is refused in a branch" - "(defn g [] 0) (defn f [] (if true (defer (g)) 0))" + "(defn g [] () 0) (defn f [] () (if true (defer (g)) 0))" ~needle:"a branch"; (* break and continue. The interesting half is the *relative* rule: a jump may not cross a construct that has work to do on the way out, and the @@ -834,34 +838,34 @@ let () = [return] still carries, and the accepting cases below are the ones a blanket rule would have got wrong. *) accepts "break leaves the innermost loop" - "(defn f [] (while true (break)))"; + "(defn f [] () (while true (break)))"; accepts "a labelled break leaves the named loop" - "(defn f [] (while :o true (while true (break :o))))"; + "(defn f [] () (while :o true (while true (break :o))))"; accepts "continue in a dotimes" - "(defn f [] (dotimes [i 3] (continue)))"; + "(defn f [] () (dotimes [i 3] (continue)))"; rejects_check "break outside a loop" - "(defn f [] (break))" ~needle:"only allowed inside a loop"; + "(defn f [] () (break))" ~needle:"only allowed inside a loop"; rejects_check "continue outside a loop" - "(defn f [] (continue))" ~needle:"only allowed inside a loop"; + "(defn f [] () (continue))" ~needle:"only allowed inside a loop"; rejects_check "a label naming no enclosing loop" - "(defn f [] (while true (break :nope)))" ~needle:"no loop named :nope"; + "(defn f [] () (while true (break :nope)))" ~needle:"no loop named :nope"; (* The rule the blanket one could not express, both ways round. A loop wholly inside a restart-case body keeps its local break; a break that would *leave* the restart-case is refused, and says so. *) accepts "a loop inside a restart-case may break out of itself" - "(defn f [] (restart-case (while true (break)) (go [] (println \"\"))))"; + "(defn f [] () (restart-case (while true (break)) (go [] (println \"\"))))"; rejects_check "break may not leave a restart-case" - "(defn f [] (while true (restart-case (break) (go [] (println \"\")))))" + "(defn f [] () (while true (restart-case (break) (go [] (println \"\")))))" ~needle:"a restart-case"; (* A clause is a barrier for the same reason the body is: it runs after a transfer landed, with the form's frames still to be popped. *) rejects_check "break may not leave a restart-case from a clause" - "(defn f [] (while true (restart-case (println \"\") (go [] (break)))))" + "(defn f [] () (while true (restart-case (println \"\") (go [] (break)))))" ~needle:"a restart-case"; accepts "a loop inside a handler-bind may break out of itself" - "(defstruct C [n i32]) (defn f [] (handler-bind [(C [c] 0)] (while true (break))))"; + "(defstruct C [n i32]) (defn f [] () (handler-bind [(C [c] 0)] (while true (break))))"; rejects_check "break may not leave a handler-bind" - "(defstruct C [n i32]) (defn f [] (while true (handler-bind [(C [c] 0)] (break))))" + "(defstruct C [n i32]) (defn f [] () (while true (handler-bind [(C [c] 0)] (break))))" ~needle:"a handler-bind"; (* An import is resolved by [Load] before the checker runs, so one that reaches [Check] means a driver skipped that step. *) @@ -869,14 +873,14 @@ let () = "(import rl \"vendor:raylib\")" ~needle:"not resolved"; (* Keywords resolve against an enum and against nothing else. *) rejects_check "a keyword needs an enum" - "(defn g [x i32]) (defn f [] (g :space))" ~needle:"is expected here"; + "(defn g [x i32] ()) (defn f [] () (g :space))" ~needle:"is expected here"; rejects_check "a keyword with no expectation" - "(defn f [] (print (i64 :space)))" ~needle:"no keyword type"; + "(defn f [] () (print (i64 :space)))" ~needle:"no keyword type"; rejects_check "a keyword that is not a member" - "(defenum Key [space 32]) (defn g [k Key]) (defn f [] (g :spcae))" + "(defenum Key [space 32]) (defn g [k Key] ()) (defn f [] () (g :spcae))" ~needle:"has no member :spcae"; accepts "a keyword that is a member" - "(defenum Key [space 32 r 82]) (defn g [k Key]) (defn f [] (g :r))"; + "(defenum Key [space 32 r 82]) (defn g [k Key] ()) (defn f [] () (g :r))"; (* Converting an enum, explicitly, in both directions. The point of the conversion is that it is written at the site: a bare integer still does not fit an enum parameter, so the checked property — a typo is an error @@ -886,11 +890,11 @@ let () = accepts "an enum converts to a float, through its i32" "(defenum Key [space 32]) (defn f [k Key] f32 (f32 k))"; accepts "an integer converts to an enum" - "(defenum Key [space 32]) (defn g [k Key]) (defn f [i i32] (g (Key i)))"; + "(defenum Key [space 32]) (defn g [k Key] ()) (defn f [i i32] () (g (Key i)))"; accepts "a value that is no declared member converts" - "(defenum Key [space 32]) (defn g [k Key]) (defn f [] (g (Key 999)))"; + "(defenum Key [space 32]) (defn g [k Key] ()) (defn f [] () (g (Key 999)))"; rejects_check "an integer still does not fit an enum on its own" - "(defenum Key [space 32]) (defn g [k Key]) (defn f [i i32] (g i))" + "(defenum Key [space 32]) (defn g [k Key] ()) (defn f [i i32] () (g i))" ~needle:"expected Key"; rejects_check "an enum does not convert to another enum" "(defenum A [x 1]) (defenum B [y 1]) (defn f [a A] B (B a))" @@ -905,8 +909,8 @@ let () = accepts "an enum is a return type" "(defenum Key [space 32]) (defn f [i i32] Key (Key i))"; accepts "an enum conversion at the head of a body is not a return type" - "(defenum Key [space 32]) (defn g [k Key]) \ - (defn f [] (Key 1) (g :space))"; + "(defenum Key [space 32]) (defn g [k Key] ()) \ + (defn f [] () (Key 1) (g :space))"; rejects_check "an enum conversion takes one argument" "(defenum Key [space 32]) (defn f [] Key (Key 1 2))" ~needle:"1 argument"; @@ -952,8 +956,8 @@ let () = An fn takes its parameter types from the position it is written in, and a defn's body that just answers one says nothing about them. *) rejects_check "an fn with nothing to say what it takes" - "(defn f [] (fn [x] x))" ~needle:"nothing here says what this fn"; - rejects_check "type variables are milestone 5" "(defn f [x a])" + "(defn f [] () (fn [x] x))" ~needle:"nothing here says what this fn"; + rejects_check "type variables are milestone 5" "(defn f [x a] ())" ~needle:"milestone 5"; (* The other half: a name in value position now *works*, and the arity is checked against the function it names. *) @@ -998,13 +1002,13 @@ let () = accepts "handler-bind over a struct condition" "(defstruct C [id i32]) (defvar n i64)\n\ - (defn f [] (handler-bind [(C [c] (set n 1))] (signal (C {.id 2}))))"; + (defn f [] () (handler-bind [(C [c] (set n 1))] (signal (C {.id 2}))))"; (* Matching is by type and there is no hierarchy, so a condition has to be a struct — an integer would have nothing to match against. *) rejects_check "signalling a non-struct" - "(defn f [] (signal 1))" ~needle:"a condition is a struct"; + "(defn f [] () (signal 1))" ~needle:"a condition is a struct"; rejects_check "erroring with a non-struct" - "(defn f [] (error 1))" ~needle:"a condition is a struct"; + "(defn f [] () (error 1))" ~needle:"a condition is a struct"; (* §2: error is Never, so it unifies with anything — including the position where a value of some other type was expected. That is what makes it usable as a restart-case body's fall-through. *) @@ -1021,7 +1025,7 @@ let () = rather than as an unknown name. *) rejects_check "a handler capturing a local" "(defstruct C [id i32])\n\ - (defn f [] (let [n 0] (handler-bind [(C [c] (set n 1))] (signal (C {.id 2})))))" + (defn f [] () (let [n 0] (handler-bind [(C [c] (set n 1))] (signal (C {.id 2})))))" ~needle:"a handler cannot see n"; (* The frames are popped on the way out of the body, so an early exit would leave them on the stack pointing into a function that has gone. *) @@ -1033,7 +1037,7 @@ let () = into a lookup and no place form for one. Refused with that reason rather than as a milestone that will never arrive. *) rejects_check "a map entry as a place" - "(defn f [] (set (get m 1) 2))" + "(defn f [] () (set (get m 1) 2))" ~needle:"a map is written with (put m k v)"; (* ── restart-case and invoke-restart, §3 to §6 ─────────────────── *) @@ -1068,15 +1072,15 @@ let () = accepts "a restart with parameters" "(defn f [] i32 (restart-case 1 (skip [n i32] n)))"; accepts "invoke-restart with arguments" - "(defn f [] (invoke-restart 'skip 1))"; + "(defn f [] () (invoke-restart 'skip 1))"; rejects_check "a restart parameter outside its clause" "(defn f [] i32 (+ (restart-case 1 (skip [n i32] n)) n))" ~needle:"unknown name n"; rejects_check "a restart argument that is not a value" - "(defn f [] (invoke-restart 'skip (println \"\")))" + "(defn f [] () (invoke-restart 'skip (println \"\")))" ~needle:"a restart argument must be a value"; rejects_check "invoke-restart on an unquoted name" - "(defn f [] (invoke-restart skip))" + "(defn f [] () (invoke-restart skip))" ~needle:"a quoted restart name and then its arguments"; (* §5 runs the defers on the way out, so a defer is already the cleanup path a transfer uses. One that starts its own transfer has no answer. *) @@ -1090,9 +1094,9 @@ let () = (fun (name, src) -> rejects_check (name ^ " is still unimplemented") src ~needle:"not implemented yet") - [ "handler-case", "(defn f [] (handler-case 1))"; - "find-restart", "(defn f [] (find-restart 'skip))"; - "compute-restarts", "(defn f [] (compute-restarts))" ]; + [ "handler-case", "(defn f [] () (handler-case 1))"; + "find-restart", "(defn f [] () (find-restart 'skip))"; + "compute-restarts", "(defn f [] () (compute-restarts))" ]; (* ── Destructuring ─────────────────────────────────────────────── *) @@ -1224,7 +1228,7 @@ let () = [ "a defn parameter", pt ^ "(defn f [{:keys [x]} Point] i32 x)"; "a defstruct field", "(defstruct S [[a b] i32])"; "an fn parameter", "(defn f [] i32 (let [g (fn [[a b]] a)] 0))"; - "a dotimes counter", "(defn f [] (dotimes [[a b] 3] 0))"; + "a dotimes counter", "(defn f [] () (dotimes [[a b] 3] 0))"; "a declare parameter", pt ^ "(declare g [{:keys [x]} Point] \"G\")" ]; (* ── match over an enum ────────────────────────────────────────── *) @@ -1548,9 +1552,9 @@ let () = let chain = synth "(defmacro m [args] `(do))\n\ - (defn a [] Unit (m))\n\ - (defn b [] Unit (a))\n\ - (defn c [] Unit (do))\n" + (defn a [] () (m))\n\ + (defn b [] () (a))\n\ + (defn c [] () (do))\n" in check "the reduction is transitive" (names_of (Macro.reduce chain) = [ "m"; "c" ]); diff --git a/test/test_session.ml b/test/test_session.ml index 7339dbd..94b60e9 100644 --- a/test/test_session.ml +++ b/test/test_session.ml @@ -218,7 +218,7 @@ let () = "not a package" — and the failure is the silent one above: the form splices as a bare [step] and the running program keeps the one it had. *) let t2, _ = Session.create ~file:"programs/sand-headless.flan" () in - (match Session.eval ~origin:"../sand.flan" t2 "(defn step [] Unit (do))" with + (match Session.eval ~origin:"../sand.flan" t2 "(defn step [] () (do))" with | c -> if c.Session.fns <> [ "sand/step" ] then fail "a form from a single-file package reported %s, wanted sand/step" @@ -226,7 +226,7 @@ let () = | exception Loc.Error (_, m) -> fail "redefining sand/step: %s" m); (* And a file that is not a package keeps its names as written. *) - (match Session.eval ~origin:"../sand.flan" t "(defn game-draw [] Unit (do))" with + (match Session.eval ~origin:"../sand.flan" t "(defn game-draw [] () (do))" with | c -> if c.Session.fns <> [ "game-draw" ] then fail "a form from the program's own file reported %s" diff --git a/tools/unit-return.py b/tools/unit-return.py new file mode 100755 index 0000000..84f2376 --- /dev/null +++ b/tools/unit-return.py @@ -0,0 +1,536 @@ +#!/usr/bin/env python3 +"""Give every `defn` an explicit return type, and rewrite `Unit` as `()`. + +`(defn f [x i32] body)` becomes `(defn f [x i32] () body)`, and a return type +already written as `Unit` -- or a `Unit` anywhere else a type is spelled, as in +`(Fn [i32] Unit)` -- becomes `()`. + +Two rules, one pass, because both are the same change: the slot after the +parameters is now unconditionally a type, so a function that returns nothing +has to say so, and the thing it says is `()`. + +Deciding whether a `defn` already has a return type is the whole difficulty, +and this script does it the way `lib/parse.ml` did before the slot became +mandatory: a form in that position is the return type when it is a *type form* +and it is not the entire body. `is_type_form` below is a transcription of the +one in parse.ml, deliberately faithful rather than improved -- being identical +to the parser it is replacing is what makes the sweep meaning-preserving. The +type names it needs come from the file's own declarations, from the prelude's +(read out of lib/prelude.ml), and from the builtin list. + +Re-runnable: a `defn` whose slot is already filled is left alone, and `()` is +itself a type form, so converting a converted file is a no-op. Parallel +branches that wrote Flan in the old spelling want this pass at merge. + + tools/unit-return.py ... # rewrite .flan in place + tools/unit-return.py --check ... # report, change nothing + tools/unit-return.py --in-strings ... # Flan inside "..." literals + tools/unit-return.py --raw-ml lib/prelude.ml # Flan in a {flan|...|flan} block + tools/unit-return.py --in-html web/index.html # Flan in 
 blocks
+
+A directory is walked for `.flan` files only. Anything else is named on the
+command line with the mode that says how its Flan is embedded, because a blind
+scan of an OCaml or HTML file would read its punctuation as Flan.
+
+`-v` logs every `defn` seen and what was decided about it, which is the only
+practical way to review a sweep this size.
+
+**Read the diff of every non-`.flan` file.** A snippet split across OCaml
+string concatenation -- `decls ^ "(defn f [s [u8]] Cursor ...)"` -- is scanned
+one literal at a time, and the names the other literal declared would be
+invisible. The embedded modes work around it by pooling every fragment's type
+declarations across the whole file, and counting a pooled name only as a bare
+symbol, exactly as the prelude's types count: as a list head it would eat
+`(Some 1)` and `(Rune {.code 65})` as return types, which is the misparse this
+change exists to remove. That is sound because no user type takes arguments --
+only the builtin constructors do, and they are known already -- but it is a
+pool and not the real scope, so read the diff.
+"""
+
+import sys, os, re
+
+DELIM = set('()[]{}";`~ \t\n\r,')
+OPENERS = {'(': ')', '[': ']', '{': '}'}
+CLOSERS = {')', ']', '}'}
+
+# lib/parse.ml, [primitives] and [builtin_types]. Present in [types] under
+# their plain names, so they count as type forms in every position.
+BUILTINS = {
+    "i8", "i16", "i32", "i64", "u8", "u16", "u32", "u64",
+    "f32", "f64", "bool", "string", "Unit", "Never",
+    "Ptr", "Option", "Result", "Vec", "Map", "Handle", "Fn",
+}
+
+NUMERIC = re.compile(r'^[-+]?[0-9]')
+
+
+class Atom:
+    def __init__(self, start, end, text):
+        self.start, self.end, self.text = start, end, text
+        self.tok = start        # never moves; `start` may slide onto a quote sigil
+        self.items = []
+
+    @property
+    def open_char(self):
+        return None
+
+    def sym(self):
+        """The symbol name, or None if this atom is not one.
+
+        A string, a keyword, a character literal and a number are all atoms and
+        none of them is a symbol -- parse.ml's [is_type_form] answers false for
+        every one of them, through its catch-all arm.
+        """
+        t = self.text
+        if not t or t[0] in '":\\' or NUMERIC.match(t):
+            return None
+        return t
+
+
+class Seq:
+    def __init__(self, open_char, start):
+        self.open_char, self.start = open_char, start
+        self.end = start
+        self.items = []
+        self.closed = False
+
+    def sym(self):
+        return None
+
+
+def lex_forms(src, i, end, stop=None):
+    """Read forms from src[i:end]. Returns (items, next_index, closed).
+
+    `closed` is False when the text ran out before the enclosing delimiter did,
+    which is how a fragment that holds only part of a form is recognised --
+    `"(defn step [] i64\\n"`, one line of a snippet built by concatenation.
+
+    The lexing rules mirror lib/reader.ml. A quote/quasiquote/unquote prefix is
+    folded into the form it applies to, so a quoted value stays one element.
+    """
+    items = []
+    n = end
+    pending_prefix = None
+
+    def push(node):
+        nonlocal pending_prefix
+        if pending_prefix is not None:
+            node.start = pending_prefix
+            pending_prefix = None
+        items.append(node)
+
+    while i < n:
+        c = src[i]
+        if c in ' \t\n\r,':
+            i += 1
+        elif c == ';':                                   # line comment
+            while i < n and src[i] != '\n':
+                i += 1
+        elif c == '"':                                   # string literal
+            j = i + 1
+            while j < n and src[j] != '"':
+                j += 2 if src[j] == '\\' else 1
+            j = min(j + 1, n)
+            push(Atom(i, j, src[i:j]))
+            i = j
+        elif c == '\\':                                  # character literal
+            j = i + 1
+            if j < n:
+                j += 1
+                while j < n and src[j] not in DELIM:
+                    j += 1
+            push(Atom(i, j, src[i:j]))
+            i = j
+        elif c in "'`~":                                 # quote sugar
+            if pending_prefix is None:
+                pending_prefix = i
+            i += 2 if (c == '~' and i + 1 < n and src[i + 1] == '@') else 1
+        elif c in OPENERS:
+            node = Seq(c, i)
+            node.items, i, node.closed = lex_forms(src, i + 1, n, OPENERS[c])
+            node.end = i
+            push(node)
+        elif c in CLOSERS:
+            return items, i + 1, True
+        else:                                            # symbol or keyword
+            j = i
+            while j < n and src[j] not in DELIM:
+                j += 1
+            if j == i:
+                j = i + 1
+            push(Atom(i, j, src[i:j]))
+            i = j
+    return items, n, False
+
+
+def head(node):
+    """The head symbol of a `(...)` form, or None."""
+    if getattr(node, 'open_char', None) != '(' or not node.items:
+        return None
+    return node.items[0].sym()
+
+
+# ── the type sets, as lib/parse.ml collects them ──────────────────────
+
+class Types:
+    """What `is_type_form` consults.
+
+    Three sets, kept apart exactly as parse.ml keeps them, because which
+    positions a name counts in depends on where it came from:
+
+    `names` -- builtins and the file's own defstruct/defunion/defalias. Count
+    as a bare symbol *and* as a list head, since `(Option f64)` is a type.
+
+    `enums`, `prelude` -- enum names and the prelude's types. Count only as a
+    bare symbol. As a list head they would eat `(Key 1)` and `(Rune {.code 65})`
+    -- a conversion and a constructor -- as return types, which is the silent
+    misparse this whole change exists to remove.
+
+    `aliases` -- import aliases, for `rl/Vector2`.
+    """
+    def __init__(self, prelude_names, prelude_enums):
+        self.names = set(BUILTINS)
+        self.enums = set(prelude_enums)
+        self.prelude = set(prelude_names)
+        self.aliases = set()
+
+    def scan(self, forms):
+        """Add what a program's top-level declarations introduce."""
+        for f in forms:
+            h = head(f)
+            if h in ('defstruct', 'defunion', 'defalias') and len(f.items) == 3:
+                n = f.items[1].sym()
+                if n:
+                    self.names.add(n)
+            elif h == 'defenum' and len(f.items) == 3:
+                n = f.items[1].sym()
+                if n:
+                    self.enums.add(n)
+            elif h == 'import' and len(f.items) == 3:
+                a = f.items[1].sym()
+                if a:
+                    self.aliases.add(a)
+
+    def copy(self):
+        t = Types(self.prelude, self.enums)
+        t.names = set(self.names)
+        t.aliases = set(self.aliases)
+        return t
+
+    def qualified(self, s):
+        i = s.find('/')
+        if i < 0:
+            return False
+        alias, name = s[:i], s[i + 1:]
+        return alias in self.aliases and name[:1].isupper()
+
+    def is_type_form(self, f):
+        oc = getattr(f, 'open_char', None)
+        if oc == '(' and not f.items:
+            return True                      # () is unit
+        if oc in ('[', '{'):
+            return True                      # [T], [n T] and {K V} are only types
+        if oc == '(':
+            h = head(f)
+            return bool(h) and (h in self.names or self.qualified(h))
+        s = f.sym()
+        if s is None:
+            return False
+        return s in self.names or s in self.enums or s in self.prelude \
+            or self.qualified(s)
+
+
+def prelude_type_names(root):
+    """The prelude's type names, from its {flan|...|flan} block.
+
+    parse.ml's [prelude_types] does the same walk over the same text; reading
+    the file keeps the two from drifting apart by hand.
+    """
+    path = os.path.join(root, 'lib', 'prelude.ml')
+    try:
+        with open(path, encoding='utf-8') as fh:
+            src = fh.read()
+    except OSError:
+        return set(), set()
+    body = flan_block(src)
+    if body is None:
+        return set(), set()
+    forms, _, _ = lex_forms(body, 0, len(body))
+    names, enums = set(), set()
+    for f in forms:
+        h = head(f)
+        if len(f.items) != 3:
+            continue
+        n = f.items[1].sym()
+        if not n:
+            continue
+        if h in ('defstruct', 'defunion', 'defalias'):
+            names.add(n)
+        elif h == 'defenum':
+            enums.add(n)
+    return names, enums
+
+
+def flan_block(src):
+    i = src.find('{flan|')
+    j = src.rfind('|flan}')
+    if i < 0 or j < i:
+        return None
+    return src[i + len('{flan|'):j]
+
+
+# ── the rewrite ───────────────────────────────────────────────────────
+
+def plan(src, types, label, log, base_line=1):
+    """Edits for one program's worth of Flan. Returns [(start, end, text)]."""
+    forms, _, _ = lex_forms(src, 0, len(src))
+    types = types.copy()
+    types.scan(forms)
+    edits = []
+
+    def line_of(off):
+        return base_line + src.count('\n', 0, off)
+
+    def walk(node, nested):
+        if getattr(node, 'open_char', None) is None:
+            # Only inside a form. Every type position is -- (Fn [i32] Unit),
+            # [Unit], the slot after a defn's parameters -- and a bare top-level
+            # `Unit` is not Flan at all. The guard is what keeps this pass off
+            # an OCaml literal that happens to spell the word, as the checker's
+            # own pattern `Tname "Unit"` does.
+            if nested and node.sym() == 'Unit':
+                edits.append((node.tok, node.end, '()'))
+            return
+        if head(node) == 'defn':
+            decide(node)
+        for it in node.items:
+            walk(it, True)
+
+    def decide(node):
+        items = node.items
+        # (defn name [params] ...). Anything else -- a metadata sigil, a
+        # malformed form -- is left alone and reported, because guessing at a
+        # shape the parser does not accept is how a sweep corrupts a file.
+        if not node.closed:
+            log.append("%s:%d: skipped, the form is cut off here -- a fragment "
+                       "of a snippet built by concatenation"
+                       % (label, line_of(node.start)))
+            return
+        if len(items) < 3 or getattr(items[2], 'open_char', None) != '[':
+            log.append("%s:%d: skipped, not (defn name [params] ...)"
+                       % (label, line_of(node.start)))
+            return
+        name = items[1].sym() or '?'
+        rest = items[3:]
+        # parse.ml's guard: a single remaining form is the body, not the
+        # return type -- [(defn f [] i32)] was a function returning Unit whose
+        # body is the name [i32]. The exception is a lone [()], which is what
+        # this script itself writes for a function with no body, and which was
+        # never a legal body form. Without it a second run would fill the slot
+        # again, and a re-runnable sweep is the point.
+        lone_unit = len(rest) == 1 and getattr(rest[0], 'open_char', None) == '(' \
+            and not rest[0].items
+        if rest and (len(rest) >= 2 or lone_unit) and types.is_type_form(rest[0]):
+            log.append("%s:%d: %s kept %s"
+                       % (label, line_of(node.start), name,
+                          src[rest[0].start:rest[0].end].replace('\n', ' ')))
+            return
+        edits.append((items[2].end, items[2].end, ' ()'))
+        log.append("%s:%d: %s filled ()" % (label, line_of(node.start), name))
+
+    for f in forms:
+        walk(f, False)
+    return edits
+
+
+def apply(src, edits):
+    if not edits:
+        return src, 0
+    out = []
+    last = 0
+    for start, end, text in sorted(edits):
+        out.append(src[last:start])
+        out.append(text)
+        last = end
+    out.append(src[last:])
+    return ''.join(out), len(edits)
+
+
+def mask_ocaml_escapes(body):
+    """Blank out OCaml escapes so the Flan lexer cannot trip on them.
+
+    Length-preserving, so offsets into the masked text index the original. A
+    `\\"` must not end a Flan string, and the `\\n\\` line continuations the
+    tests wrap their snippets with must not read as Flan character literals.
+
+    An escaped newline becomes a real one rather than a blank: a `;` comment
+    runs to end of line, so flattening `\\n` to spaces would let one comment
+    swallow the rest of the snippet.
+    """
+    chars = list(body)
+    i = 0
+    while i < len(chars) - 1:
+        if chars[i] == '\\':
+            c = chars[i + 1]
+            chars[i] = ' '
+            chars[i + 1] = c if c in '\n\t' else ('\n' if c == 'n' else ' ')
+            i += 2
+        else:
+            i += 1
+    return ''.join(chars)
+
+
+def pool(types, fragments):
+    """Fold every fragment's declarations into the bare-symbol-only sets.
+
+    One file's Flan is written in pieces -- concatenated OCaml literals, one
+    
 per section -- and a piece does not see the piece that declared its
+    types. Pooling gives it back. See the module docstring for why pooled names
+    count only in bare-symbol position.
+    """
+    for body in fragments:
+        forms, _, _ = lex_forms(body, 0, len(body))
+        seen = types.copy()
+        seen.names = set()
+        seen.enums = set()
+        seen.scan(forms)
+        types.prelude |= seen.names
+        types.enums |= seen.enums
+        types.aliases |= seen.aliases
+    return types
+
+
+def convert_flan(src, types, label, log):
+    return apply(src, plan(src, types, label, log))
+
+
+def ocaml_literals(src):
+    """(offset, masked body) for every OCaml string literal in `src`."""
+    out = []
+    i, n = 0, len(src)
+    while i < n:
+        c = src[i]
+        if c == '"':
+            j = i + 1
+            while j < n and src[j] != '"':
+                j += 2 if src[j] == '\\' else 1
+            out.append((i + 1, mask_ocaml_escapes(src[i + 1:j])))
+            i = j + 1
+        elif c == '(' and i + 1 < n and src[i + 1] == '*':   # OCaml comment
+            i += 2
+        else:
+            i += 1
+    return out
+
+
+def convert_in_strings(src, types, label, log):
+    """Flan inside ordinary OCaml `"..."` literals, as the tests write it."""
+    lits = ocaml_literals(src)
+    pool(types, [body for _, body in lits])
+    edits = []
+    for off, body in lits:
+        base = src.count('\n', 0, off) + 1
+        for s, e, t in plan(body, types, label, log, base):
+            edits.append((off + s, off + e, t))
+    return apply(src, edits)
+
+
+def convert_raw_ml(src, types, label, log):
+    """A whole {flan|...|flan} block, as lib/prelude.ml writes it."""
+    i = src.find('{flan|')
+    j = src.rfind('|flan}')
+    if i < 0 or j < i:
+        return src, 0
+    off = i + len('{flan|')
+    body = src[off:j]
+    base = src.count('\n', 0, off) + 1
+    edits = [(off + s, off + e, t) for s, e, t in plan(body, types, label, log, base)]
+    return apply(src, edits)
+
+
+CODE = re.compile(r'
(.*?)
', re.S)
+
+
+def convert_in_html(src, types, label, log):
+    """Flan in 
 blocks. HTML entities are left escaped: `<` lexes
+    as an ordinary atom and nothing this pass writes needs escaping."""
+    edits = []
+    pool(types, [m.group(1) for m in CODE.finditer(src)])
+    for m in CODE.finditer(src):
+        off = m.start(1)
+        base = src.count('\n', 0, off) + 1
+        for s, e, t in plan(m.group(1), types, label, log, base):
+            edits.append((off + s, off + e, t))
+    return apply(src, edits)
+
+
+MODES = {
+    '--in-strings': convert_in_strings,
+    '--raw-ml': convert_raw_ml,
+    '--in-html': convert_in_html,
+}
+
+
+def walk_paths(paths):
+    for p in paths:
+        if os.path.isdir(p):
+            for root, dirs, files in os.walk(p):
+                # vendor/ is not third-party: edn, raylib and agent are this
+                # repo's own packages, written in Flan, and they convert too.
+                dirs[:] = [d for d in dirs
+                           if d not in ('_build', '.git', 'node_modules')]
+                for f in sorted(files):
+                    if f.endswith('.flan'):
+                        yield os.path.join(root, f)
+        else:
+            yield p
+
+
+def main(argv):
+    check = '--check' in argv
+    verbose = '-v' in argv or '--verbose' in argv
+    modes = [m for m in MODES if m in argv]
+    if len(modes) > 1:
+        sys.stderr.write("pick one of %s\n" % ', '.join(MODES))
+        return 2
+    mode = modes[0] if modes else None
+    paths = [a for a in argv[1:] if not a.startswith('-')] or ['.']
+
+    root = os.path.dirname(os.path.dirname(os.path.abspath(__file__)))
+    pnames, penums = prelude_type_names(root)
+    if not pnames:
+        sys.stderr.write("warning: no prelude types found under %s -- a "
+                         "prelude type in return position may be mis-read\n" % root)
+
+    total_files = total_edits = 0
+    log = []
+    for path in walk_paths(paths):
+        if not path.endswith('.flan') and mode is None:
+            sys.stderr.write(
+                "%s: say how the Flan is embedded -- --in-strings for OCaml "
+                "string literals, --raw-ml for a {flan|...|flan} block, "
+                "--in-html for 
 blocks. A blind scan would read the "
+                "host language's punctuation as Flan.\n" % path)
+            return 2
+        with open(path, encoding='utf-8') as fh:
+            src = fh.read()
+        types = Types(pnames, penums)
+        fn = MODES[mode] if mode else convert_flan
+        new, n = fn(src, types, path, log)
+        if n:
+            total_files += 1
+            total_edits += n
+            print("%s: %d" % (path, n))
+            if not check:
+                with open(path, 'w', encoding='utf-8') as fh:
+                    fh.write(new)
+    if verbose:
+        for line in log:
+            print("  " + line)
+    verb = "would make" if check else "made"
+    print("%s %d edits across %d files" % (verb, total_edits, total_files))
+    return 1 if (check and total_edits) else 0
+
+
+if __name__ == '__main__':
+    sys.exit(main(sys.argv))
diff --git a/vendor/edn/edn.flan b/vendor/edn/edn.flan
index 11d91c1..c12af96 100644
--- a/vendor/edn/edn.flan
+++ b/vendor/edn/edn.flan
@@ -197,7 +197,7 @@
 ;;
 ;; The first failure wins: a later one would overwrite the offset that
 ;; explains the file, with an offset that is merely downstream of it.
-(defn fail [c (Ptr Cursor)  code i32  pos i32]
+(defn fail [c (Ptr Cursor)  code i32  pos i32] ()
   (when (= (.err c) err-none)
     (set (.err c) code)
     (set (.err-pos c) pos)))
@@ -256,7 +256,7 @@
 ;; Whitespace, commas, and `;` comments, which run to the newline or to the end
 ;; of input — a comment on the last line of a file with no trailing newline is
 ;; the case that decides whether the loop tests the length before the byte.
-(defn skip-trivia [c (Ptr Cursor)]
+(defn skip-trivia [c (Ptr Cursor)] ()
   (while (not (at-end? c))
     (let [b (at (.src c) (.pos c))]
       (cond
diff --git a/web/examples/arrays.flan b/web/examples/arrays.flan
index 747eff6..1529497 100644
--- a/web/examples/arrays.flan
+++ b/web/examples/arrays.flan
@@ -7,7 +7,7 @@
 ;; No initialiser means all-bytes-zero, so this is BSS and costs nothing.
 (defvar grid [rows [cols i32]])
 
-(defn main []
+(defn main [] ()
   (set (at grid 1 2) 7)
   (print (at grid 1 2)) (println "")           ; 7
   (print (len palette)) (println "")           ; 4
diff --git a/web/examples/boom.flan b/web/examples/boom.flan
index 7771015..09f2f83 100644
--- a/web/examples/boom.flan
+++ b/web/examples/boom.flan
@@ -7,6 +7,6 @@
     (use-placeholder [] -1)
     (retry           [] 7)))
 
-(defn main []
+(defn main [] ()
   (print (load 1))
   (println ""))
diff --git a/web/examples/bounds.flan b/web/examples/bounds.flan
index 853b734..3b4a365 100644
--- a/web/examples/bounds.flan
+++ b/web/examples/bounds.flan
@@ -3,7 +3,7 @@
 ;; (at xs 7) with a literal index does not reach the backend at all: check.ml
 ;; rejects it. This one goes through a local, so it is the runtime check that
 ;; catches it — the same message, and the program stops where it happened.
-(defn main []
+(defn main [] ()
   (let [i 7]
     (println "before")
     (print (at xs i))
diff --git a/web/examples/breakdemo.flan b/web/examples/breakdemo.flan
index 7f7ae55..d55cce7 100644
--- a/web/examples/breakdemo.flan
+++ b/web/examples/breakdemo.flan
@@ -9,7 +9,7 @@
     (use-placeholder [] -1)
     (retry           [] 7)))
 
-(defn main []
+(defn main [] ()
   (agent/start "/tmp/flan-breakdemo.sock")
   (print (load 1))
   (println ""))
diff --git a/web/examples/conds.flan b/web/examples/conds.flan
index 5537d56..b3f9728 100644
--- a/web/examples/conds.flan
+++ b/web/examples/conds.flan
@@ -2,11 +2,11 @@
 
 (defvar seen i64)
 
-(defn load-all []
+(defn load-all [] ()
   (signal (AssetMissing {.id 1}))     ; Unit — the caller carries on
   (signal (AssetMissing {.id 2})))
 
-(defn main []
+(defn main [] ()
   (load-all)                          ; no handler: a no-op
   (print seen) (println "")           ; 0
 
diff --git a/web/examples/control.flan b/web/examples/control.flan
index a99b6db..2820eaf 100644
--- a/web/examples/control.flan
+++ b/web/examples/control.flan
@@ -6,7 +6,7 @@
     (= n 0)  "zero"
     :else    "positive"))
 
-(defn countdown [n i32]
+(defn countdown [n i32] ()
   (let [i n]
     (while (> i 0)
       (print i)
@@ -20,7 +20,7 @@
       (return (Some (at s i)))))
   None)
 
-(defn main []
+(defn main [] ()
   (println (classify -3))
   (countdown 4)
   (unless false
diff --git a/web/examples/defer.flan b/web/examples/defer.flan
index d4d3a75..daa5c45 100644
--- a/web/examples/defer.flan
+++ b/web/examples/defer.flan
@@ -6,6 +6,6 @@
   (println "body")
   n)
 
-(defn main []
+(defn main [] ()
   (print (work 3))
   (println ""))
diff --git a/web/examples/enums.flan b/web/examples/enums.flan
index 4773ea5..6743251 100644
--- a/web/examples/enums.flan
+++ b/web/examples/enums.flan
@@ -7,7 +7,7 @@
     (= k :escape) "escape"
     :else         "an arrow"))
 
-(defn main []
+(defn main [] ()
   ;; :space resolves against the parameter's enum at compile time.
   ;; A typo is an error here, not a wrong number later.
   (println (key-name :space))
diff --git a/web/examples/ffi.flan b/web/examples/ffi.flan
index 2c7efb0..d34ca00 100644
--- a/web/examples/ffi.flan
+++ b/web/examples/ffi.flan
@@ -2,5 +2,5 @@
 ;; no aggregate crosses, so no wrapper is generated.
 (declare cos-f64 [x f64] f64 "cos")
 
-(defn main []
+(defn main [] ()
   (print (cos-f64 0.0)) (println ""))
diff --git a/web/examples/globals.flan b/web/examples/globals.flan
index 5b6a5d2..ea7583b 100644
--- a/web/examples/globals.flan
+++ b/web/examples/globals.flan
@@ -5,7 +5,7 @@
 (defconst cols 4)
 (defvar grid [rows [cols u32]])        ; BSS, rows*cols*4 bytes
 
-(defn main []
+(defn main [] ()
   (print cell-size) (println "")
   (print gravity) (println "")
   (print current-color) (println "")
diff --git a/web/examples/hello.flan b/web/examples/hello.flan
index fcef751..9946bc7 100644
--- a/web/examples/hello.flan
+++ b/web/examples/hello.flan
@@ -1,2 +1,2 @@
-(defn main []
+(defn main [] ()
   (println "hello from flan"))
diff --git a/web/examples/option.flan b/web/examples/option.flan
index 97986f4..ea8ea91 100644
--- a/web/examples/option.flan
+++ b/web/examples/option.flan
@@ -4,7 +4,7 @@
 (defn doubled-first [s [i32]] (Option i32)
   (Some (* 2 (some (index-of-i32 s 15)))))
 
-(defn main []
+(defn main [] ()
   (match (doubled-first (slice nums 0 4))
     (Some i) (do (print i) (println ""))          ; 4
     None     (println "not found"))
diff --git a/web/examples/pkg.flan b/web/examples/pkg.flan
index d55033b..d749471 100644
--- a/web/examples/pkg.flan
+++ b/web/examples/pkg.flan
@@ -2,7 +2,7 @@
 ;; arrives qualified by the alias this import chose.
 (import g "geom")
 
-(defn main []
+(defn main [] ()
   (let [v (g/add (g/V2 {.x 3.0 .y 0.0})
                  (g/V2 {.x 0.0 .y 4.0}))]
     (print (g/length v))
diff --git a/web/examples/places.flan b/web/examples/places.flan
index 10ce89a..fbe4c17 100644
--- a/web/examples/places.flan
+++ b/web/examples/places.flan
@@ -5,7 +5,7 @@
 (defvar room [room-size i32])
 
 ;; `set` takes a fixed list of forms, not an extensible setf.
-(defn main []
+(defn main [] ()
   (let [e (Enemy {.hp 10 .name "slime"})
         p (addr e)]
     (set spawned (+ spawned 1))    ; a local or a defvar
diff --git a/web/examples/printing.flan b/web/examples/printing.flan
index 206cd79..6a8542b 100644
--- a/web/examples/printing.flan
+++ b/web/examples/printing.flan
@@ -4,7 +4,7 @@
 (defn look-up [k Key] (Option i32)
   (if (= k :space) (Some 32) None))
 
-(defn main []
+(defn main [] ()
   (println 42)                               ; an i32, uncast
   (println 1.5)
   (println (Enemy {.hp 3 .name "wisp" .key :left}))
diff --git a/web/examples/restart.flan b/web/examples/restart.flan
index 564f8c8..24d746c 100644
--- a/web/examples/restart.flan
+++ b/web/examples/restart.flan
@@ -15,7 +15,7 @@
     (use-placeholder [] -1)
     (retry           [] 7)))
 
-(defn main []
+(defn main [] ()
   (print (fetch 1)) (println "")          ; 101 — nothing handled it
 
   (handler-bind [(AssetMissing [c] (invoke-restart 'use-placeholder))]
diff --git a/web/examples/shimdemo.flan b/web/examples/shimdemo.flan
index 9863eae..aef8782 100644
--- a/web/examples/shimdemo.flan
+++ b/web/examples/shimdemo.flan
@@ -2,6 +2,6 @@
 
 (declare-c get-mouse-position [] Vector2 "GetMousePosition")
 
-(defn main []
+(defn main [] ()
   (print (.x (get-mouse-position)))
   (println ""))
diff --git a/web/examples/structs.flan b/web/examples/structs.flan
index 278377d..299e744 100644
--- a/web/examples/structs.flan
+++ b/web/examples/structs.flan
@@ -7,10 +7,10 @@
     (at (.src c) (.pos c))
     0))
 
-(defn advance [c (Ptr Cursor)]
+(defn advance [c (Ptr Cursor)] ()
   (set (.pos c) (+ (.pos c) 1)))   ; field access derefs one level
 
-(defn main []
+(defn main [] ()
   (let [c (Cursor {.src (bytes "hi")})]   ; pos omitted, so pos is 0
     (print (peek (addr c))) (println "")
     (advance (addr c))
diff --git a/web/index.html b/web/index.html
index 4068d17..a2283cd 100644
--- a/web/index.html
+++ b/web/index.html
@@ -337,7 +337,7 @@ produced. run builds to a temporary file and execs it.

 
 
The smallest program:

 
-
(defn main []
+
(defn main [] ()
   (println "hello from flan"))

 
 
The entry point is (defn main [args [string]] i32). Both the parameter
@@ -380,7 +380,7 @@ heap is involved.

 (defvar room [room-size i32])
 
 ;; `set` takes a fixed list of forms, not an extensible setf.
-(defn main []
+(defn main [] ()
   (let [e (Enemy {.hp 10 .name "slime"})
         p (addr e)]
     (set spawned (+ spawned 1))    ; a local or a defvar
@@ -411,7 +411,7 @@ wisp
 ;; (at xs 7) with a literal index does not reach the backend at all: check.ml
 ;; rejects it. This one goes through a local, so it is the runtime check that
 ;; catches it — the same message, and the program stops where it happened.
-(defn main []
+(defn main [] ()
   (let [i 7]
     (println "before")
     (print (at xs i))
@@ -502,10 +502,10 @@ its fields, and omitted fields are zeroed.

     (at (.src c) (.pos c))
     0))
 
-(defn advance [c (Ptr Cursor)]
+(defn advance [c (Ptr Cursor)] ()
   (set (.pos c) (+ (.pos c) 1)))   ; field access derefs one level
 
-(defn main []
+(defn main [] ()
   (let [c (Cursor {.src (bytes "hi")})]   ; pos omitted, so pos is 0
     (print (peek (addr c))) (println "")
     (advance (addr c))
@@ -534,7 +534,7 @@ typo is an error there rather than a wrong number later.

     (= k :escape) "escape"
     :else         "an arrow"))
 
-(defn main []
+(defn main [] ()
   ;; :space resolves against the parameter's enum at compile time.
   ;; A typo is an error here, not a wrong number later.
   (println (key-name :space))
@@ -567,7 +567,7 @@ functions need no forward declaration. Globals come in two kinds:

 (defconst cols 4)
 (defvar grid [rows [cols u32]])        ; BSS, rows*cols*4 bytes
 
-(defn main []
+(defn main [] ()
   (print cell-size) (println "")
   (print gravity) (println "")
   (print current-color) (println "")
@@ -601,7 +601,7 @@ whose type matters is named at the top level rather than written inline.

     (= n 0)  "zero"
     :else    "positive"))
 
-(defn countdown [n i32]
+(defn countdown [n i32] ()
   (let [i n]
     (while (> i 0)
       (print i)
@@ -615,7 +615,7 @@ whose type matters is named at the top level rather than written inline.

       (return (Some (at s i)))))
   None)
 
-(defn main []
+(defn main [] ()
   (println (classify -3))
   (countdown 4)
   (unless false
@@ -655,7 +655,7 @@ on nothing else today. some unwraps Some and early-ret
 (defn doubled-first [s [i32]] (Option i32)
   (Some (* 2 (some (index-of-i32 s 15)))))
 
-(defn main []
+(defn main [] ()
   (match (doubled-first (slice nums 0 4))
     (Some i) (do (print i) (println ""))          ; 4
     None     (println "not found"))
@@ -680,7 +680,7 @@ has not executed yet and must not fire.

   (println "body")
   n)
 
-(defn main []
+(defn main [] ()
   (print (work 3))
   (println ""))

 
@@ -711,7 +711,7 @@ It is a place: (set (at grid r c) v) and (addr (at grid r c))
 ;; No initialiser means all-bytes-zero, so this is BSS and costs nothing.
 (defvar grid [rows [cols i32]])
 
-(defn main []
+(defn main [] ()
   (set (at grid 1 2) 7)
   (print (at grid 1 2)) (println "")           ; 7
   (print (len palette)) (println "")           ; 4
@@ -750,7 +750,7 @@ user-supplied printer to choose between.

 (defn look-up [k Key] (Option i32)
   (if (= k :space) (Some 32) None))
 
-(defn main []
+(defn main [] ()
   (println 42)                               ; an i32, uncast
   (println 1.5)
   (println (Enemy {.hp 3 .name "wisp" .key :left}))
@@ -859,7 +859,7 @@ and no ceremony.

 ;; arrives qualified by the alias this import chose.
 (import g "geom")
 
-(defn main []
+(defn main [] ()
   (let [v (g/add (g/V2 {.x 3.0 .y 0.0})
                  (g/V2 {.x 0.0 .y 4.0}))]
     (print (g/length v))
@@ -933,11 +933,11 @@ normally leaves the signaller to carry on — the accumulation case:

 
 (defvar seen i64)
 
-(defn load-all []
+(defn load-all [] ()
   (signal (AssetMissing {.id 1}))     ; Unit — the caller carries on
   (signal (AssetMissing {.id 2})))
 
-(defn main []
+(defn main [] ()
   (load-all)                          ; no handler: a no-op
   (print seen) (println "")           ; 0
 
@@ -971,7 +971,7 @@ first, before the clause body starts.

     (use-placeholder [] -1)
     (retry           [] 7)))
 
-(defn main []
+(defn main [] ()
   (print (fetch 1)) (println "")          ; 101 — nothing handled it
 
   (handler-bind [(AssetMissing [c] (invoke-restart 'use-placeholder))]
@@ -1060,7 +1060,7 @@ and an exit status of 134:

     (use-placeholder [] -1)
     (retry           [] 7)))
 
-(defn main []
+(defn main [] ()
   (print (load 1))
   (println ""))

 
@@ -1083,7 +1083,7 @@ is generated; a Flan string crosses as ptr+len, exactly as it is stored.

 
 
(declare cos-f64 [x f64] f64 "cos")
 
-(defn main []
+(defn main [] ()
   (print (cos-f64 0.0)) (println ""))

 
 
1