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

Merge branch 'pkg-visibility' into dev-loop

Browse Source
This commit is contained in:
Joseph Ferano 2026-09-11 20:16:18 +07:00
commit 1b2533b41e
17 changed files with 871 additions and 282 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

131
NEXT.md
View File

@ -146,7 +146,6 @@ reader ✅ → parse ✅ → load ✅ → check ✅ → emit ✅ → clang ✅
| `vendor/raylib/` | **the raylib package: `raylib.flan`, `shim.c`, `link`** |
| `vendor/agent/` | **the dev agent: a socket, a loader thread, install at a frame boundary** |
| `emacs/` | **`flan-mode.el`, `flan-dev.el`, `flan-repl.el`: the editor half of the dev loop** |
| `sand-sim/` | **the falling-sand simulation, with no raylib in it** |
| `bin/main.ml` | `flan read \| parse \| check \| emit \| build \| run \| reload \| dev` |
| `test/test_flan.ml` | reader, parser and checker |
| `test/test_acceptance.ml` | expression/result pairs + whole programs + the traps |
@ -340,64 +339,100 @@ slash.
A package may also carry the C it binds to: every `.c` file in the directory is
compiled into the build, and a file named `link` lists extra linker arguments.
Whether those reach the build at all is decided *after* checking — see below.
This is not a module system yet. No visibility (hence `rl/get-color-raw` being
callable), no cycle detection, and a package cannot import another one.
**A package may be a single `.flan` file** named outright, rather than a
directory. That is for the program that is also a library: `sand.flan` shares
the repository root with three other loose programs, so naming its directory
would import all four. A file carries no `.c` and no `link` file; those belong
to a directory.
## sand.flan is two programs
**A package may import a package.** The qualification flattens to the *inner*
alias — raylib imported by a package that is itself imported is still `rl/…`,
never `sand/rl/…` — because a directory reached along two routes has to arrive
under one set of names or the checker sees every declaration twice. A directory
is keyed by its real path and read once, which is also what ends a cycle: a
package that imports itself meets its own entry and contributes nothing the
second time, and the namespace being flat, mutually dependent packages simply
work. The same directory under two *different* aliases is refused.
**The stated reason below is narrower than it reads, and the real fix is a
one-line change to `Load` rather than two files.** Two claims got run together:
**Visibility is one rule: `main` is not exported.** A package carrying one
would collide with the importer's the moment anything imported it, so a program
could never be a package; and `main` is a reachability root, so an imported one
would keep everything it calls alive. Writing `sand/main` is refused at the
line that wrote it, with the reason — left to the checker it would be "unknown
name", which is true and useless.
- *raylib does not work on wasm* — false. It works through emscripten, which
plan.org says itself. What is true is that it does not work on the **wasi**
path, which is what the headless table targets, and which has no GL and no
browser.
- *a game loop cannot be expressed on wasm* — false. The browser cannot be
blocked, so a web build drives the loop with `emscripten_set_main_loop`
instead of a `while`. That is a different `main`, not a different program,
and nothing about it requires the simulation to live in its own package.
Still missing: a package-private marker for anything other than `main`, which
is why `rl/get-color-raw` is callable.
What actually justifies the split is smaller and stands on its own: **the
headless test needs no window and no input on any target.** `sand.flan` could
not be that test even natively — with no mouse the grid stays empty and
`settle` and `move-grain` never run on real data.
## The link follows the program
What makes the split *mandatory* rather than chosen is the packaging
limitation: **`Load` collects a package's C sources and link flags whether or
not anything references the package.** Make that conditional and the two files
become a preference. That is the thing to fix, and it is not large.
plan.org wants sand tested twice — interactive at 120 fps, and headless over N
frames with the grid hashed, the version CI runs on native *and* wasm32. Those
cannot be one binary: `Load` collects a package's C sources and linker
arguments unconditionally, so anything importing the raylib package links
libraylib on every target regardless of what its `main` does, and on wasm32
`Load` used to hand a package's `.c` files and `link` arguments to the build
the moment it was imported, whatever the importing program did with them. So
anything naming `vendor:raylib` linked libraylib on every target, and on wasm32
that link cannot succeed.
So the simulation moved to `sand-sim/`, which imports nothing. `sand.flan`
imports it as `sim/` and adds the window, the mouse and the drawing;
`test/programs/sand-headless.flan` imports it and adds a seed, four
deterministic clouds, 40 frames and an FNV-1a hash. One copy of the physics.
`lib/reach.ml` answers it from the checked program instead. Start at `main` and
at the globals that run before it, follow every call — including the `Handled`
frames, where a lifted handler clause is reached by address and by nothing else
— and keep what is reached. A package none of whose externs survive contributes
no C and no linker argument.
The headless case is what actually *verifies* milestone 4 — running the
interactive build only proves it enters its loop, because with no mouse input
the grid stays empty and `paint-at`, `settle` and `move-grain` never execute on
real data. Measured through the probe: 168 grains painted around row 4–8, still
168 after 40 frames, lowest occupied row 68. Grains fall, and none are lost.
Dropping the flags alone would only move the failure: the bodies that called
into raylib would still be emitted and `wasm-ld` would fail on the symbols
rather than on the argument list. So the same walk prunes **functions and
externs** from the program. Only those. Globals, structs and unions stay,
because an unreferenced global is bytes in BSS and a dropped one is a silently
different program.
**Three edits were made to sand.flan's own text**, and they are language
decisions rather than fixes:
**Dev builds are not pruned.** What a REPL may redefine next is not a function
of what has been called so far.
The filtering happens at the call sites — `bin/main.ml`, the tests — because
`Build.executable` receives `csrcs` and `lflags` from its caller and never sees
the import list. `Reach.link` returns the pruned program and its C and linker
arguments together, so a caller cannot take one without the other.
## sand.flan is one program
It was two files, and only ever for the reason above: the headless run is the
one CI does on native *and* wasm32, and a program that imported raylib linked
libraylib whatever its `main` did. So the simulation lived in `sand-sim/` and
both drivers imported it.
Now `sand.flan` holds the simulation *and* the raylib front-end, and
`test/programs/sand-headless.flan` imports `sand.flan` itself — window, raylib
bindings, dev agent and all — and still builds for wasm32. Nothing it calls
reaches raylib; `sand.flan`'s `main` is not exported, so the only `main` is the
headless one; and the hash is unchanged on both targets at `-O2` and `-O0`,
which is the point. A refactor that moved that number would have moved the
simulation.
What still justifies *two entry points* is smaller and stands on its own: **the
headless test needs no window and no input on any target.** `sand.flan` could
not be that test even natively — with no mouse the grid stays empty and
`settle` and `move-grain` never run on real data. Measured through the probe:
168 grains painted around row 4–8, still 168 after 40 frames, lowest occupied
row 68. Grains fall, and none are lost.
Two claims that got run together in an earlier note, for the record:
- *raylib does not work on wasm* — false. It works through emscripten. What is
true is that it does not work on the **wasi** path, which is what the
headless table targets, and which has no GL and no browser.
- *a game loop cannot be expressed on wasm* — false. The browser cannot be
blocked, so a web build drives the loop with `emscripten_set_main_loop`
instead of a `while`. That is a different `main`, not a different program.
**Three edits were made to sand.flan's own text** when it was ported, and they
are language decisions rather than fixes:
- `(defconst gravity 0.05)` → `(defconst gravity f32 0.05)`. An untyped float
constant is `f64`, `velocity` is `[f32]`, and there is no implicit widening.
- `(defvar current-color u32)` → `i32`. It is an index into `colors`, and
`(len colors)` is an `i32`.
- The file was split as above, so its body now says `sim/rows` and so on.
`(defn main [])` is unchanged — the short form, as plan.org says.
- `(defn main [])` is unchanged — the short form, as plan.org says.
Painting is on **hold left mouse button** rather than on space, since the mouse
bindings exist now. Space is still what cycles the colour, on release, which is
@ -503,7 +538,7 @@ enforces, and a later change could quietly drop it.
from the folding pass's value, because a global's initialiser has to be a
compile-time constant and only that pass knows this one is. Its range check
is therefore its own call to `in_range`; there is a regression test.
- A `let` binding takes no type annotation, which is why `sand-sim` names its
- A `let` binding takes no type annotation, which is why `sand.flan` names its
FNV constants instead of writing them inline.
- `(defn f [] f65 0.0)` still says *unknown name* rather than *did you mean
f64*: with a single body form the parser cannot tell a return type from the
@ -804,8 +839,8 @@ all the folding back; `Tast.global.gfolded` is what tells the two apart, because
nothing downstream of the checker could.
**A form typed into a file that is imported as a package is qualified the way
the import qualified it.** `settle` in `sand-sim/sim.flan` becomes `sim/settle`,
and its call to `move-grain` becomes `sim/move-grain` — through `Load`'s own
the import qualified it.** `poll` in `vendor/agent/agent.flan` becomes
`agent/poll`, and its call to `poll-raw` becomes `agent/poll-raw` — through `Load`'s own
`qualify_decl`, so the rule cannot drift from the one used at import time.
Without this the form spliced as a brand-new unrelated name: the evaluation
answered `ok`, and the running program went on calling the `sim/settle` it
@ -1596,7 +1631,7 @@ The tests assert on the reason, not just on the failure.
`calc-me` and `sand`, the executables `flan build` drops beside their sources,
are now in `.gitignore` — anchored (`/calc-me`, `/sand`) so the patterns cannot
also match `sand-sim/` or anything nested.
match anything nested.
`old-ocaml/` — the pre-rewrite menhir/ocamllex frontend, kept as reference and
excluded from the build by the root `dune` file. Its contents are also in git

