diff --git a/NEXT.md b/NEXT.md index da43f24..7c0c8fc 100644 --- a/NEXT.md +++ b/NEXT.md @@ -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 diff --git a/bin/main.ml b/bin/main.ml index 07cc208..b08660d 100644 --- a/bin/main.ml +++ b/bin/main.ml @@ -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 diff --git a/lib/load.ml b/lib/load.ml index 3fa5869..f4dc86c 100644 --- a/lib/load.ml +++ b/lib/load.ml @@ -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 diff --git a/lib/reach.ml b/lib/reach.ml new file mode 100644 index 0000000..f841776 --- /dev/null +++ b/lib/reach.ml @@ -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 diff --git a/lib/session.ml b/lib/session.ml index a4d2121..540bd39 100644 --- a/lib/session.ml +++ b/lib/session.ml @@ -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 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 6494283..9fbe3b8 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/pkg-unused.flan b/test/programs/pkg-unused.flan new file mode 100644 index 0000000..0d9d6c0 --- /dev/null +++ b/test/programs/pkg-unused.flan @@ -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) 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 c8ea758..ece3f84 100644 --- a/test/test_acceptance.ml +++ b/test/test_acceptance.ml @@ -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 diff --git a/test/test_agent.ml b/test/test_agent.ml index 3072a99..4f16c62 100644 --- a/test/test_agent.ml +++ b/test/test_agent.ml @@ -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); diff --git a/test/test_session.ml b/test/test_session.ml index 4e5521f..5a6ba7f 100644 --- a/test/test_session.ml +++ b/test/test_session.ml @@ -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 ->