From 0e889546647c8931688bed9f6ed0f402a389560e Mon Sep 17 00:00:00 2001 From: Joseph Ferano Date: Fri, 11 Sep 2026 20:02:21 +0700 Subject: [PATCH] The link follows the program, not the import list MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit A package handed over its .c files and its `link` arguments the moment it was imported, whatever the importing program did with it. That is what made sand's two halves two files: anything naming vendor:raylib linked libraylib on every target, and on wasm32 that link cannot succeed, so the headless run could not so much as mention the package the interactive one needs. Reach.link 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. 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. So the same walk prunes the functions and externs too. Only those — globals, structs and unions stay, because an unreferenced global is bytes in BSS and a dropped one is a silently different program. Dev builds keep everything. What a REPL may redefine next is not a function of what has been called so far. --- bin/main.ml | 10 ++- lib/load.ml | 13 +++- lib/reach.ml | 143 ++++++++++++++++++++++++++++++++++ test/programs/pkg-unused.flan | 12 +++ test/test_acceptance.ml | 33 +++++++- test/test_agent.ml | 17 ++-- 6 files changed, 212 insertions(+), 16 deletions(-) create mode 100644 lib/reach.ml create mode 100644 test/programs/pkg-unused.flan 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..fadf876 100644 --- a/lib/load.ml +++ b/lib/load.ml @@ -38,7 +38,13 @@ type t = { 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 @@ -283,8 +289,9 @@ let import ~loc alias dir = close_in ch; r end in - { decls; csrcs = entries dir ".c"; lflags; - pkgs = [ { alias; dir; owns = owned } ] } + let csrcs = entries dir ".c" in + { decls; csrcs; lflags; + pkgs = [ { alias; dir; owns = owned; pcsrcs = csrcs; plflags = lflags } ] } (* ── The one entry point ───────────────────────────────────────────── *) 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/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/test_acceptance.ml b/test/test_acceptance.ml index 300a7e7..770d561 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,20 @@ 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"; + (* ── 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 +481,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 +559,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")); if !failures = 0 then print_endline "acceptance: all tests passed" else begin 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);