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.
This commit is contained in:
parent
385ecc5c48
commit
26c53e0a19
@ -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)))
|
||||
|
||||
|
||||
@ -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)))))]
|
||||
|
||||
@ -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
|
||||
|
||||
@ -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))
|
||||
|
||||
@ -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))
|
||||
|
||||
@ -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.
|
||||
|
||||
@ -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))
|
||||
|
||||
@ -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))
|
||||
|
||||
@ -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))
|
||||
|
||||
@ -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))
|
||||
|
||||
@ -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))
|
||||
|
||||
@ -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))
|
||||
|
||||
@ -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))
|
||||
|
||||
@ -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,
|
||||
|
||||
@ -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
|
||||
|
||||
@ -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
|
||||
|
||||
56
sand.flan
56
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))
|
||||
|
||||
@ -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))
|
||||
|
||||
@ -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 " "))
|
||||
|
||||
@ -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 "]"))
|
||||
|
||||
@ -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
|
||||
|
||||
@ -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})))
|
||||
|
||||
@ -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))
|
||||
|
||||
@ -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)
|
||||
|
||||
@ -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))]
|
||||
|
||||
@ -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))
|
||||
|
||||
@ -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)))
|
||||
|
||||
@ -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
|
||||
|
||||
@ -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)))
|
||||
|
||||
@ -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 " "))
|
||||
|
||||
|
||||
@ -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 " "))
|
||||
|
||||
|
||||
@ -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)]
|
||||
|
||||
@ -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
|
||||
|
||||
@ -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")))
|
||||
|
||||
|
||||
@ -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))
|
||||
|
||||
@ -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
|
||||
|
||||
@ -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)
|
||||
|
||||
@ -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 "] ")
|
||||
|
||||
@ -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
|
||||
|
||||
@ -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
|
||||
|
||||
@ -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"))
|
||||
|
||||
@ -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
|
||||
|
||||
@ -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
|
||||
|
||||
@ -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" ]);
|
||||
|
||||
@ -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"
|
||||
|
||||
536
tools/unit-return.py
Executable file
536
tools/unit-return.py
Executable file
@ -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 <file-or-dir>... # rewrite .flan in place
|
||||
tools/unit-return.py --check <file-or-dir>... # report, change nothing
|
||||
tools/unit-return.py --in-strings <file.ml>... # 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 <pre><code> 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
|
||||
<pre> 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'<pre><code>(.*?)</code></pre>', re.S)
|
||||
|
||||
|
||||
def convert_in_html(src, types, label, log):
|
||||
"""Flan in <pre><code> 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 <pre><code> 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))
|
||||
4
vendor/edn/edn.flan
vendored
4
vendor/edn/edn.flan
vendored
@ -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
|
||||
|
||||
@ -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
|
||||
|
||||
@ -7,6 +7,6 @@
|
||||
(use-placeholder [] -1)
|
||||
(retry [] 7)))
|
||||
|
||||
(defn main []
|
||||
(defn main [] ()
|
||||
(print (load 1))
|
||||
(println ""))
|
||||
|
||||
@ -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))
|
||||
|
||||
@ -9,7 +9,7 @@
|
||||
(use-placeholder [] -1)
|
||||
(retry [] 7)))
|
||||
|
||||
(defn main []
|
||||
(defn main [] ()
|
||||
(agent/start "/tmp/flan-breakdemo.sock")
|
||||
(print (load 1))
|
||||
(println ""))
|
||||
|
||||
@ -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
|
||||
|
||||
|
||||
@ -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
|
||||
|
||||
@ -6,6 +6,6 @@
|
||||
(println "body")
|
||||
n)
|
||||
|
||||
(defn main []
|
||||
(defn main [] ()
|
||||
(print (work 3))
|
||||
(println ""))
|
||||
|
||||
@ -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))
|
||||
|
||||
@ -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 ""))
|
||||
|
||||
@ -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 "")
|
||||
|
||||
@ -1,2 +1,2 @@
|
||||
(defn main []
|
||||
(defn main [] ()
|
||||
(println "hello from 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"))
|
||||
|
||||
@ -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))
|
||||
|
||||
@ -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
|
||||
|
||||
@ -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}))
|
||||
|
||||
@ -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))]
|
||||
|
||||
@ -2,6 +2,6 @@
|
||||
|
||||
(declare-c get-mouse-position [] Vector2 "GetMousePosition")
|
||||
|
||||
(defn main []
|
||||
(defn main [] ()
|
||||
(print (.x (get-mouse-position)))
|
||||
(println ""))
|
||||
|
||||
@ -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))
|
||||
|
||||
@ -337,7 +337,7 @@ produced. <code>run</code> builds to a temporary file and execs it.</p>
|
||||
|
||||
<p>The smallest program:</p>
|
||||
|
||||
<pre><code>(defn main []
|
||||
<pre><code>(defn main [] ()
|
||||
(println "hello from flan"))</code></pre>
|
||||
|
||||
<p>The entry point is <code>(defn main [args [string]] i32)</code>. Both the parameter
|
||||
@ -380,7 +380,7 @@ heap is involved.</p>
|
||||
(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.</p>
|
||||
(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.</p>
|
||||
(= 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:</p>
|
||||
(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.</p>
|
||||
(= 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.</p>
|
||||
(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. <code>some</code> unwraps <code>Some</code> 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.</p>
|
||||
(println "body")
|
||||
n)
|
||||
|
||||
(defn main []
|
||||
(defn main [] ()
|
||||
(print (work 3))
|
||||
(println ""))</code></pre>
|
||||
|
||||
@ -711,7 +711,7 @@ It is a place: <code>(set (at grid r c) v)</code> and <code>(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.</p>
|
||||
(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.</p>
|
||||
;; 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:</p>
|
||||
|
||||
(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.</p>
|
||||
(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:</p>
|
||||
(use-placeholder [] -1)
|
||||
(retry [] 7)))
|
||||
|
||||
(defn main []
|
||||
(defn main [] ()
|
||||
(print (load 1))
|
||||
(println ""))</code></pre>
|
||||
|
||||
@ -1083,7 +1083,7 @@ is generated; a Flan string crosses as ptr+len, exactly as it is stored.</p>
|
||||
|
||||
<pre><code>(declare cos-f64 [x f64] f64 "cos")
|
||||
|
||||
(defn main []
|
||||
(defn main [] ()
|
||||
(print (cos-f64 0.0)) (println ""))</code></pre>
|
||||
|
||||
<pre><code class="sh">1</code></pre>
|
||||
|
||||
Loading…
x
Reference in New Issue
Block a user