diff --git a/sand-sim/sim.flan b/sand-sim/sim.flan deleted file mode 100644 index cc66c8f..0000000 --- a/sand-sim/sim.flan +++ /dev/null @@ -1,122 +0,0 @@ -;;;; The falling-sand simulation, with no raylib in it. -;;;; -;;;; It is a package of its own because milestone 4 asks for sand to be tested -;;;; twice — interactive at 120 fps, and headless over N frames with the grid -;;;; hashed (plan.org, Build sequence). The headless run is the one CI does on -;;;; wasm32, and a program that imports the raylib package links the raylib -;;;; shared library on *every* target, whatever its main does. So the headless -;;;; artifact cannot import raylib at all, and the only way to have both -;;;; without two copies of the simulation is for both to import this. -;;;; -;;;; The directory is the package (plan.org, Modules): sand.flan imports it as -;;;; sim/, test/programs/sand-headless.flan imports it as sim/ too. - -(defconst screen-width 1400) -(defconst screen-height 1000) -(defconst cell-size 5) -;; f32: velocity is [f32], and there is no implicit widening. -(defconst gravity f32 0.05) -(defconst rows (/ screen-height cell-size)) -(defconst cols (/ screen-width cell-size)) -(defconst brush-size 10) - -;; Packed 0xRRGGBBAA. A cell of 0 means empty, so no Option and no tag word. -(defconst colors [4 u32] [0xE6B800FF 0x3B6E8CFF 0xA83232FF 0xCC6B1FFF]) - -;; Flat, unboxed, statically sized. No headers, so these are exactly -;; rows*cols*4 bytes each — the same memory the Odin port has. Fixed arrays are -;; values, so `(set grid (zeroed))` overwrites in place rather than reallocating. -;; No initialiser means all-bytes-zero (plan.org, zero values), so these are -;; BSS and cost nothing to start. `(zeroed)` below is the explicit spelling for -;; re-zeroing later — a memset, not an allocation. -(defvar grid [rows [cols u32]]) -(defvar velocity [rows [cols f32]]) -;; An index into colors, not a colour. -(defvar current-color i32) - -(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 [] - (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] - (let [half (/ brush-size 2)] - (dotimes [x brush-size] - (dotimes [y brush-size] - (let [r (+ y (- row half)) - c (+ x (- col half))] - (when (and (>= r 0) (< r (- rows 1)) - (>= c 0) (< c (- cols 1)) - (empty-at? r c) - (< (rand-f32) 0.5)) - (set (at grid r c) (nth colors current-color)) - (set (at velocity r c) 1.0))))))) - -(defn move-grain [from-row i32 from-col i32 - to-row i32 to-col i32 - 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) - (set (at velocity from-row from-col) 0.0)) - -;; Move the grain at [row col] as far down as it can, sliding to a free -;; diagonal neighbour when the cell below is taken. -;; -;; 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] - (let [vel (+ gravity (at velocity row col)) - y (min (- rows 1) (+ row (i32 vel)))] - (while (> y row) - (when (empty-at? y col) - (move-grain row col y col vel) - (return)) - (let [left? (and (> col 0) (empty-at? y (- col 1))) - right? (and (< col (- cols 1)) (empty-at? y (+ col 1)))] - (when (or left? right?) - (let [side (cond - (not left?) 1 - (not right?) -1 - :else (if (< (rand-f32) 0.5) 1 -1))] - (move-grain row col y (+ col side) vel) - (return)))) - (set y (- y 1))) - ;; Nowhere to fall: reset the accumulated velocity and stay put. - (set (at velocity row col) 0.0))) - -;; One frame of physics. Bottom-up, so a grain settles at most once per frame. -(defn step [] - (let [row (- rows 2)] - (while (>= row 0) - (dotimes [col cols] - (unless (empty-at? row col) - (settle row col))) - (set row (- row 1))))) - -;; FNV-1a over the grid, so the headless run has one number to compare. It has -;; to be identical on native and wasm32, which is the whole reason rand-f32 is -;; a seeded PRNG written in Flan rather than libc's (plan.org, RNG is ours). -;; Named because a let binding takes no type annotation, and 0xcbf29ce484222325 -;; does not fit the i32 an unannotated integer literal would default to. -(defconst fnv-offset u64 0xcbf29ce484222325) -(defconst fnv-prime u64 1099511628211) - -(defn hash-grid [] u64 - (let [h fnv-offset] - (dotimes [row rows] - (dotimes [col cols] - (let [c (at grid row col)] - (dotimes [b 4] - (set h (bit-xor h (u64 (bit-and (>> c (u32 (* b 8))) 255)))) - (set h (* h fnv-prime)))))) - h)) diff --git a/sand.flan b/sand.flan index dd3c080..90f5d42 100644 --- a/sand.flan +++ b/sand.flan @@ -6,10 +6,14 @@ ;;;; path to "the language runs something". ;;;; ;;;; It is tested twice: headless (N frames, hash the grid — the version CI runs -;;;; on native and wasm32) and interactive at 120 fps. This file is the -;;;; interactive half; the simulation itself lives in sand-sim/ so the headless -;;;; half can have it without linking raylib. See sand-sim/sim.flan for why that -;;;; split exists, and test/programs/sand-headless.flan for the other driver. +;;;; on native and wasm32) and interactive at 120 fps. Both halves are one file +;;;; now. The simulation lived in a package of its own for a while, not because +;;;; it wanted to but because importing raylib linked libraylib whatever main +;;;; did, and on wasm32 that link cannot succeed. The link follows what the +;;;; program reaches now, so test/programs/sand-headless.flan imports *this +;;;; file* as a package, calls the simulation directly, and pulls in neither a +;;;; window nor libraylib. The main below is not exported: an entry point is +;;;; not something a package offers. ;;;; ;;;; Note what it still deliberately does not use: no Vec, no Map, no generics, ;;;; no user-written macros, no conditions, no allocator other than the stack @@ -25,9 +29,128 @@ ;;;; it is an ordinary compile-time value, so [rows [cols u32]] is unambiguous (import rl "vendor:raylib") ; directory = package; declaration optional -(import sim "sand-sim") ; no collection prefix: relative to this file (import agent "vendor:agent") ; the dev agent: redefinitions, installed below +;;;; ── The simulation ─────────────────────────────────────────── +;;;; +;;;; No raylib between here and the next banner, which is what the headless +;;;; driver imports this file for. The hash is over exactly this. + +(defconst screen-width 1400) +(defconst screen-height 1000) +(defconst cell-size 5) +;; f32: velocity is [f32], and there is no implicit widening. +(defconst gravity f32 0.05) +(defconst rows (/ screen-height cell-size)) +(defconst cols (/ screen-width cell-size)) +(defconst brush-size 10) + +;; Packed 0xRRGGBBAA. A cell of 0 means empty, so no Option and no tag word. +(defconst colors [4 u32] [0xE6B800FF 0x3B6E8CFF 0xA83232FF 0xCC6B1FFF]) + +;; Flat, unboxed, statically sized. No headers, so these are exactly +;; rows*cols*4 bytes each — the same memory the Odin port has. Fixed arrays are +;; values, so `(set grid (zeroed))` overwrites in place rather than reallocating. +;; No initialiser means all-bytes-zero (plan.org, zero values), so these are +;; BSS and cost nothing to start. `(zeroed)` below is the explicit spelling for +;; re-zeroing later — a memset, not an allocation. +(defvar grid [rows [cols u32]]) +(defvar velocity [rows [cols f32]]) +;; An index into colors, not a colour. +(defvar current-color i32) + +(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 [] + (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] + (let [half (/ brush-size 2)] + (dotimes [x brush-size] + (dotimes [y brush-size] + (let [r (+ y (- row half)) + c (+ x (- col half))] + (when (and (>= r 0) (< r (- rows 1)) + (>= c 0) (< c (- cols 1)) + (empty-at? r c) + (< (rand-f32) 0.5)) + (set (at grid r c) (nth colors current-color)) + (set (at velocity r c) 1.0))))))) + +(defn move-grain [from-row i32 from-col i32 + to-row i32 to-col i32 + 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) + (set (at velocity from-row from-col) 0.0)) + +;; Move the grain at [row col] as far down as it can, sliding to a free +;; diagonal neighbour when the cell below is taken. +;; +;; 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] + (let [vel (+ gravity (at velocity row col)) + y (min (- rows 1) (+ row (i32 vel)))] + (while (> y row) + (when (empty-at? y col) + (move-grain row col y col vel) + (return)) + (let [left? (and (> col 0) (empty-at? y (- col 1))) + right? (and (< col (- cols 1)) (empty-at? y (+ col 1)))] + (when (or left? right?) + (let [side (cond + (not left?) 1 + (not right?) -1 + :else (if (< (rand-f32) 0.5) 1 -1))] + (move-grain row col y (+ col side) vel) + (return)))) + (set y (- y 1))) + ;; Nowhere to fall: reset the accumulated velocity and stay put. + (set (at velocity row col) 0.0))) + +;; One frame of physics. Bottom-up, so a grain settles at most once per frame. +(defn step [] + (let [row (- rows 2)] + (while (>= row 0) + (dotimes [col cols] + (unless (empty-at? row col) + (settle row col))) + (set row (- row 1))))) + +;; FNV-1a over the grid, so the headless run has one number to compare. It has +;; to be identical on native and wasm32, which is the whole reason rand-f32 is +;; a seeded PRNG written in Flan rather than libc's (plan.org, RNG is ours). +;; Named because a let binding takes no type annotation, and 0xcbf29ce484222325 +;; does not fit the i32 an unannotated integer literal would default to. +(defconst fnv-offset u64 0xcbf29ce484222325) +(defconst fnv-prime u64 1099511628211) + +(defn hash-grid [] u64 + (let [h fnv-offset] + (dotimes [row rows] + (dotimes [col cols] + (let [c (at grid row col)] + (dotimes [b 4] + (set h (bit-xor h (u64 (bit-and (>> c (u32 (* b 8))) 255)))) + (set h (* h fnv-prime)))))) + h)) + +;;;; ── The raylib front-end ────────────────────────────────── +;;;; +;;;; Everything from here on needs a window, and nothing headless reaches any +;;;; of it — which is why importing this file costs a headless build nothing. + ;; The brush sprite: a 16x8 sheet of two 8x8 frames, the ring drawn while the ;; mouse is idle and the blob while it is painting. It is here because the ;; texture calls cannot be in the acceptance table at all — loading one needs a @@ -75,7 +198,7 @@ rl/white) (rl/draw-texture brush 20 50 rl/white) (rl/draw-texture-v brush (rl/Vector2 {:x 44.0 :y 50.0}) - (rl/get-color (nth sim/colors sim/current-color))) + (rl/get-color (nth colors current-color))) (rl/draw-texture-ex brush (rl/Vector2 {:x 72.0 :y 46.0}) 0.0 2.0 rl/white))) ;; The mirrored one beside them, scaled up so the flip is visible rather ;; than eight pixels wide. If the two badges look the same, either the flip @@ -139,9 +262,9 @@ ;; place get-screen-to-world-2d is not a test case but a requirement. (defn paint [] (let [m (rl/get-screen-to-world-2d (rl/get-mouse-position) view) - row (/ (i32 (.y m)) sim/cell-size) - col (/ (i32 (.x m)) sim/cell-size)] - (sim/paint-at row col))) + row (/ (i32 (.y m)) cell-size) + col (/ (i32 (.x m)) cell-size)] + (paint-at row col))) ;; Every cross-function call in a dev build routes through an indirection cell, ;; so redefining this from the REPL reaches the running loop on the next frame. @@ -154,20 +277,20 @@ ;; 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 [] - (when (rl/key-pressed? :r) (sim/clear-grid)) + (when (rl/key-pressed? :r) (clear-grid)) (move-view) (when (rl/mouse-button-down? :left) (paint)) - (when (rl/mouse-button-released? :left) (sim/next-color)) - (sim/step)) + (when (rl/mouse-button-released? :left) (next-color)) + (step)) (defn draw-grid [] - (dotimes [row sim/rows] - (dotimes [col sim/cols] - (let [c (at sim/grid row col)] + (dotimes [row rows] + (dotimes [col cols] + (let [c (at grid row col)] (unless (= 0 c) - (rl/draw-rectangle (i32 (* col sim/cell-size)) - (i32 (* row sim/cell-size)) - sim/cell-size sim/cell-size + (rl/draw-rectangle (i32 (* col cell-size)) + (i32 (* row cell-size)) + cell-size cell-size (rl/get-color c))))))) ;; Drawn inside the camera, in world units, so every one of these moves and @@ -176,10 +299,10 @@ ;; and does not. (defn draw-world-cursor [] (let [p (rl/get-screen-to-world-2d (rl/get-mouse-position) view) - tint (rl/get-color (nth sim/colors sim/current-color)) + tint (rl/get-color (nth colors current-color)) x (.x p) y (.y p) - r (f32 (* sim/brush-size sim/cell-size))] + r (f32 (* brush-size cell-size))] ;; The brush's actual reach, as a ring, plus a thinner circle outside it. (rl/draw-ring p (* r (f32 0.9)) r (f32 0.0) (f32 360.0) 48 tint) (rl/draw-circle-lines-v p (+ r (f32 6.0)) tint) @@ -207,8 +330,8 @@ ;; And the world's own edge, so panning has something to pan against. (rl/draw-rectangle-lines-ex (rl/Rectangle {:x 0.0 :y 0.0 - :width (f32 sim/screen-width) - :height (f32 sim/screen-height)}) + :width (f32 screen-width) + :height (f32 screen-height)}) (f32 2.0) (rl/get-color 0x303030FF)))) ;; Drawn outside the camera, in screen pixels, so it stays put while the world @@ -241,11 +364,11 @@ ;; with a ring round it, so `current-color` is readable off the screen. (let [sw (- (rl/get-screen-width) 40) sh (- (rl/get-screen-height) 40)] - (dotimes [i (len sim/colors)] - (let [cx (- sw (* (- (len sim/colors) (+ i 1)) 46)) - c (rl/get-color (nth sim/colors i))] + (dotimes [i (len colors)] + (let [cx (- sw (* (- (len colors) (+ i 1)) 46)) + c (rl/get-color (nth colors i))] (rl/draw-circle cx sh (f32 16.0) c) - (when (= i sim/current-color) + (when (= i current-color) (rl/draw-circle-lines cx sh (f32 22.0) rl/white)))) ;; A zoom read-out with no number in it, because there is no string @@ -297,7 +420,7 @@ (defn main [] (rl/set-trace-log-level :warning) - (rl/init-window sim/screen-width sim/screen-height "SAND") + (rl/init-window screen-width screen-height "SAND") (defer (rl/close-window)) (rl/set-target-fps 120) ;; Before anything draws: a zero zoom is singular and nothing would appear. diff --git a/test/dune b/test/dune index 738c770..5277921 100644 --- a/test/dune +++ b/test/dune @@ -6,9 +6,9 @@ (deps (file %{workspace_root}/calc-me.flan) (file %{workspace_root}/sand.flan) - ; The sim package and the raylib bindings, because the headless sand case and - ; the FFI case import them and an import reads the directory at build time. - (glob_files %{workspace_root}/sand-sim/*) + ; The raylib bindings, because sand.flan and the FFI case import them and an + ; import reads the directory at build time. sand.flan itself is above: the + ; headless case imports it as a single-file package. (glob_files %{workspace_root}/vendor/raylib/*) ; The dev agent package: its Flan declarations and the C that implements them. (glob_files %{workspace_root}/vendor/agent/*) diff --git a/test/programs/pkg-hidden-main.flan b/test/programs/pkg-hidden-main.flan new file mode 100644 index 0000000..7d247f3 --- /dev/null +++ b/test/programs/pkg-hidden-main.flan @@ -0,0 +1,12 @@ +;;;; A name the import did not bring. +;;;; +;;;; sand.flan declares a main and this imports it, so sand/main is a name +;;;; somebody might reasonably write — and is not one. Left to the checker it +;;;; would be "unknown name", which is true and unhelpful; the refusal has to +;;;; say the name is missing on purpose. Never built: the refusal is the test. + +(import sand "../../sand.flan") + +(defn main [] i32 + (sand/main) + 0) diff --git a/test/programs/pkg-shared.flan b/test/programs/pkg-shared.flan new file mode 100644 index 0000000..a12660e --- /dev/null +++ b/test/programs/pkg-shared.flan @@ -0,0 +1,15 @@ +;;;; One package reached along two routes. +;;;; +;;;; raylib is imported here and again by sand.flan, which this also imports. +;;;; Loading it twice would declare every binding twice and be refused as a +;;;; collision, so a directory is read once and keyed by its real path. Nothing +;;;; calls into raylib, so nothing links it either. + +(import sand "../../sand.flan") +(import rl "vendor:raylib") + +(defn main [] i32 + (sand/paint-at 4 (/ sand/cols 2)) + (sand/step) + (print-line "ok") + 0) diff --git a/test/programs/pkg-two-aliases.flan b/test/programs/pkg-two-aliases.flan new file mode 100644 index 0000000..4960fc0 --- /dev/null +++ b/test/programs/pkg-two-aliases.flan @@ -0,0 +1,11 @@ +;;;; One directory, two names. +;;;; +;;;; An import is a rename into one flat namespace, so a directory reached +;;;; twice has to arrive under one alias: with two, every declaration in it +;;;; exists twice and the checker refuses a collision nobody wrote. Said here +;;;; instead, where the two import forms are still visible. + +(import rl "vendor:raylib") +(import ray "vendor:raylib") + +(defn main [] i32 0) diff --git a/test/programs/pkg-two-mains.flan b/test/programs/pkg-two-mains.flan new file mode 100644 index 0000000..e5b525f --- /dev/null +++ b/test/programs/pkg-two-mains.flan @@ -0,0 +1,8 @@ +;;;; Two entry points. +;;;; +;;;; There is one top-level namespace, so this is one name declared twice — +;;;; and the entry point is exactly the name no program can be vague about. + +(defn main [] i32 0) + +(defn main [] i32 1) diff --git a/test/programs/sand-headless.flan b/test/programs/sand-headless.flan index 3135093..dedcf9a 100644 --- a/test/programs/sand-headless.flan +++ b/test/programs/sand-headless.flan @@ -1,15 +1,21 @@ ;;;; sand.flan's other half: N frames, no window, hash the grid. ;;;; -;;;; This is the version CI runs on native *and* wasm32, which is why it does -;;;; not import the raylib package — a program that does links libraylib on -;;;; every target regardless of what its main does. The simulation itself is -;;;; shared with the interactive driver; only the input differs. +;;;; This is the version CI runs on native *and* wasm32, and it imports +;;;; sand.flan itself — window, raylib bindings, dev agent and all. It builds +;;;; for wasm32 anyway because the link follows what the program reaches: +;;;; nothing here calls into raylib, so no shim is compiled and no -lraylib is +;;;; passed, and the front-end's own functions are never emitted. sand.flan's +;;;; main is not exported, so the only main is this one. +;;;; +;;;; A package is a directory, except when it is a single .flan file named +;;;; outright — which is this, because sand.flan shares the repository root +;;;; with three other loose programs. ;;;; ;;;; The hash is a regression test only because the sequence is reproducible: ;;;; rand-f32 is a seeded PRNG written in Flan, so the same seed gives the same ;;;; grains in the same places on both targets (plan.org, RNG is ours). -(import sim "../../sand-sim") +(import sand "../../sand.flan") (defconst frames 40) @@ -18,10 +24,10 @@ ;; Four clouds, spread across the top, one per colour. Deterministic ;; positions: the mouse is what the interactive driver has and this does not. (dotimes [i 4] - (sim/next-color) - (sim/paint-at 4 (* (+ i 1) (/ sim/cols 5)))) + (sand/next-color) + (sand/paint-at 4 (* (+ i 1) (/ sand/cols 5)))) (dotimes [f frames] - (sim/step)) - (print-i64 (i64 (sim/hash-grid))) + (sand/step)) + (print-i64 (i64 (sand/hash-grid))) (newline) 0) diff --git a/test/test_acceptance.ml b/test/test_acceptance.ml index 770d561..0ac5fd1 100644 --- a/test/test_acceptance.ml +++ b/test/test_acceptance.ml @@ -454,6 +454,40 @@ let () = "ok\n"; outputs "an imported package nothing calls, -O0" ~opt:"-O0" "programs/pkg-unused.flan" "ok\n"; + (* A package may import a package, and one reached along two routes is read + once: pkg-shared imports sand.flan, which imports raylib, and imports + raylib itself. Loading it twice would declare every binding twice. *) + outputs "a package reached along two routes" "programs/pkg-shared.flan" + "ok\n"; + + (* The refusals. Each is a thing that would otherwise fail later and + elsewhere — as a name the checker says is unknown, or as a collision + nobody wrote — so what is asserted is the *reason*, at the form that + caused it. None of these is built; being refused is the whole test. *) + let refuses name path needle = + let attempt () = + let l = Load.program ~file:path (Parse.program (Reader.read_file path)) in + ignore (Check.program l.Load.decls) + in + match attempt () with + | () -> + incr failures; + Printf.printf "FAIL %s\n it was accepted\n" name + | exception Loc.Error (_, m) -> + if not (contains m needle) then begin + incr failures; + Printf.printf "FAIL %s\n said: %S\n wanted: %S in it\n" + name m needle + end + in + (* Visibility: main is not a name a package offers, and saying so is the + point — "unknown name sand/main" would be true and useless. *) + refuses "a package's main is not visible" "programs/pkg-hidden-main.flan" + "sand/main is not a name"; + refuses "one directory under two aliases" "programs/pkg-two-aliases.flan" + "one directory is one set of names"; + refuses "two mains in one program" "programs/pkg-two-mains.flan" + "main is defined twice"; (* ── wasm32 (NEXT.md, deferred item 6) ────────────────────────────── The second target, and the reason sand-headless imports no raylib. What diff --git a/test/test_session.ml b/test/test_session.ml index 4e5521f..70469a8 100644 --- a/test/test_session.ml +++ b/test/test_session.ml @@ -159,14 +159,14 @@ let () = editor. *) let t, _ = Session.create ~file:"../sand.flan" in (match - Session.eval ~origin:"../sand-sim/sim.flan" t - "(defn settle [row i32 col i32] Unit (do))" + Session.eval ~origin:"../vendor/agent/agent.flan" t + "(defn poll [] i32 (poll-raw))" with | c -> - if c.Session.fns <> [ "sim/settle" ] then - fail "a form from a package file reported %s, wanted sim/settle" + if c.Session.fns <> [ "agent/poll" ] then + fail "a form from a package file reported %s, wanted agent/poll" (String.concat " " c.Session.fns) - | exception Loc.Error (_, m) -> fail "redefining sim/settle: %s" m); + | exception Loc.Error (_, m) -> fail "redefining agent/poll: %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 | c ->