Joseph Ferano
ff2c949361
Flan's tagged sum has been spelled defunion since it landed, which was accurate right up until the language wanted C's untagged union as well. Both cannot be called the same thing, and the tagged one is the one with an alternative name that says what it is: a case, its fields, and a tag that steers which case is live is a data type, not a union. So the form is defdata everywhere -- the parser, the AST, the checker, both backends, the prelude's Form, the editor's font-locking and imenu, the docs and every .flan file in the tree. The internal vocabulary moves with it: Tast.union is Tast.data, uname is dname, the tables the checker and the emitter keep are datas. Leaving them would have inverted the words permanently, with surface defunion meaning one thing and env.unions meaning the other, which is exactly the kind of drift the comments in those files exist to prevent. What did not move is case, variant and vfields: a tagged sum still has cases, and it still has one live at a time. defunion is not kept as an alias. An alias would compile the day the untagged form lands and mean the opposite of what it used to -- the same silent misparse that made defn's return type mandatory, and worse, because the reader would have no reason to look. The old spelling is a named refusal instead, parse/defunion-renamed, which says what it is now called and that the name is reserved for something else. It fires on the head alone, so (defunion U [A B]) -- which would otherwise have parsed cleanly as one field A of type B -- is refused with the rest.
210 lines
9.9 KiB
OCaml
210 lines
9.9 KiB
OCaml
(** 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 data types 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
|
|
(* The other edge reached by address rather than by a call: a Map's hash and
|
|
equality pair. Same hazard as [Handled] below — miss it and a program with
|
|
a map loses the two functions its every lookup calls through. *)
|
|
| Tast.FnAddr (Tast.Flanfn n) -> f n
|
|
| Tast.FnAddr (Tast.Rtfn _) -> ()
|
|
(* A function value, and the *only* thing that keeps it linked. A name used
|
|
as a value is never a [Call], so without this edge the one function a
|
|
program passes to [map] is the one function the link drops. *)
|
|
| Tast.FnAddr (Tast.Fnval n) -> f n
|
|
| Tast.Prim (_, es) -> gos es
|
|
| Tast.Call (n, es) -> f n; gos es
|
|
(* No name to root: whatever this calls was reached as a value, and the
|
|
[FnAddr] that produced it is somewhere in the callee expression. *)
|
|
| Tast.CallPtr (callee, es) -> go callee; 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, latch) -> go c; gos body; gos latch
|
|
| Tast.Break _ | Tast.Continue _ -> ()
|
|
| 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) | Tast.MakeCase (_, _, es) -> gos es
|
|
| Tast.CaseField (t, _, _) -> go t
|
|
| 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
|
|
| Tast.WithAlloc (a, body) -> go a; gos 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
|
|
|
|
(* ── What a body names, as one number ──────────────────────────────── *)
|
|
|
|
(* The globals half of what the two ends of a break loop compare about a frame,
|
|
and the companion to [Emit.slot_fingerprint] rather than a replacement for
|
|
it. The slot fingerprint is the right cut for [locals]: if the slots are
|
|
identical then the names still describe the storage, whatever else the body
|
|
changed. It is the wrong cut for the globals section, because a redefined
|
|
body can name entirely different globals while binding identical locals —
|
|
and then the section shows the new body's reference set attributed to the
|
|
frame of the old one.
|
|
|
|
Two fingerprints and not one combined, because the two facts are separately
|
|
useful: a frame can have perfectly readable locals and untrustworthy global
|
|
attribution, and the user should be told which. One hash over both would
|
|
make [locals] refuse a frame nothing is wrong with.
|
|
|
|
**A set, sorted and deduplicated, not the order the walk found them in.**
|
|
Slot indices make the slot fingerprint order-sensitive on purpose; a
|
|
reference set is not ordered, and a body that mentions the same two globals
|
|
the other way round is the same body as far as this is concerned.
|
|
|
|
Computed from [expr_refs], which is the walk that already answers "what does
|
|
this body refer to" — the same one [Dev]'s globals section uses to build the
|
|
union, so the two cannot disagree about what counts as a reference. Which
|
|
names are globals is the caller's to say: the emitter knows the program's
|
|
globals, and so does the session. *)
|
|
let ref_fingerprint ~is_global (fn : Tast.fn) =
|
|
let seen = Hashtbl.create 16 in
|
|
let note n = if is_global n && not (Hashtbl.mem seen n) then Hashtbl.add seen n () in
|
|
List.iter (expr_refs note) fn.Tast.body;
|
|
List.iter (expr_refs note) fn.Tast.fdefers;
|
|
let names = List.sort compare (Hashtbl.fold (fun n () acc -> n :: acc) seen []) in
|
|
Hashtbl.hash (String.concat ";" names) land 0x3fffffff
|
|
|
|
(* 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
|
|
(* The generated wrappers go the same way as the packages: a wrapper whose
|
|
flattened declaration did not survive the prune is a C function calling
|
|
a library symbol nothing reachable wants, and emitting it would put an
|
|
undefined reference in a link that deliberately has no such library.
|
|
The preamble stays; an unused typedef costs nothing. *)
|
|
let live (name, _) =
|
|
name = ""
|
|
|| List.exists (fun (e : Tast.extern) -> e.Tast.esym = name)
|
|
p.Tast.externs
|
|
in
|
|
let p =
|
|
match List.filter live p.Tast.cshim with
|
|
(* Nothing left but the preamble: no wrapper survived, so there is no
|
|
translation unit to compile. *)
|
|
| [ ("", _) ] | [] -> { p with Tast.cshim = [] }
|
|
| parts -> { p with Tast.cshim = parts }
|
|
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
|