10
bin/main.ml
View File

@ -141,9 +141,14 @@ let () =
with_errors path (fun () ->
let l = load path in
let p = Flan.Check.program l.decls in
(* The link follows the program, not the import list: a package nothing
reachable calls into contributes no C and no linker argument, and its
functions are not emitted either. That is what lets one file import
raylib and still be buildable for wasm32. *)
let p, csrcs, lflags = Flan.Reach.link ~dev l p in
ignore (Flan.Build.executable
~opts:{ Flan.Build.default with checks; dev; target }
~csrcs:l.csrcs ~lflags:l.lflags p ~out))
~csrcs ~lflags p ~out))
(* The daemon an editor talks to: one session, the program it belongs to
running beside it, and a socket. Unlike [flan reload] the session persists,
so a defvar added by one evaluation is part of what the next one is checked
@ -197,7 +202,8 @@ let () =
in
let l = load path in
let p = Flan.Check.program l.decls in
ignore (Flan.Build.executable ~csrcs:l.csrcs ~lflags:l.lflags p ~out:exe);
let p, csrcs, lflags = Flan.Reach.link l p in
ignore (Flan.Build.executable ~csrcs ~lflags p ~out:exe);
let code =
Sys.command (String.concat " " (List.map Filename.quote (exe :: args)))
in

357
lib/load.ml
View File

@ -15,9 +15,19 @@
downstream knows a package existed; the checker sees one flat list of
declarations with names that happen to contain a slash.
That is not a module system yet. There is no visibility, no cycle
detection, and a package cannot import another one — milestone 4 needs one
package, imported once, and the rest can wait for a use that exercises it.
A package may import a package. The qualification flattens to the *inner*
alias — raylib imported by a package that is itself imported is still
[rl/...] — because a directory reached along two routes has to arrive under
one set of names or the checker sees every declaration twice. Two importers
of one directory load it once, keyed by its real path; the same directory
under two different aliases is refused, and so is a cycle.
Visibility is one rule so far: [main] is not exported. A package carrying
one would collide with the importer's, and worse, would keep everything it
calls reachable (see [Reach]) — which for a raylib front-end is the whole
library, on the target that cannot link it. Package-private markers for
anything else are still missing, which is why [rl/get-color-raw] is
callable.
A package may also carry the C it binds to. Every [.c] file in the
directory is compiled into the build, and a file named [link] lists extra
@ -33,12 +43,18 @@ type t = {
(* Which alias each package's directory was imported under, and the names it
owns. A file on disk does not say what it is called from outside — the
*importer* chooses that — so this is the only place the answer exists, and
a REPL editing a package's source needs it to know that [settle] typed in
sand-sim/sim.flan means [sim/settle] to the running program. *)
a REPL editing a package's source needs it to know that [poll] typed in
vendor/agent/agent.flan means [agent/poll] to the running program. *)
pkgs : pkg list;
}
and pkg = { alias : string; dir : string; owns : string list }
(* [pcsrcs] and [plflags] are the package's own, kept per-package rather than
only in the aggregate above: whether they are handed to the build at all is
decided after checking, by whether anything reachable calls into the package
(see [Reach.link]). The aggregate fields remain what a dev build uses, where
"not called yet" is not "not called". *)
and pkg = { alias : string; dir : string; owns : string list;
pcsrcs : string list; plflags : string list }
let fail loc fmt = Printf.ksprintf (fun m -> raise (Loc.Error (loc, m))) fmt
@ -61,16 +77,27 @@ let rec find_collection dir name =
let parent = Filename.dirname dir in
if String.equal parent dir then None else find_collection parent name
(* A package is a directory, or a single [.flan] file named outright. The file
form is for the program that is also a library: sand.flan sits beside three
other loose .flan files, so naming its directory would import all four, and
moving it into one of its own would be arranging the tree around a
limitation. A file carries no [.c] and no [link] — those belong to a
directory, and a package that needs them has one. *)
let is_package_file path =
Filename.check_suffix path ".flan" && Sys.file_exists path
&& not (Sys.is_directory path)
let resolve_dir ~file loc path =
let here =
let d = Filename.dirname file in
if Filename.is_relative d then Filename.concat (Sys.getcwd ()) d else d
in
let ok d = (Sys.file_exists d && Sys.is_directory d) || is_package_file d in
match split_path path with
| None, rel ->
let d = Filename.concat here rel in
if Sys.file_exists d && Sys.is_directory d then d
else fail loc "no package directory at %s" d
if ok d then d else fail loc "no package at %s — wanted a directory or a \
.flan file" d
| Some collection, rel ->
(match find_collection here collection with
| None ->
@ -79,8 +106,7 @@ let resolve_dir ~file loc path =
there is none" collection collection here
| Some root ->
let d = Filename.concat root rel in
if Sys.file_exists d && Sys.is_directory d then d
else fail loc "the package %s is not at %s" path d)
if ok d then d else fail loc "the package %s is not at %s" path d)
let entries dir suffix =
Sys.readdir dir
@ -248,57 +274,290 @@ let qualify_decl owned alias (d : Ast.decl) : Ast.decl =
ret = Option.map (rename_texpr owned alias) fn.Ast.ret;
fbody = List.map (rename_expr owned alias bound) fn.Ast.fbody }
| Ast.Package _ -> Ast.Package alias
| Ast.Import _ ->
fail loc "an imported package may not import another one yet (milestone 4)"
(* A package's own imports were resolved before this ran and are not in
the list it is given, so one arriving here is a bug in [import] rather
than anything a user wrote. *)
| Ast.Import (a, _) ->
fail loc "internal: the import of %s was not resolved before qualifying" a
| Ast.Defunion (n, _) ->
fail loc "%s is a union, and an imported union is not implemented yet \
(milestone 4)" n
in
{ d with Ast.d = k }
(* ── Visibility ────────────────────────────────────────────────────── *)
(* The one rule so far: [main] is not a name a package offers.
There is a single top-level namespace and an import is a rename into it
(check.ml), so a package carrying a [main] would collide with the importer's
the moment anything imported it — a program could never be a package. And
the collision is the smaller half. [main] is a *root*: [Reach] starts there,
so an imported one keeps everything it calls alive. A raylib front-end
imported for its simulation would drag the whole library back in, on the
target that cannot link it, which is the thing the reachable-link change
exists to prevent.
So the package's [main] is dropped rather than qualified, and [alias/main]
is not a name. Everything else is still exported; package-private markers
are a separate gap (NEXT.md, Packages — [rl/get-color-raw] should not be
callable either). *)
let exported n = not (String.equal n "main")
(* Where a name is *used*, which is what a refusal has to point at. A rename
does not need this — it rebuilds the tree and the failure is a mismatch
later — but "you cannot see that name" has to name the line that tried.
Only top-level name positions are collected: a field, a keyword, an enum
member and a restart name are none of them, exactly as in the rename above.
Local bindings are not tracked, because the names this guards are ones no
local can be called: a [let] named [sim/main] does not parse. *)
let rec texpr_uses acc (t : Ast.texpr) =
match t.Ast.t with
| Ast.Tname n -> acc := (n, t.Ast.tloc) :: !acc
| Ast.Tslice e -> texpr_uses acc e
| Ast.Tarray (l, e) ->
(match l with Ast.Lname n -> acc := (n, t.Ast.tloc) :: !acc | Ast.Lint _ -> ());
texpr_uses acc e
| Ast.Tmap (k, v) -> texpr_uses acc k; texpr_uses acc v
| Ast.Tapp (_, args) -> List.iter (texpr_uses acc) args
| Ast.Tfn (ps, r) -> List.iter (texpr_uses acc) ps; texpr_uses acc r
let rec expr_uses acc (e : Ast.expr) =
let go = expr_uses acc in
let gos = List.iter go in
match e.Ast.e with
| Ast.Int _ | Ast.Float _ | Ast.Byte _ | Ast.Str _ | Ast.Kw _ | Ast.Quote _
| Ast.InvokeRestart _ -> ()
| Ast.Var n -> acc := (n, e.Ast.loc) :: !acc
| Ast.Do body -> gos body
| Ast.Let (bs, body) ->
List.iter
(fun (b : Ast.binding) ->
Option.iter (texpr_uses acc) b.Ast.bty; go b.Ast.bval)
bs;
gos body
| Ast.If (c, t, e') -> go c; go t; Option.iter go e'
| Ast.While (c, body) -> go c; gos body
| Ast.Return v -> Option.iter go v
| Ast.Set (p, v) -> place_uses acc e.Ast.loc p; go v
| Ast.Field (t, _) -> go t
| Ast.Call (h, args) -> go h; gos args
| Ast.Match (sc, arms) ->
go sc; List.iter (fun (a : Ast.arm) -> gos a.Ast.body) arms
| Ast.Struct (n, kvs) ->
acc := (n, e.Ast.loc) :: !acc;
List.iter (fun (_, v) -> go v) kvs
| Ast.Arr items -> gos items
| Ast.Fn (_, body) -> gos body
| Ast.Dotimes (_, n, body) -> go n; gos body
| Ast.Defer body -> gos body
| Ast.Unwrap (_, v) -> go v
| Ast.Signal (_, c) -> go c
| Ast.RestartCase (body, clauses) ->
go body;
List.iter (fun (c : Ast.rclause) -> gos c.Ast.rbody) clauses
| Ast.HandlerBind (clauses, body) ->
List.iter
(fun (c : Ast.hclause) -> texpr_uses acc c.Ast.hty; gos c.Ast.hbody)
clauses;
gos body
(* A place carries no location of its own, so it borrows the [set] form's. *)
and place_uses acc loc (p : Ast.place) =
match p with
| Ast.Pvar n -> acc := (n, loc) :: !acc
| Ast.Pfield (t, _) -> expr_uses acc t
| Ast.Pindex (t, idx) -> expr_uses acc t; List.iter (expr_uses acc) idx
| Ast.Pderef t -> expr_uses acc t
let decl_uses acc (d : Ast.decl) =
let field (f : Ast.field) = texpr_uses acc f.Ast.fty in
let fn (f : Ast.fn) =
List.iter field f.Ast.params;
Option.iter (texpr_uses acc) f.Ast.ret;
List.iter (expr_uses acc) f.Ast.fbody
in
match d.Ast.d with
| Ast.Package _ | Ast.Import _ | Ast.Defenum _ -> ()
| Ast.Defalias (_, t) -> texpr_uses acc t
| Ast.Defstruct (_, fs) -> List.iter field fs
| Ast.Defunion (_, vs) ->
List.iter (fun (v : Ast.variant) -> List.iter field v.Ast.vfields) vs
| Ast.Defn f -> fn f
| Ast.Declare (f, _) ->
List.iter field f.Ast.params;
Option.iter (texpr_uses acc) f.Ast.ret
| Ast.Defvar (_, t, init) ->
Option.iter (texpr_uses acc) t;
(match init with Ast.Init v -> expr_uses acc v | _ -> ())
| Ast.Defconst (_, t, v) ->
Option.iter (texpr_uses acc) t; expr_uses acc v
let uses (ds : Ast.decl list) =
let acc = ref [] in
List.iter (decl_uses acc) ds;
List.rev !acc
(* The refusal, by name and at the line that tried. [hidden] maps a name that
cannot be seen to the reason it cannot. *)
let refuse_hidden hidden ds =
if hidden <> [] then
List.iter
(fun (n, loc) ->
match List.assoc_opt n hidden with
| None -> ()
| Some why -> fail loc "%s" why)
(uses ds)
(* Every top-level name the package declares — types and values alike, since a
use site is rewritten by name and the two never collide in one namespace. *)
let owned_names (ds : Ast.decl list) =
List.filter_map Ast.declared_name ds
let import ~loc alias dir =
let files = entries dir ".flan" in
if files = [] then fail loc "the package at %s has no .flan file" dir;
let ds = List.concat_map (fun f -> Parse.program (Reader.read_file f)) files in
let owned = owned_names ds in
let decls = List.map (qualify_decl owned alias) ds in
let lflags =
let path = Filename.concat dir "link" in
if not (Sys.file_exists path) then []
else begin
let ch = open_in path in
let rec go acc =
match input_line ch with
| line ->
let line = String.trim line in
go (if line = "" || line.[0] = '#' then acc else line :: acc)
| exception End_of_file -> List.rev acc
in
let r = go [] in
close_in ch; r
end
in
{ decls; csrcs = entries dir ".c"; lflags;
pkgs = [ { alias; dir; owns = owned } ] }
(* The [link] file: extra linker arguments, one per line, blank lines and
comments ignored. *)
let link_flags dir =
let path = Filename.concat dir "link" in
if not (Sys.file_exists path) then []
else begin
let ch = open_in path in
let rec go acc =
match input_line ch with
| line ->
let line = String.trim line in
go (if line = "" || line.[0] = '#' then acc else line :: acc)
| exception End_of_file -> List.rev acc
in
let r = go [] in
close_in ch; r
end
let real dir = try Unix.realpath dir with Unix.Unix_error _ -> dir
(* One package, and whatever it imports.
A package may import a package. The qualification flattens to the *inner*
alias: if sand/ imports vendor:raylib as [rl], the names are [rl/...] in the
finished program and not [sand/rl/...]. That is forced rather than chosen —
a directory imported along two routes has to arrive with one set of names,
or the checker sees every declaration twice — and it is what makes the
dedupe below coherent.
[seen] is that dedupe, keyed by the real path, so raylib imported by the
program and again by a package it imports is loaded once. It is also what
terminates a cycle, and there is nothing else to do about one: a directory
is entered before it is read, so a package that imports itself — directly or
round a ring — meets its own entry and contributes nothing the second time.
The namespace is flat, so mutually dependent packages then simply work. *)
let rec import ~seen ~loc alias dir =
let dir' = real dir in
match Hashtbl.find_opt seen dir' with
| Some previous when String.equal previous alias ->
(* Already in, under the same name. Importing it again is a no-op, which
is what lets two packages both depend on a third. *)
{ decls = []; csrcs = []; lflags = []; pkgs = [] }
| Some previous ->
fail loc
"%s is imported as %s here and as %s elsewhere; one directory is one set \
of names, so the two cannot both be true" dir alias previous
| None ->
Hashtbl.replace seen dir' alias;
let one_file = is_package_file dir in
let files = if one_file then [ dir ] else entries dir ".flan" in
if files = [] then fail loc "the package at %s has no .flan file" dir;
let ds =
List.concat_map (fun f -> Parse.program (Reader.read_file f)) files
in
(* [main] is the importer's, always. A package that called its own would
get the importer's instead — silently, since the name still resolves —
so it is refused here rather than left to mean something else. *)
refuse_hidden
[ ("main",
Printf.sprintf
"the package %s calls main, and main belongs to the program that \
imports it, not to a package" dir) ]
ds;
(* What this package imports, resolved first and relative to itself. Its
declarations come back already qualified under their own aliases, so the
rename below leaves them alone: they are not in [owned]. *)
let nested =
List.filter_map
(fun (d : Ast.decl) ->
match d.Ast.d with
| Ast.Import (a, path) ->
(* Relative to the package itself: for a directory that is the
directory, for a single file the one it sits in. *)
let file = if one_file then dir else Filename.concat dir "." in
let sub = resolve_dir ~file d.Ast.dloc path in
Some (import ~seen ~loc:d.Ast.dloc a sub)
| _ -> None)
ds
in
let own =
List.filter (fun (d : Ast.decl) ->
match d.Ast.d with
| Ast.Import _ -> false
| _ -> (match Ast.declared_name d with
| Some n -> exported n
| None -> true))
ds
in
let owned = List.filter exported (owned_names ds) in
let decls = List.map (qualify_decl owned alias) own in
let lflags = if one_file then [] else link_flags dir in
let csrcs = if one_file then [] else entries dir ".c" in
let here =
{ decls; csrcs; lflags;
pkgs = [ { alias; dir; owns = owned; pcsrcs = csrcs; plflags = lflags } ] }
in
List.fold_left
(fun acc p ->
{ decls = acc.decls @ p.decls;
csrcs = acc.csrcs @ p.csrcs;
lflags = acc.lflags @ p.lflags;
pkgs = acc.pkgs @ p.pkgs })
here nested
(* What an import did *not* bring: the names an importer might reasonably write
and that are not there, each with the reason it is not. *)
let hidden_of (t : t) =
List.filter_map
(fun (p : pkg) ->
let ds =
List.concat_map (fun f -> Parse.program (Reader.read_file f))
(if is_package_file p.dir then [ p.dir ] else entries p.dir ".flan")
in
if List.exists (fun d -> Ast.declared_name d = Some "main") ds then
Some (qualify p.alias "main",
Printf.sprintf
"%s is not a name: %s declares a main, and a main is an entry \
point rather than something a package offers"
(qualify p.alias "main") p.dir)
else None)
t.pkgs
(* ── The one entry point ───────────────────────────────────────────── *)
let program ~file (decls : Ast.decl list) : t =
List.fold_left
(fun acc (d : Ast.decl) ->
match d.Ast.d with
| Ast.Import (alias, path) ->
let dir = resolve_dir ~file d.Ast.dloc path in
let p = import ~loc:d.Ast.dloc alias dir in
{ decls = acc.decls @ p.decls;
csrcs = acc.csrcs @ p.csrcs;
lflags = acc.lflags @ p.lflags;
pkgs = acc.pkgs @ p.pkgs }
| _ -> { acc with decls = acc.decls @ [ d ] })
{ decls = []; csrcs = []; lflags = []; pkgs = [] }
decls
let seen = Hashtbl.create 8 in
let t =
List.fold_left
(fun acc (d : Ast.decl) ->
match d.Ast.d with
| Ast.Import (alias, path) ->
let dir = resolve_dir ~file d.Ast.dloc path in
let p = import ~seen ~loc:d.Ast.dloc alias dir in
{ decls = acc.decls @ p.decls;
csrcs = acc.csrcs @ p.csrcs;
lflags = acc.lflags @ p.lflags;
pkgs = acc.pkgs @ p.pkgs }
| _ -> { acc with decls = acc.decls @ [ d ] })
{ decls = []; csrcs = []; lflags = []; pkgs = [] }
decls
in
(* Said here rather than left to the checker: [sim/main] would otherwise be
"unknown name", which is true and unhelpful — the name is missing on
purpose and the message should say which purpose. *)
refuse_hidden (hidden_of t) t.decls;
t

143
lib/reach.ml Normal file
View File

@ -0,0 +1,143 @@
(** What a program actually calls, and what that means for the link.
A package is imported as a whole — every declaration in the directory
becomes a declaration of the importing program — and until now the C it
binds to came with it unconditionally. So importing [vendor:raylib] linked
libraylib whatever [main] did, and on wasm32 that link cannot succeed. That
is the single fact that made sand's two halves two *files* rather than two
entry points, and it is what this module removes.
The answer is reachability, computed once on the checked program: start at
[main] and at every global initialiser, follow every call, and keep what is
reached. Two things fall out of the same walk:
- a package none of whose externs is reached contributes no [.c] file and
no linker argument, and
- the functions that would have referenced those externs are dropped from
the program, because removing [-lraylib] while still emitting a body that
calls [@InitWindow] only moves the failure from the linker's argument
list to its symbol table.
Only [fns] and [externs] are pruned. Globals, structs and unions stay:
a dropped function is a loud link error, a dropped global would be a
silently different program, and an unreferenced global is bytes in BSS that
cost nothing. A [defvar brush rl/Texture2D] in a headless build is exactly
that.
Dev builds are not pruned at all. A REPL redefines a function that the
running program has not called yet, so "not reached" there means "not
reached *so far*", which is not the same claim. *)
(* The edges. [Call] and [Global] are the obvious ones; [Handled] is the one
worth naming, because a handler-bind clause was lifted into a function of
its own and is reached by *address* from the body that wrote it, never by a
call. Miss it and a program with a handler loses the handler. *)
let rec expr_refs f (e : Tast.expr) =
let go = expr_refs f in
let gos = List.iter go in
match e.Tast.e with
| Tast.Int _ | Tast.Float _ | Tast.Bool _ | Tast.Str _ | Tast.Unit
| Tast.Zero _ | Tast.Uninit _ | Tast.Local _ | Tast.None_
| Tast.InvokeRestart _ -> ()
| Tast.Global n -> f n
| Tast.Prim (_, es) -> gos es
| Tast.Call (n, es) -> f n; gos es
| Tast.Do es -> gos es
| Tast.Let (bs, body) -> List.iter (fun (_, v) -> go v) bs; gos body
| Tast.If (c, t, e') -> go c; go t; go e'
| Tast.While (c, body) -> go c; gos body
| Tast.Return v -> Option.iter go v
| Tast.Set (p, v) -> place_refs f p; go v
| Tast.Field (t, _) -> go t
| Tast.Addr p -> place_refs f p
| Tast.Deref t -> go t
| Tast.Make (_, es) -> gos es
| Tast.Arr es -> gos es
| Tast.Some_ v -> go v
| Tast.Match (sc, arms) ->
go sc; List.iter (fun (a : Tast.arm) -> gos a.Tast.abody) arms
| Tast.UnwrapSome v -> go v
| Tast.Signal (_, _, c) -> go c
| Tast.Handled (frames, body) ->
List.iter (fun (h : Tast.hframe) -> f h.Tast.hfn) frames;
gos body
| Tast.RestartCase (cs, body) ->
List.iter (fun (c : Tast.rclause) -> gos c.Tast.rbody) cs;
go body
and place_refs f (p : Tast.place) =
match p with
| Tast.Plocal _ -> ()
| Tast.Pglobal n -> f n
| Tast.Pfield (t, _) -> expr_refs f t
| Tast.Pindex (t, idx) -> expr_refs f t; List.iter (expr_refs f) idx
| Tast.Pderef t -> expr_refs f t
(* Every name reachable from [main] and from the globals, which run before it.
A name that is neither a function nor an extern — a global, a struct — is
still recorded; it costs a hashtable entry and saves asking twice. *)
let reachable (p : Tast.program) =
let fns = Hashtbl.create 64 in
List.iter (fun (fn : Tast.fn) -> Hashtbl.replace fns fn.Tast.name fn) p.Tast.fns;
let seen = Hashtbl.create 128 in
let queue = Queue.create () in
let visit n =
if not (Hashtbl.mem seen n) then begin
Hashtbl.add seen n ();
Queue.add n queue
end
in
List.iter (fun (g : Tast.global) -> expr_refs visit g.Tast.ginit) p.Tast.globals;
visit "main";
while not (Queue.is_empty queue) do
let n = Queue.pop queue in
match Hashtbl.find_opt fns n with
| None -> ()
| Some fn ->
List.iter (expr_refs visit) fn.Tast.body;
List.iter (expr_refs visit) fn.Tast.fdefers
done;
seen
(* A lifted handler clause is reached from its parent and from nowhere else,
and the parent names it in a [Handled] frame — so it is already in [seen]
when the parent is. Nothing extra is needed for it here; [fparent] only
matters to the dev registry. *)
let prune (p : Tast.program) =
let seen = reachable p in
let kept n = Hashtbl.mem seen n in
{ p with
Tast.fns = List.filter (fun (f : Tast.fn) -> kept f.Tast.name) p.Tast.fns;
externs =
List.filter (fun (e : Tast.extern) -> kept e.Tast.ename) p.Tast.externs }
(* ── What the build is told ────────────────────────────────────────── *)
(* The link, decided by the program rather than by the import list. [dev] is
the opt-out: a dev build keeps everything, because what a REPL may call next
is not a function of what it has called so far.
Returns the program to emit and the C and linker arguments that go with it,
which is why it is one function and not three — the three answers have to
agree, and a caller that took the flags without the pruned program would
link nothing and still emit the calls. *)
let link ?(dev = false) (l : Load.t) (p : Tast.program) =
if dev then (p, l.Load.csrcs, l.Load.lflags)
else begin
let p = prune p in
let used (pkg : Load.pkg) =
(* An extern of the package survived the prune, so something reachable
calls into the C it binds to. A package of pure Flan has no externs
and no C either, so it answers false and contributes nothing, which
is the same as contributing what it has. *)
let prefix = pkg.Load.alias ^ "/" in
List.exists
(fun (e : Tast.extern) -> String.starts_with ~prefix e.Tast.ename)
p.Tast.externs
in
let pkgs = List.filter used l.Load.pkgs in
(p,
List.concat_map (fun (k : Load.pkg) -> k.Load.pcsrcs) pkgs,
List.concat_map (fun (k : Load.pkg) -> k.Load.plflags) pkgs)
end

18
lib/session.ml
View File

@ -67,8 +67,8 @@ let create ~file =
(* Which package a file being edited belongs to, if any.
A form typed into sand-sim/sim.flan declares [settle], but the running
program only ever knew it as [sim/settle]: the alias is chosen by whatever
A form typed into vendor/agent/agent.flan declares [poll], but the running
program only ever knew it as [agent/poll]: the alias is chosen by whatever
imported the directory, and is written nowhere in the file itself. Without
this the form splices as a brand-new unrelated name, the evaluation reports
success, and nothing changes — the exact failure this whole design is meant
@ -80,15 +80,21 @@ let package_of t origin =
match origin with
| "" -> None
| origin ->
let dir =
try Filename.dirname (Unix.realpath origin)
with Unix.Unix_error _ -> Filename.dirname origin
let here =
try Unix.realpath origin with Unix.Unix_error _ -> origin
in
let dir = Filename.dirname here in
(* A package is a directory, or a single .flan file named outright — so the
file being edited belongs to it if the package *is* that file, or if it
sits in the package's directory. Comparing only the directory would miss
the file case entirely and answer [None], which is the silent failure
above rather than a loud one: the form splices unqualified and the
running program keeps calling the name it already had. *)
let same p =
let d =
try Unix.realpath p.Load.dir with Unix.Unix_error _ -> p.Load.dir
in
String.equal d dir
String.equal d here || String.equal d dir
in
(match List.filter same t.pkgs with
| [] -> None

122
sand-sim/sim.flan
View File

@ -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))

177
sand.flan
View File

@ -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.

6
test/dune
View File

@ -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/*)

12
test/programs/pkg-hidden-main.flan Normal file
View File

@ -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)

15
test/programs/pkg-shared.flan Normal file
View File

@ -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)

11
test/programs/pkg-two-aliases.flan Normal file
View File

@ -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)

8
test/programs/pkg-two-mains.flan Normal file
View File

@ -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)

12
test/programs/pkg-unused.flan Normal file
View File

@ -0,0 +1,12 @@
;;;; A package imported and never called into.
;;;;
;;;; raylib is here, so before Reach.link this program linked libraylib — and
;;;; on wasm32 it could not be built at all. The link now follows what the
;;;; program reaches rather than what it imports, so main's one print is the
;;;; whole of it and the same file builds for both targets.
(import rl "vendor:raylib")
(defn main [] i32
(print-line "ok")
0)

24
test/programs/sand-headless.flan
View File

@ -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)

67
test/test_acceptance.ml
View File

@ -32,8 +32,12 @@ let compile ?(opt = "-O2") ?(checks = true) ?(dev = false) path =
brings back the package's C shim and linker arguments as well. *)
let l = Load.program ~file:path (Parse.program (Reader.read_file path)) in
let p = Check.program l.Load.decls in
(* [Reach.link] decides the link from the program: a package nothing
reachable calls into hands over no C and no linker argument, and its
functions are not emitted. *)
let p, csrcs, lflags = Reach.link ~dev l p in
ignore (Build.executable ~opts:{ Build.default with opt; checks; dev }
~csrcs:l.Load.csrcs ~lflags:l.Load.lflags p ~out:exe);
~csrcs ~lflags p ~out:exe);
exe
(* No Str, and the reader is hand-written for the same reason. *)
@ -437,6 +441,54 @@ let () =
print_endline "FAIL --no-bounds-checks: a check survived"
end;
(* ── Packages: the link follows the program ────────────────────────
A package's C and linker arguments used to come with the import,
whatever [main] did — which is what made sand's two halves two files
rather than one file with two entry points (NEXT.md, sand.flan is two
programs). [Reach.link] decides it from the checked program instead:
nothing reachable calls into raylib here, so no shim is compiled, no
-lraylib is passed, and no body that would reference a raylib symbol is
emitted. Natively that is invisible; the wasm32 case below is where it
is the difference between building and not. *)
outputs "an imported package nothing calls" "programs/pkg-unused.flan"
"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
is asserted is not that a wasm module exists — it is that it prints the
@ -463,10 +515,11 @@ let () =
let wasm_build ?(opt = "-O2") path out =
let l = Load.program ~file:path (Parse.program (Reader.read_file path)) in
let p = Check.program l.Load.decls in
let p, csrcs, lflags = Reach.link l p in
ignore
(Build.executable
~opts:{ Build.default with opt; target = Some "wasm32-wasi" }
~csrcs:l.Load.csrcs ~lflags:l.Load.lflags p ~out)
~csrcs ~lflags p ~out)
in
let wasm_run ?arg runner wasm =
let out = Filename.concat scratch "flan-acceptance-wasm.out" in
@ -540,7 +593,15 @@ let () =
also the file header's own claim, that the table runs on wasm32
too, honoured for the first time. *)
wasm_case "calc-me, wasm32" "../calc-me.flan"
~arg:"1 + 2 * (3 - 0.5) / 2" "3.5\n"));
~arg:"1 + 2 * (3 - 0.5) / 2" "3.5\n";
(* And the case the whole of Reach.link exists for: a program that
imports raylib, calls none of it, and builds for a target where
libraylib cannot be linked at all. Before, this was not a failing
test — it was a file nobody could write. *)
wasm_case "an imported package nothing calls, wasm32"
"programs/pkg-unused.flan" "ok\n";
wasm_case "an imported package nothing calls, wasm32, -O0"
~opt:"-O0" "programs/pkg-unused.flan" "ok\n"));
(* The EDN tokenizer, and the struct reader written by hand against it
(vendor/edn, test/programs/edn.flan). The expected output is a raw

17
test/test_agent.ml
View File

@ -77,15 +77,16 @@ let () =
(Build.executable ~opts:dev ~csrcs:l.Load.csrcs ~lflags:l.Load.lflags
t.Session.host ~out:exe);
(* And the same program without [--dev], which has to *link*. A package's C
sources are collected whatever [main] does, so the agent's C is in every
build that imports it, and it refers to the dev runtime — leaving that
out made this an undefined symbol at the link rather than a missing
flag. Nothing is run: with no cells the agent refuses every module, and
linking is the whole claim. *)
(* And the same program without [--dev], which has to *link*. Its [main]
calls [agent/start], so the package is reached and its C comes with it
even through [Reach.link] — and that C refers to the dev runtime, so
leaving it out made this an undefined symbol at the link rather than a
missing flag. Nothing is run: with no cells the agent refuses every
module, and linking is the whole claim. *)
(match
Build.executable ~opts:Build.default ~csrcs:l.Load.csrcs
~lflags:l.Load.lflags t.Session.host ~out:(tmp "prog-release")
let p, csrcs, lflags = Reach.link l t.Session.host in
Build.executable ~opts:Build.default ~csrcs ~lflags p
~out:(tmp "prog-release")
with
| _ -> ()
| exception Failure m -> fail "a release build of the agent: %s" m);

23
test/test_session.ml
View File

@ -159,14 +159,27 @@ 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);
(* A package that is a single file, which is what sand.flan is to the
headless driver. The file being edited *is* the package rather than a
member of a directory, so matching on the directory alone would answer
"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
| c ->
if c.Session.fns <> [ "sand/step" ] then
fail "a form from a single-file package reported %s, wanted sand/step"
(String.concat " " c.Session.fns)
| 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
| c ->