From 2572f0a5371434349cda3434c3cfe0ee63100acb Mon Sep 17 00:00:00 2001 From: Joseph Ferano Date: Mon, 21 Sep 2026 12:54:13 +0700 Subject: [PATCH] An fn sees the locals it was written among, and Fn says so in its type spec-memory.md's case 2, capture by value into a stack environment, and the calling convention the author's rulings asked for. (Fn [i32] i32) captures; {code, env}; the common case (CFn [i32] i32) the bare address; one word; cannot capture A local of the enclosing function that an fn names is copied into a struct the checker synthesises, held in a slot of that function's frame, and the value carries its address; the lifted body reads the copies back into named slots of its own, once, at entry. So the name in the body means what the local held at the instant the value was made -- fn-capture.flan changes the local through a pointer after the value exists and the fn still answers with the old one. Two types rather than a uniform environment parameter: "while it's dyn first, static side should never have to pay the price for the existence of the dyn side... if you fully opt out, for instance, using --no-gc flag, then we should be operating under Odin/C semantics and never paying any runtime costs." The environment is declared by exactly the bodies an (Fn ...) value can reach -- a lifted literal in an Fn position, every handler clause, and the widening thunks -- and by nothing else. An ordinary defn emits the signature it always did; calc-me and fourteen corpus programs were diffed to say so. CFn, because the C carries information: a value with no environment is the only kind that could ever cross to C, and under the --no-conditions direction FIX.org records it becomes literally a C function pointer. It is not that today -- a declare cannot take a function type at all -- and crossable's refusal says so where a reader would otherwise be misled. Nobody needs CFn: Fn accepts everything, and the commonest reason to reach for the narrow one is that a *named* function handed to an Fn pays a hop through the widening thunk where a CFn is a direct call. That thunk is one small function per distinct signature widened, which reads the bare address back out of the environment and calls it. The cheaper trick -- the environment last, ignored by a body that never declared it -- is legal under SysV and is a trap under wasm32's call_indirect, which compares the signature at the call. Every indirect call is exactly typed now. A handler clause captures the same way and is sound with nothing left over: its frame is popped by the body that pushed it. What is refused there is a *store* into a captured name -- it is a copy, and writing to it would leave the local as it was. And the other half, which is what "non-escaping" means: a value carrying an environment may be called, passed down and let-bound, and may not be returned, stored, pointed at or pushed into a container. A parameter of type Fn is treated as one, which answers "passed to something that stores it" with no interprocedural analysis -- the store is refused inside the callee. Everything of type CFn is clean for free, which is the second thing having two types buys. Every refusal names case 3, the environment the collector owns. Two pre-existing bugs fell out on the way. A lifted fn asked for Fnval, so `flan reload' on any function containing an fn literal died at llc with an undefined cell; it takes Flanfn now, which is the choice a handler clause always made. And a redefinition module now carries its own hidden copy of every thunk it names, which is the same bug shape caught before it shipped. --- lib/ast.ml | 7 +- lib/check.ml | 801 ++++++++++++++++++++++++--- lib/cimport.ml | 4 +- lib/dev.ml | 2 +- lib/emit.ml | 229 ++++++-- lib/js.ml | 14 +- lib/load.ml | 7 +- lib/parse.ml | 11 +- lib/reach.ml | 7 +- lib/session.ml | 24 +- lib/tast.ml | 67 ++- lib/types.ml | 51 +- lib/x86.ml | 179 ++++-- runtime/flan_rt.c | 19 +- test/programs/fn-capture-dyn.flan | 13 + test/programs/fn-capture-set.flan | 10 + test/programs/fn-capture.flan | 121 +++- test/programs/fn-cfn-captures.flan | 10 + test/programs/fn-cfn-narrow.flan | 13 + test/programs/fn-cfn.flan | 67 +++ test/programs/fn-escape-copy.flan | 19 + test/programs/fn-escape-handled.flan | 12 + test/programs/fn-escape-param.flan | 11 + test/programs/fn-escape-return.flan | 10 + test/programs/fn-escape-store.flan | 7 + test/programs/fn-escape-vec.flan | 9 + test/programs/fn-extern.flan | 6 +- test/programs/fn-in-struct.flan | 11 + test/programs/fn-no-type.flan | 4 + test/programs/fn-values.flan | 12 +- test/reload_host.c | 5 +- test/test_acceptance.ml | 78 ++- test/test_flan.ml | 33 +- test/test_session.ml | 2 +- 34 files changed, 1654 insertions(+), 221 deletions(-) create mode 100644 test/programs/fn-capture-dyn.flan create mode 100644 test/programs/fn-capture-set.flan create mode 100644 test/programs/fn-cfn-captures.flan create mode 100644 test/programs/fn-cfn-narrow.flan create mode 100644 test/programs/fn-cfn.flan create mode 100644 test/programs/fn-escape-copy.flan create mode 100644 test/programs/fn-escape-handled.flan create mode 100644 test/programs/fn-escape-param.flan create mode 100644 test/programs/fn-escape-return.flan create mode 100644 test/programs/fn-escape-store.flan create mode 100644 test/programs/fn-escape-vec.flan diff --git a/lib/ast.ml b/lib/ast.ml index c9cab783..a24d2b78 100644 --- a/lib/ast.ml +++ b/lib/ast.ml @@ -18,7 +18,12 @@ and texpr_kind = | Tarray of len * texpr (* [4 f32] [rows [cols u32]] *) | Tmap of texpr * texpr (* (Map string i32) *) | Tapp of string * texpr list (* (Ptr Cursor) (Option f64) *) - | Tfn of texpr list * texpr (* (Fn [a a] bool) *) + (* (Fn [a a] bool) and (CFn [a a] bool). The flag is whether the value + carries an environment: true for [Fn], false for [CFn]. One case + rather than two because everything that walks a type expression treats + them identically — the difference is a fact about the value, and it is + [Check.resolve] that turns it into one. *) + | Tfn of bool * texpr list * texpr (* An array length is an integer or a compile-time constant's name. *) and len = diff --git a/lib/check.ml b/lib/check.ml index f523457b..83feaf4c 100644 --- a/lib/check.ml +++ b/lib/check.ml @@ -503,6 +503,34 @@ type ctx = { refusal below says why the enclosing function's locals are not there. Both are the same gap: capture does not exist. *) mutable outer_what : string option; + (* What this body has captured out of [outer], in the order it first named + each one: the source name, the *outer* binding the copy is taken from, + and the slot in this body's own frame the copy is read into. Empty + everywhere [outer] is, which is everywhere but a lifted body. + + The order is the environment's field order, so it is the order the copy + is made in and the order the body reads it back in. First-reference order + rather than declaration order because it is the only one this pass has: + the outer scope is a list and the names on it were not all written for + this body's sake. *) + mutable caught : (string * (binding * int)) list; + (* The context this body was lifted out of, so that capture can be + transitive: an [fn] inside an [fn] naming a local of the function both + were written in is captured by the middle one and then by the inner one + out of the middle one's copy. Without it the inner body would see only + what the middle body happened to have named already, which is a rule + about the text and not about the scope. + + It is safe to reach into while it is on the stack, and only then: a + lifted body is checked at the point it is written, so the parent is + paused exactly there and its scope is the snapshot [outer] holds. *) + parent : ctx option; + (* The slot the environment pointer arrives in, minted the first time + something is captured and [None] until then. Nameless, so the break loop + hides it the way it hides every other slot the compiler made: what a + reader wants to see is the copies, and those are under the names the + source gave them. *) + mutable envslot : int option; (* True wherever handler or restart frames established by this function are on the stack. A [return] from there would leave them pointing into a frame that has gone, so it is refused — the same rule as [defer] inside a @@ -582,26 +610,115 @@ let bind ctx ?what name bty ~assignable = let lookup ctx name = List.assoc_opt name ctx.scope -(* A handler clause is lifted into a function of its own, so the establishing - function's locals are simply not there. Capturing them is a closure with an - explicit environment — spec-memory.md's case 2, a non-escaping [fn] capturing - by value into a stack environment, since a handler frame does not outlive the - function that pushed it — and until that exists a reference to one is refused - for the reason it is really refused for, rather than as a name nobody has - heard of. *) -let captured ctx loc name = - match ctx.outer_what with - | Some what when List.mem_assoc name ctx.outer -> - let why = - if String.equal what "a handler" then - "Use a global, or pass it on the condition" - else - "Pass it in, or use a global" +(* Capture, spec-memory.md's case 2: a body lifted into a function of its own — + an [fn] literal or a handler clause — naming a local of the function it was + written in. + + The copy is taken where the value is made and not where it is read, so the + name in the body means what the local held at that instant and nothing + later can change it. What makes that safe is the extent: the copies live in + a slot of the *enclosing* frame, and a value holding their address may not + outlive it. [escapes] is the whole of what enforces that, and it is where + the escaping half — an environment the collector allocates — is named. + + Answers the binding the body should use, minting one on first reference: + a named slot of this body's own frame, which the prologue fills from the + environment. Not assignable, and that is not an omission — see [captured_set]. + + A dyn is refused, and for the reason a struct field of dyn already is (see + the [defstruct] arm): the collector's roots are frames, a captured copy + lives inside a struct the checker synthesised, and nothing pushes the + fields of one. A dyn in there would be a live value reachable only through + memory the marker never walks. Milestone 2's per-type descriptors lift it, + alongside the condition payload's and the struct field's. *) +let rec capture ctx loc name = + match List.assoc_opt name ctx.caught with + (* Already captured, and named again from a scope that no longer lists it — + a [let] inside the body restores what it displaced, and the copy's + binding goes with it. One field, not two: the environment is keyed by the + source name. *) + | Some (outer, slot) -> Some { slot; bty = outer.bty; assignable = false; bwhat = None } + | None -> + let from_parent () = + (* Not a local of the body directly around this one, so ask whether that + body can capture it in turn. The middle one takes a copy and this one + takes a copy of that — which is the same value, because every copy on + the way was taken at the moment its own value was made, and those + moments are nested. *) + match ctx.parent with + | Some p -> capture p loc name + | None -> None in - Loc.failk "check/capture" loc - "%s cannot see %s — it is a local of the enclosing function. %s" - what name why - | _ -> () + let outer = + match List.assoc_opt name ctx.outer with + | Some b -> Some b + | None -> if ctx.outer_what = None then None else from_parent () + in + match ctx.outer_what, outer with + | Some what, Some (outer : binding) -> + if outer.bty = Types.Dyn then + Loc.failk "check/capture-dyn" loc + "%s cannot capture %s: it is a dyn, and the collector finds its \ + roots by frame — a copy inside the environment %s is handed would \ + be a live value nothing walks. Pass it in as a parameter, or hold \ + it in a global" + what name what; + let slot = bind ctx name outer.bty ~assignable:false in + ctx.caught <- ctx.caught @ [ (name, (outer, slot)) ]; + Some { slot; bty = outer.bty; assignable = false; bwhat = None } + | _ -> None + +(* The one thing [capture] does not answer for. A captured name is a copy, so + a store into it would change this body's copy and leave the local it came + from as it was — which is a silent disagreement and not a feature. The + ordinary "not assignable" message would name the wrong reason, so this one + names the right one. + + [and] rather than a second [let] only so the two read together; neither + calls the other. *) +(* What [capture] would find, without capturing it. A guard that has to know + the *type* of an enclosing local before deciding what a form means — a + name in head position is a call through a value only if the value is a + function — must not take a copy on the way to answering. The binding it + answers with is only good for its type unless it came out of [caught]. *) +and peek_outer ctx name = + if ctx.outer_what = None then None + else + match List.assoc_opt name ctx.caught with + | Some ((b : binding), slot) -> Some { slot; bty = b.bty; assignable = false; bwhat = None } + | None -> + match List.assoc_opt name ctx.outer with + | Some b -> Some b + | None -> + match ctx.parent with Some p -> peek_outer p name | None -> None + +and outer_local ctx name = + ctx.outer_what <> None + && (List.mem_assoc name ctx.caught + || List.mem_assoc name ctx.outer + || (match ctx.parent with + | Some p -> outer_local p name + | None -> false)) + +and captured_set ctx loc name = + if outer_local ctx name then + match ctx.outer_what with + | Some what -> + Loc.failk "check/capture-set" loc + "%s cannot assign to %s: it is a copy of the enclosing function's \ + local, taken where the value was made, so a store here would change \ + the copy and leave %s as it was. %s" + what name name + (if String.equal what "a handler" then + "Accumulate into a global, or put the value on the condition — \ + capture is by value, which is what lets the copy be read at all" + else + "Return the new value, or keep it in a local of this fn") + | None -> () + +(* A binding this body captured, as opposed to one it declared. Used where the + difference matters and nowhere else. *) +let is_captured ctx name = List.mem_assoc name ctx.caught let scoped ctx f = let saved = ctx.scope in @@ -873,6 +990,13 @@ let map_type ?(preds = []) loc (k : Types.t) (v : Types.t) = (* The positions a function value may not be written in, and the one reason they are all the same position: something zeroes it. + Since capture arrived there is a second reason standing behind the first, + and it is the sharper one: every position on this list outlives the frame + a captured environment is on, so even a value nobody zeroed could not be + kept there. The message names the zero because that is the one that applies + to *every* function value and not only to a capturing one — and the escape + is what [escape_check] says, at the store rather than at the declaration. + ZII is the language's rule — an omitted struct field, a fixed array's elements, a [defonce] with no initialiser are all all-bytes-zero — and a zeroed function value is a null pointer with a signature on it, which is the @@ -883,9 +1007,21 @@ let map_type ?(preds = []) loc (k : Types.t) (v : Types.t) = A parameter, a return type, a [let] binding and an [(Option (Fn ...))] are not on the list: none of them is ever conjured, and an [Option]'s zero is a [None] whose tag nobody may look past. *) +(* The two function types as one question, for every place that wants the + signature and does not care which of them carries an environment: a call + site, a shadowing guard, a walk over the parameters. Where the difference + matters it is matched on directly, and there are few such places — the + representation is [Emit]'s business and the coercion is [expect]'s. *) +let fn_sig (t : Types.t) = + match t with + | Types.Fn (ps, r) | Types.CFn (ps, r) -> Some (ps, r) + | _ -> None + +let callable_ty t = fn_sig t <> None + let rec no_zeroed_fn loc what (t : Types.t) = match t with - | Types.Fn _ -> + | Types.Fn _ | Types.CFn _ -> fail loc "%s cannot be %s — it would be zeroed, and a zeroed function value is a \ null pointer. Pass it as a parameter, or hold it in a let" @@ -986,17 +1122,27 @@ let rec resolve env ?(seen = []) (t : Ast.texpr) : Types.t = | Ast.Tmap (k, v) -> map_type ~preds:env.tvpreds loc (resolve env ~seen k) (resolve env ~seen v) - (* (Fn [T ...] R): a function value, which is one code address and no - environment beside it. There is no capture — [check_fn] refuses a - reference to an enclosing local by name — so this is a pointer with a - signature and nothing about it can dangle. + (* (Fn [T ...] R) is a code address and the environment it is called with: + two words. A value made out of a name carries a null there; one made out + of an [fn] that captures carries the address of the copies on the frame + it was written in, and [escape_check] is what stops that address + outliving the frame. + + (CFn [T ...] R) is the address alone, one word, and nothing that can + capture — see [Types] for why the C is information rather than + decoration, and for why it is not yet a capability. Nobody needs it: + [Fn] accepts everything, and the commonest reason to reach for the + narrow one is that a *named* function handed to an [Fn] pays a hop + through the widening thunk where a [CFn] is a direct call. Where one may be *written* is narrower than where the type resolves, and the two rules live apart on purpose: this is what the spelling means, and [no_zeroed_fn] is where a position that would zero one is refused. A - parameter, a return type and a let binding are the positions that work. *) - | Ast.Tfn (ps, r) -> - Types.Fn (List.map (resolve env ~seen) ps, resolve env ~seen r) + parameter, a return type and a let binding are the positions that work, + for both. *) + | Ast.Tfn (env', ps, r) -> + let ps = List.map (resolve env ~seen) ps and r = resolve env ~seen r in + if env' then Types.Fn (ps, r) else Types.CFn (ps, r) | Ast.Tapp (name, args) -> (match name, args with | "Ptr", [ a ] -> Types.Ptr (resolve env ~seen a) @@ -1554,7 +1700,7 @@ let signature_tyvars (fn : Ast.fn) = and a variable cannot stand there: this spike is generic over types, not over type constructors. A [$t] inside the arguments is ordinary. *) | Ast.Tapp (_, args) -> List.iter ty args - | Ast.Tfn (ps, r) -> List.iter ty ps; ty r + | Ast.Tfn (_, ps, r) -> List.iter ty ps; ty r in List.iter (fun (p : Ast.field) -> ty p.Ast.fty) fn.Ast.params; (match fn.Ast.ret with Some r -> ty r | None -> ()); @@ -1595,6 +1741,8 @@ let rec subst_ty subst (t : Types.t) = | Types.Vec e -> Types.Vec (subst_ty subst e) | Types.Option e -> Types.Option (subst_ty subst e) | Types.Fn (ps, r) -> Types.Fn (List.map (subst_ty subst) ps, subst_ty subst r) + | Types.CFn (ps, r) -> + Types.CFn (List.map (subst_ty subst) ps, subst_ty subst r) | t -> t (* Does this resolved type still mention a variable? *) @@ -1604,7 +1752,8 @@ let rec generic_ty (t : Types.t) = | Types.Slice e | Types.Array (_, e) | Types.Ptr e | Types.Vec e | Types.Option e -> generic_ty e | Types.Map (k, v) -> generic_ty k || generic_ty v - | Types.Fn (ps, r) -> List.exists generic_ty ps || generic_ty r + | Types.Fn (ps, r) | Types.CFn (ps, r) -> + List.exists generic_ty ps || generic_ty r | _ -> false (* Does a type a call site bound a variable to reach a [dyn] anywhere? See the @@ -1617,7 +1766,8 @@ let rec reaches_dyn (t : Types.t) = | Types.Slice e | Types.Array (_, e) | Types.Ptr e | Types.Vec e | Types.Option e -> reaches_dyn e | Types.Map (k, v) -> reaches_dyn k || reaches_dyn v - | Types.Fn (ps, r) -> List.exists reaches_dyn ps || reaches_dyn r + | Types.Fn (ps, r) | Types.CFn (ps, r) -> + List.exists reaches_dyn ps || reaches_dyn r | _ -> false (* The refusal plan.org's Types section asks for, in one place so that every @@ -1662,6 +1812,9 @@ let rec mangle_ty (t : Types.t) = | Types.Fn (ps, r) -> Printf.sprintf "fn-%s-to-%s" (String.concat "-" (List.map mangle_ty ps)) (mangle_ty r) + | Types.CFn (ps, r) -> + Printf.sprintf "cfn-%s-to-%s" + (String.concat "-" (List.map mangle_ty ps)) (mangle_ty r) | t -> Types.to_string t (* ── The runaway instantiation, refused by name rather than by depth ──── @@ -1697,7 +1850,7 @@ let rec occurs_in ~needle (t : Types.t) = | Types.Slice e | Types.Array (_, e) | Types.Ptr e | Types.Vec e | Types.Option e -> occurs_in ~needle e | Types.Map (k, v) -> occurs_in ~needle k || occurs_in ~needle v - | Types.Fn (ps, r) -> + | Types.Fn (ps, r) | Types.CFn (ps, r) -> List.exists (occurs_in ~needle) ps || occurs_in ~needle r | _ -> false @@ -1766,6 +1919,69 @@ let mk loc ty e : Tast.expr = { Tast.e; ty; loc } let unit_at loc = mk loc Types.Unit Tast.Unit +(* The environment for a lifted body, built once its own body has been checked + and [caught] is therefore final. spec-memory.md's case 2, and the whole of + its machinery. + + It is a struct the checker synthesises — one field per captured name, in + first-reference order — and it is registered in the same table a + [defstruct] goes in, so both backends lay it out with the calculator they + already have and neither learns a new shape. Its name is the lifted + function's, which is unique and stable for the reason that name is: a + redefinition module emits the lifted functions belonging to the bodies it + replaces, and it emits their environments with them. + + Two ends, and the copy is at the near one: + + - in the *enclosing* frame, a slot holding the struct, filled with a [Make] + of the outer locals. That store is the copy, and it happens where the + value is made. A literal written inside a loop stores into the same slot + each time round, so each value is made from the locals as they were on + its own iteration. + - in the *lifted* frame, a slot holding the pointer, and a [Let] around the + whole body reading each field back into the named slot the body has been + checked against. Once, at entry, for the same reason a handler clause + binds its condition once: what the body names is the copy and not an + address, so nothing downstream has to know an environment exists. + + Both new slots are nameless, which is how the break loop is told to hide + them: a reader wants the captured copies, and those are the named slots the + body reads them into. Answers the prefixed body, the slot the pointer + arrives in, the enclosing frame's binding, and the address to put in the + value. *) +let close_over ~fname (octx : ctx) (fctx : ctx) loc = + match fctx.caught with + | [] -> (fun body -> body), None, None, None + | caught -> + let ename = "env/" ^ fname in + let fields = + List.map + (fun (n, ((b : binding), _)) -> { Tast.fname = n; fty = b.bty }) + caught + in + Hashtbl.replace fctx.env.structs ename { Tast.sname = ename; fields }; + let ety = Types.Named ename in + let eslot = fresh_slot fctx (Types.Ptr ety) in + let binds = + List.mapi + (fun i (_, ((b : binding), slot)) -> + let p = mk loc (Types.Ptr ety) (Tast.Local eslot) in + (slot, mk loc b.bty (Tast.Field (mk loc ety (Tast.Deref p), i)))) + caught + in + let prefix body = [ mk loc fctx.ret (Tast.Let (binds, body)) ] in + let mslot = fresh_slot octx ety in + let make = + mk loc ety + (Tast.Make (ename, + List.map + (fun (_, ((b : binding), _)) -> + mk loc b.bty (Tast.Local b.slot)) + caught)) + in + prefix, Some eslot, Some (mslot, make), + Some (mk loc (Types.Ptr ety) (Tast.Addr (Tast.Plocal mslot))) + (* A source location as a value, for a runtime trap that has to name the site rather than the runtime. The bounds and slice traps get theirs from [Emit], which renders the [Loc.t] it is already carrying; a trap reached through a @@ -2269,7 +2485,7 @@ let box loc (e : Tast.expr) : Tast.expr = caller that starts doing that gets a sentence instead of a silent mis-lowering. *) | Types.Named _ | Types.Enum _ | Types.Option _ | Types.Ptr _ - | Types.Alloc | Types.Fn _ | Types.Var _ -> + | Types.Alloc | Types.Fn _ | Types.CFn _ | Types.Var _ -> no_dyn_yet loc ~into:true e.Tast.ty "" let unbox loc (want : Types.t) (e : Tast.expr) : Tast.expr = @@ -2468,6 +2684,59 @@ let unbox_option ctx loc (t : Types.t) (got : Tast.expr) : Tast.expr = Written once and used by both refusals that can report one — [expect]'s, and the binary operators' when their two operands have no join. *) +(* ── The widening thunk ──────────────────────────────────────────────── + One per signature, and the whole of what a [CFn] costs on its way into + an [Fn]. Its parameters are the signature's, it declares the environment, + and its body calls through what it finds there — because that is where the + original bare address was put. + + Which is the move that makes the two conventions meet in exactly one + place. Every body reachable through an [Fn] value declares the trailing + environment, so every indirect call is exactly typed and nothing anywhere + relies on a callee ignoring an argument it never declared. That was the + first design's hinge and it does not survive wasm32: [call_indirect] + compares the signature at the call and a spare argument is a trap. + + Per *signature* and not per name, so a program pays one small function per + distinct shape it widens rather than one per function it widens. The name + is derived from the type, so two widenings of the same shape share it and + the memo below finds it — the same arrangement [struct_key_pair] uses for + a map's hash and equality pair, and for the same reason. + + [fparent] is []: not a name anyone wrote, so [defs] hides it, and a + marker the redefinition modules match on to carry a copy of their own. *) +let thick_thunk env loc ps r = + let name = "thick/" ^ mangle_ty (Types.CFn (ps, r)) in + if not (List.exists (fun (f : Tast.fn) -> f.Tast.name = name) env.lifted) + then begin + let n = List.length ps in + let fty = Types.CFn (ps, r) in + let args = List.mapi (fun i t -> mk loc t (Tast.Local i)) ps in + let callee = mk loc fty (Tast.Local n) in + env.lifted <- + { Tast.name; params = ps; + slots = Array.of_list (ps @ [ fty ]); + snames = Array.make (n + 1) None; + ret = r; body = [ mk loc r (Tast.CallPtr (callee, args)) ]; + fdefers = []; fenv = Some n; fparent = Some ""; floc = loc } + :: env.lifted + end; + name + +(* The slot a lifted body's environment arrives in, minted when the body did + not capture anything and so has none of its own. + + Every body that can be *reached* through an [Fn] value declares the + parameter, whether or not it reads it: a lifted [fn] literal in an [Fn] + position, and every handler clause, since [flan_signal] passes the frame's + environment to all of them. The alternative is a call whose signature is + one argument longer than the callee's, which SysV tolerates and wasm32 + does not. The slot is nameless, so the break loop hides it, and a body + that never reads it costs one store the optimiser drops. *) +let declare_env ctx = function + | Some _ as s -> s + | None -> Some (fresh_slot ctx (Types.Ptr Types.Unit)) + let numeric_note ~(want : Types.t) ~(got : Types.t) = if not (Types.is_numeric want && Types.is_numeric got) then "" else if Types.widens_to ~from:want ~into:got then @@ -2521,6 +2790,14 @@ let expect ctx loc ~want (got : Tast.expr) = honest — it admits only conversions that cannot change the number, so the cast this inserts is one no program can tell happened. *) | _ when Types.widens_to ~from:got.Tast.ty ~into:w -> widen loc w got + (* The other widening, and the only coercion between the two function + types. A bare address satisfies a signature that asks for an + environment. It goes this way only — an [Fn] has an environment and a + [CFn] has nowhere to put one — so the reverse falls through to the + ordinary refusal, which names both types and is the right sentence. *) + | Types.Fn (ps, r), Types.CFn (ps', r') + when Types.equal (Types.Fn (ps, r)) (Types.Fn (ps', r')) -> + mk loc w (Tast.Thicken (thick_thunk ctx.env loc ps r, got)) | _ -> got in if Types.fits ~expected:w ~actual:got.Tast.ty then got @@ -2598,7 +2875,7 @@ let hash_ty = Types.Int Types.U64 would share a slot counter. *) let invented_ctx env ret = { env; ret; slots = 0; slot_tys = []; slot_names = []; scope = []; - defers = []; defer_slot = None; outer = []; outer_what = None; in_frames = None; loops = []; tail = false; + defers = []; defer_slot = None; outer = []; outer_what = None; caught = []; envslot = None; parent = None; in_frames = None; loops = []; tail = false; in_defer = false; defer_ok = false; defer_block = "a nested form"; owner = "" } @@ -2711,7 +2988,7 @@ and struct_key_pair env loc n = let placeholder name ret params = { Tast.name; params; slots = Array.of_list params; snames = Array.make (List.length params) None; - ret; body = []; fdefers = []; fparent = None; floc = loc } + ret; body = []; fdefers = []; fenv = None; fparent = None; floc = loc } in env.lifted <- placeholder hname hash_ty hparams @@ -2794,7 +3071,7 @@ and struct_key_pair env loc n = { Tast.name; params; slots = Array.of_list (List.rev ctx.slot_tys); snames = Array.of_list (List.rev ctx.slot_names); - ret; body; fdefers = []; fparent = None; floc = loc } + ret; body; fdefers = []; fenv = None; fparent = None; floc = loc } in env.lifted <- finish hname hash_ty hparams hctx hbody @@ -3440,6 +3717,15 @@ and var ctx ?(qualified = false) loc ~want name = match lookup ctx name with | Some b -> expect ctx loc ~want (mk loc b.bty (Tast.Local b.slot)) + (* A local of the enclosing function, in a body that was lifted out of it: + captured by value, here, where it is first named. Asked *before* the + globals, because that is what the name means at the place it is + written — inside the enclosing function a local shadows a global of the + same name, and a body lifted out of it must not silently mean something + else. *) + | None when capture ctx loc name <> None -> + let b = Option.get (capture ctx loc name) in + expect ctx loc ~want (mk loc b.bty (Tast.Local b.slot)) | None -> match Hashtbl.find_opt ctx.env.globals name with | Some (ty, _) -> @@ -3482,8 +3768,9 @@ and var ctx ?(qualified = false) loc ~want name = "%s is a foreign function, and its address is not a Flan \ function value. Wrap it in a defn and pass that" name; expect ctx loc ~want - (mk loc (Types.Fn (params, ret)) (Tast.FnAddr (Tast.Fnval name))) - | None -> captured ctx loc name; unknown_name ctx loc name) + (mk loc (Types.CFn (params, ret)) + (Tast.FnAddr (Tast.Fnval name))) + | None -> unknown_name ctx loc name) (* What remains of spec-memory.md's ownership section after the repeals of 2026-09-18 is the allocator's side alone: the region rule decides where a @@ -3533,14 +3820,15 @@ and block ctx ?want ?(defer_ok = false) loc body = landed, and the surface feature is that machinery given a name rather than a second one invented beside it. - **No capture, and that is the scope of this milestone.** The body sees its - parameters and the program's globals and nothing else; a reference to a - local of the enclosing function is refused by name (see [captured]) rather - than resolved to something it did not mean. That is what makes the value a - bare code address with no environment behind it, which in turn is what makes - it safe to pass down, return, and store: there is nothing that can outlive - anything. spec-memory.md's capture cases, and escaping closures with them, - stay deferred. + **Capture is by value, and the value may not escape.** The body sees its + parameters, the program's globals, and the locals of the function it was + written in — those last copied into an environment on that function's + frame at the instant the value is made (see [capture] and [close_over]). + So the value is two words, the second of them an address into a frame, and + what keeps that address good is [escape_check]: it may be called, passed + down and let-bound, and may not be returned, stored or pushed anywhere. + spec-memory.md's case 3 — an environment the collector owns, and with it + the escaping closure — is a separate lane, and every refusal names it. **The parameter types come from the position.** [Ast.Fn] carries names and no types — that is the surface syntax, not an omission here — so an fn is @@ -3553,26 +3841,36 @@ and check_fn ctx ~want ?gen loc (params : string list) body = [(Fn ...)] want to say so, and the return is the annotated element type, or [None] to take the body's own. Everything else threads [want]. The caller has already checked the arity, in its own words. *) + (* Which of the two function types was asked for. [CFn] is a bare + address, so a literal written into one has nowhere to put an + environment — it is checked exactly as an [Fn] is and then refused *if + it turned out to capture*, which is a decision only the finished body + can make. Nothing else differs. *) + let bare = match want with Some (Types.CFn _) -> true | _ -> false in let pts, ret0 = match gen with | Some (pts, r) -> pts, r | None -> - match want with - | Some (Types.Fn (ps, r)) when List.length ps = List.length params -> + match Option.map fn_sig want with + | Some (Some (ps, r)) when List.length ps = List.length params -> ps, Some r - | Some (Types.Fn (ps, r)) -> + | Some (Some (ps, r)) -> fail loc "this fn has %d parameter%s and %s was wanted here" (List.length params) (if List.length params = 1 then "" else "s") - (Types.to_string (Types.Fn (ps, r))) - | Some other when other <> Types.Never -> - fail loc "expected %s, found an fn" (Types.to_string other) + (Types.to_string + (if bare then Types.CFn (ps, r) else Types.Fn (ps, r))) | _ -> - fail loc - "nothing here says what this fn's parameters are — an fn takes its \ - types from the position it is written in. Write it as an argument \ - whose parameter is a (Fn [T ...] R)" + match want with + | Some other when other <> Types.Never -> + fail loc "expected %s, found an fn" (Types.to_string other) + | _ -> + fail loc + "nothing here says what this fn's parameters are — an fn takes \ + its types from the position it is written in. Write it as an \ + argument whose parameter is a (Fn [T ...] R), or a \ + (CFn [T ...] R) when it captures nothing" in (* Its own frame and its own empty scope, with [outer] kept only so that a reference to the enclosing function's locals is refused for the reason it @@ -3582,7 +3880,8 @@ and check_fn ctx ~want ?gen loc (params : string list) body = is an expression, and no machinery is built for the form nobody writes. *) let fctx = { (invented_ctx ctx.env (Option.value ret0 ~default:Types.Unit)) with - outer = ctx.scope; outer_what = Some "an fn"; owner = ctx.owner } + outer = ctx.scope; outer_what = Some "an fn"; parent = Some ctx; + owner = ctx.owner } in List.iter2 (fun n t -> ignore (bind fctx n t ~assignable:false)) params pts; @@ -3635,25 +3934,73 @@ and check_fn ctx ~want ?gen loc (params : string list) body = in Printf.sprintf "fn/%s/%d" ctx.owner (List.length mine) in + (* And the environment, now that the body has named everything it is going + to. [close_over] allocates in both frames, so it runs after the body's + slots and before the lifted function is recorded. *) + let prefix, fenv, bind, addr = close_over ~fname ctx fctx loc in + (* A [CFn] is a bare address and has nowhere to keep an environment, so a + literal that captured cannot be one. Refused with the name of what it + captured, because that is the fact the writer has to act on — and with + the fix named, which is the wider type. *) + if bare && fctx.caught <> [] then begin + let names = List.map fst fctx.caught in + Loc.failk "check/cfn-captures" loc + "this fn captures %s, so it is a (Fn [%s] %s) and not a (CFn [%s] \ + %s): a CFn is the bare address, one word, with nowhere for the \ + copies to live. Widen the position to Fn, or pass %s in as a parameter" + (String.concat ", " names) + (String.concat " " (List.map Types.to_string pts)) (Types.to_string ret) + (String.concat " " (List.map Types.to_string pts)) (Types.to_string ret) + (match names with [ n ] -> n | _ -> "them") + end; + (* An [Fn]-position literal declares the environment whether or not it + captured: it is reached by a call that passes one. A [CFn]-position + one must not — it is reached by calls that pass none, and a parameter + nobody supplies is read off whatever the register held. *) + let fenv = if bare then fenv else declare_env fctx fenv in ctx.env.lifted <- { Tast.name = fname; params = pts; slots = Array.of_list (List.rev fctx.slot_tys); snames = Array.of_list (List.rev fctx.slot_names); - ret; body = fbody; fdefers = []; - fparent = Some ctx.owner; floc = loc } + ret; body = prefix fbody; fdefers = []; + fenv; fparent = Some ctx.owner; floc = loc } :: ctx.env.lifted; - expect ctx loc ~want - (mk loc (Types.Fn (pts, ret)) (Tast.FnAddr (Tast.Fnval fname))) + let fty = if bare then Types.CFn (pts, ret) else Types.Fn (pts, ret) in + (* [Flanfn] and not [Fnval], which is the handler clause's choice and is the + same choice for the same reason. [Fnval] exists so that a *name* taken as + a value in a dev build answers with the body that is current, which means + a load from that name's indirection cell. A lifted body has no name + anyone can type and no way to be redefined on its own: it is reached by + address from the body it was written in, and a redefinition of that body + carries its own copy. So the cell would never hold anything but this + symbol, and asking for one is how a redefinition module came to reference + a cell nothing declares. *) + let v = + match addr with + | None -> mk loc fty (Tast.FnAddr (Tast.Flanfn fname)) + | Some a -> + (* The value, and the store that fills its environment around it. What + stops the value leaving this frame is [escape_check], which reads the + finished body: a rule about where a value may *go* cannot be settled + at the point it is made. *) + let c = mk loc fty (Tast.Closure (Tast.Flanfn fname, a)) in + mk loc fty (Tast.Let ([ Option.get bind ], [ c ])) + in + expect ctx loc ~want v (* A handler runs where the *signal* was, not where it was established, so it cannot be a branch in the function that wrote it: it is lifted into a function of its own and reached through a pointer. - Which means it cannot see the establishing function's locals. Capturing them - is a closure with an explicit environment — the non-escaping kind, captured - by value onto this frame — and until that exists a reference to one is - rejected by name rather than silently resolving to something else. Globals and the condition itself are - in scope, which is enough for the accumulation case §1 is about. + It *can* see the establishing function's locals, by value: the same capture + an [fn] literal gets, and the one place it has no escaping case left over. + A handler frame is popped by the body that pushed it and nothing in the + language can name one, so the establishing frame is alive whenever the + clause runs and the copies on it are good. What is still refused is a store + into a captured name — the clause holds a copy, and writing to it would + leave the local as it was — so §1's accumulation case still accumulates + into a global, and now with whatever the establishing function knew + readable beside it. The body may not [return] either. The frames are pushed and popped around it, and an early exit would leave them on the stack pointing into a function @@ -3680,7 +4027,8 @@ and check_handler_bind ctx ?want ?(what = "handler-bind") loc clauses body = the enclosing one. *) let hctx = { (invented_ctx ctx.env Types.Unit) with - outer = ctx.scope; outer_what = Some "a handler" } + outer = ctx.scope; outer_what = Some "a handler"; + parent = Some ctx } in (* The condition crosses as a pointer, because the handler runs while the signalling frame is still alive and there is nothing to copy. @@ -3716,16 +4064,35 @@ and check_handler_bind ctx ?want ?(what = "handler-bind") loc clauses body = in Printf.sprintf "handler/%s/%d/%s" ctx.owner (List.length mine) name in + (* And the environment, the same machinery an [fn] literal's capture + uses and settled by the same argument — only with no escaping + case to leave over. A handler frame is popped by the body that + pushed it and nothing in the language can name one, so the clause + cannot be reached from anywhere the establishing frame is not + alive. There is nothing here that case 3 would change. *) + let prefix, fenv, bind, addr = + close_over ~fname ctx hctx c.Ast.hloc + in + (* Every clause declares the environment, captured or not: + [flan_signal] reads it off the frame and passes it to whichever + clause matched, and it cannot know which of them captured. *) + let fenv = declare_env hctx fenv in ctx.env.lifted <- { Tast.name = fname; params = [ Types.Ptr ty ]; slots = Array.of_list (List.rev hctx.slot_tys); snames = Array.of_list (List.rev hctx.slot_names); - ret = Types.Unit; body = hbody; fdefers = []; - fparent = Some ctx.owner; floc = c.Ast.hloc } + ret = Types.Unit; body = prefix hbody; fdefers = []; + fenv; fparent = Some ctx.owner; floc = c.Ast.hloc } :: ctx.env.lifted; - { Tast.htype = type_id name; hfn = fname }) + { Tast.htype = type_id name; hfn = fname; henv = addr }, bind) clauses in + (* The stores that fill the environments, one per clause that captured, + around the whole form: a handler frame carries the address and the frame + is pushed before the body runs, so the copies have to be made before + either. *) + let envbinds = List.filter_map snd frames in + let frames = List.map fst frames in (* The flag is set on [ctx] itself and restored, not on a copy: [ctx.slots] and [ctx.slot_tys] are mutable, so a copy would allocate the body's slots into a record the function never sees again and the indices would @@ -3765,7 +4132,11 @@ and check_handler_bind ctx ?want ?(what = "handler-bind") loc clauses body = go body) in ctx.in_frames <- saved; - expect ctx loc ~want (mk loc ty (Tast.Handled (frames, body))) + let h = mk loc ty (Tast.Handled (frames, body)) in + let h = + if envbinds = [] then h else mk loc ty (Tast.Let (envbinds, [ h ])) + in + expect ctx loc ~want h (* (restart-case BODY (name [] BODY-1) ...) — spec-conditions.md §3 and §6. @@ -5064,8 +5435,10 @@ and check_array_gen ctx ~want loc dims f = | _ -> check ctx f in let elem = - match f.Tast.ty with - | Types.Fn (ps, r) -> + (* Either function type: the generator is called and nothing here cares + whether an environment rides along. *) + match fn_sig f.Tast.ty with + | Some (ps, r) -> let got = List.length ps in if got <> rank then fail f.Tast.loc @@ -5081,12 +5454,12 @@ and check_array_gen ctx ~want loc dims f = (k + 1) (Types.to_string p)) ps; r - | other -> + | None -> fail f.Tast.loc "array-gen's second element is a function value, called once per \ element with one i32 index per dimension, and this is %s — for one \ value repeated, write array-fill" - (Types.to_string other) + (Types.to_string f.Tast.ty) in no_zeroed_fn loc "a fixed array's element" elem; let fs = fresh_slot ctx f.Tast.ty in @@ -5468,14 +5841,29 @@ and refuse_string_place loc (ty : Types.t) = and check_place ctx loc (p : Ast.place) : Tast.place * Types.t = match p with | Ast.Pvar name -> + (* Scope first, and the capture refusal only where scope did not settle + it. A body's *own* [let] may shadow a name the enclosing function also + has, and a store into that one is an ordinary store — asking about the + capture before looking would refuse it with a message about a copy that + is not the thing being written to. *) (match lookup ctx name with | Some b -> - if not b.assignable then + if not b.assignable then begin + (* Not assignable, so it is either a parameter or a captured copy. + Which one decides the message, and the copy's reason is its + own. *) + (match List.assoc_opt name ctx.caught with + | Some (_, slot) when slot = b.slot -> captured_set ctx loc name + | _ -> ()); fail loc "%s is a parameter, and a parameter is not assignable — bind a \ - local with let" name; + local with let" name + end; Tast.Plocal b.slot, b.bty | None -> + (* Not in scope here at all: a name of the enclosing function, which a + lifted body may read as a copy and may not write to. *) + captured_set ctx loc name; match Hashtbl.find_opt ctx.env.globals name with | Some (_, true) -> (* Four words, before: the name and the fact, and nothing about what @@ -5492,7 +5880,7 @@ and check_place ctx loc (p : Ast.place) : Tast.place * Types.t = "%s is a constant, and a constant is not assignable. Declare it \ with defonce if it has to change" name | Some (ty, false) -> Tast.Pglobal name, ty - | None -> captured ctx loc name; unknown_name ~setting:true ctx loc name) + | None -> unknown_name ~setting:true ctx loc name) | Ast.Pfield (target, name) -> let target, sname = struct_target ctx target in let s = Option.get (fields_named ctx.env sname) in @@ -5609,8 +5997,11 @@ and check_call ctx ~want loc (head : Ast.expr) (args : Ast.expr list) = above and by a name that resolved to a local or a parameter of function type, which is the shape every caller of [map] has. *) and call_value ctx ~want loc (callee : Tast.expr) args = - match callee.Tast.ty with - | Types.Fn (params, ret) -> + (* Either function type: calling one is calling the other, and the + difference — whether an environment rides along — is the backend's to + lower. Nothing here has to know which. *) + match fn_sig callee.Tast.ty with + | Some (params, ret) -> if List.length args <> List.length params then fail loc "this function value takes %d argument%s, given %d" (List.length params) @@ -5618,9 +6009,9 @@ and call_value ctx ~want loc (callee : Tast.expr) args = (List.length args); let args = map2_lr (fun p a -> check ctx ~want:p a) params args in expect ctx loc ~want (mk loc ret (Tast.CallPtr (callee, args))) - | other -> + | None -> fail loc "this is a %s and not a function, so it cannot be called" - (Types.to_string other) + (Types.to_string callee.Tast.ty) (* A builtin's arity. The count is the builtin's and can only be the builtin's: a defn of the same name written in the program now takes the @@ -6563,7 +6954,7 @@ and named_call ?(qualified = false) ctx ~want loc name args = | Types.Option _ -> "it carries a tag saying whether the value is there, and a \ filled one says yes over a payload nobody wrote" - | Types.Fn _ -> + | Types.Fn _ | Types.CFn _ -> "it is a code address, and a call through a filled one jumps \ into whatever 0xDE bytes happen to address" | Types.Named n when Hashtbl.mem ctx.env.datas n -> @@ -8311,16 +8702,26 @@ and ordinary_call ctx ~want loc name args = before the global function table: a binding shadows a defn of the same name (one namespace, ordinary lexical scoping). A local of any *other* type falls through to the table, so a program that shadows a function - name with an i32 and then calls the function still means the function. *) + name with an i32 and then calls the function still means the function. + + A local of the *enclosing* function holding one is the same case: a + lifted body captures it by value and then calls the copy. [peek_outer] + rather than [capture] in the guard, because a guard must not take a copy + on its way to deciding what a form means. *) | _ when (match lookup ctx name with - | Some b -> (match b.bty with Types.Fn _ -> true | _ -> false) - | None -> false) -> + | Some b -> callable_ty b.bty + | None -> + match peek_outer ctx name with + | Some b -> callable_ty b.bty + | None -> false) -> (* The binding the guard already found, read directly. Going back through - [check] would repeat the lookup and walk the capture path for a type - that is not capturable. *) + [check] would repeat the lookup. *) (match lookup ctx name with | Some b -> call_value ctx ~want loc (mk loc b.bty (Tast.Local b.slot)) args - | None -> assert false) + | None -> + match capture ctx loc name with + | Some b -> call_value ctx ~want loc (mk loc b.bty (Tast.Local b.slot)) args + | None -> assert false) | _ when Hashtbl.mem ctx.env.gsigs name -> let vars, params, ret = Hashtbl.find ctx.env.gsigs name in generic_call ctx ~want loc name vars params ret args @@ -8975,7 +9376,8 @@ and trial ctx f = resource failure into a wrong answer. *) let[@warning "+9"] { env = _; ret = _; slots; slot_tys; slot_names; scope; defers; defer_slot; defer_ok; defer_block; outer = _; - outer_what; in_frames; loops; tail; in_defer; + outer_what; caught; envslot; parent = _; + in_frames; loops; tail; in_defer; owner = _ } = ctx in match f () with | r -> Ok r @@ -8985,6 +9387,7 @@ and trial ctx f = ctx.defers <- defers; ctx.defer_slot <- defer_slot; ctx.defer_ok <- defer_ok; ctx.defer_block <- defer_block; ctx.outer_what <- outer_what; ctx.in_frames <- in_frames; + ctx.caught <- caught; ctx.envslot <- envslot; ctx.loops <- loops; ctx.tail <- tail; ctx.in_defer <- in_defer; Error d @@ -9720,6 +10123,25 @@ let collect env (decls : Ast.decl list) = "%s of %s is dyn, which does not cross to C — take the value \ at a written type and pass that" what fn.Ast.name + (* Its own arm too, because "pass (Ptr T)" is nonsense for a + function and the real objection is worth stating. A [CFn] is + one word and is the right *shape* for a C callback — that is + what it is for — but a Flan function's emitted signature still + ends with the transfer channel, and a C caller knows nothing + about one. So the address is not a C function pointer yet, and + what would make it one is dropping the channel from a signature + that cannot transfer (FIX.org, 2026-09-21). A [Fn] is two words + and is not even the right shape. *) + | Types.CFn _ | Types.Fn _ -> + fail loc + "%s of %s is %s, and a Flan function's address is not a C \ + function pointer yet — not even a CFn's. Its signature ends \ + with the transfer channel, and a C caller knows nothing \ + about one; the C in CFn is about having no environment, \ + which is what a C function pointer would need, and not about \ + crossing today. Write the callback in C, or give the binding \ + a (Ptr ()) and let the shim pass C's own" + what fn.Ast.name (Types.to_string t) | _ -> fail loc "%s of %s is %s, which cannot cross to C directly — pass \ @@ -10126,7 +10548,7 @@ let rec check_fn env (fn : Ast.fn) : Tast.fn = (match ctx.defer_slot with | None -> ctx.defers | Some s -> guarded_defers s ctx.defers); - fparent = None; floc = fn.Ast.nloc } + fenv = None; fparent = None; floc = fn.Ast.nloc } (* The generic body, checked once with its variables abstract. Nothing is kept — the [Tast.fn] it produces is thrown away, and so is anything it lifted — @@ -10420,7 +10842,7 @@ let lift_ginit ctx loc n ty (v : Tast.expr) = (match ctx.defer_slot with | None -> ctx.defers | Some s -> guarded_defers s ctx.defers); - fparent = Some n; floc = loc } + fenv = None; fparent = Some n; floc = loc } :: ctx.env.lifted; { Tast.e = Tast.Call (fname, []); ty; loc } @@ -11085,6 +11507,199 @@ let dyn_descriptors (p : Tast.program) = "What C hands back points at storage this compiler never rooted") p.Tast.externs; value_sites p (fun ~slot:_ loc what t -> check loc what t) +(* ── Escape, which is the other half of capture ──────────────────────── + spec-memory.md's case 2 is the *non-escaping* fn, and this is what makes + the word mean something. A captured copy lives in a slot of the frame the + literal was written in, so a value holding that frame's address may be + called, passed down and copied about as much as anyone likes — and must + never outlive the frame. Case 3, the escaping closure with an environment + the collector allocates, is a separate lane; every refusal here names it, + because "this cannot be done" and "this cannot be done yet" are different + sentences and the second one is the true one. + + Run over the typed IR rather than over the surface, and over every + function the program ends up with rather than only over the ones anyone + wrote. Two reasons, and both are about not having to be careful: the IR + has one node per way a value can be stored, so the list below is closed; + and a lifted body is checked by exactly the same pass as the body it came + out of, so an [fn] inside an [fn] needs no special case. + + **What is suspect.** A value of function type that may carry an + environment, decided by a rule that needs no interprocedural anything: + + - a capturing literal, which is a [Closure] node and is the only place one + is made; + - a *parameter* of function type, in every function, because nothing at a + definition can see what its callers will pass; + - a local bound to either of those, transitively; + - a branch or a block whose value is one. + + Everything else of function type is clean: the address of a name, and the + result of any call — the second follows from the first refusal below, which + is what stops a function from returning a suspect in the first place. + + **Why the parameter rule is the whole answer to the hard case.** An [fn] + that captures, passed to a function that stores it, is caught *inside that + function*: its parameter is suspect there, and the store is refused where + it is written. So no call can leak what its caller passed, and no caller + has to be analysed. What it costs is real and worth naming: [(defn id [f + (Fn [] i32)] (Fn [] i32) f)] is refused although it is harmless, and so is + holding a parameter of function type in a Vec that never leaves the frame. + Both become writable when case 3 lands, and neither is worth an analysis + before then. + + **Where a suspect may stand**: an argument of a call, the callee of one, a + [let] binding, and the field of an environment another literal captures it + into — that last is the [env/] exemption below, and it is sound for the + same reason everything here is: the outer literal is itself suspect, so + the pair of environments lives and dies with one frame. *) +let rec escaping suspects (e : Tast.expr) = + (* The value of a body is its last form, which is the only part of one that + can be this expression's own value. *) + let tail body = + match List.rev body with x :: _ -> escaping suspects x | [] -> false + in + match e.Tast.ty with + | Types.Fn _ -> + (match e.Tast.e with + | Tast.Closure _ -> true + | Tast.Local s -> List.mem s !suspects + | Tast.If (_, a, b) -> escaping suspects a || escaping suspects b + | Tast.Do body | Tast.Let (_, body) -> tail body + | Tast.Match (_, arms) -> List.exists (fun (a : Tast.arm) -> tail a.Tast.abody) arms + (* The forms that establish something around a body and yield the body's + value. Easy to forget and not safe to: each of them is an expression, + so each of them is a way for a suspect to be the answer. A + restart-case yields its body's value *or* a clause's, so every clause + is a tail too. *) + | Tast.Handled (_, body) | Tast.WithAlloc (_, body) -> tail body + | Tast.RestartCase (cs, body) -> + escaping suspects body + || List.exists (fun (c : Tast.rclause) -> tail c.Tast.rbody) cs + (* Read out of a struct, which for a function value means read out of an + *environment*: that is the one aggregate a capture may be written into + (see [is_env_struct]), and so the one this can be reading. A copy of a + captured function value carries whatever environment the original did, + so it is suspect exactly as the original was — without this, a lifted + body could hand back its copy of a captured value and the result would + arrive at the caller as an ordinary call result, which is to say as + clean. The same goes for a load through a pointer: nothing a + [(Ptr (Fn ...))] can point at is anywhere but a frame, since a global + and a struct field of function type are both refused. *) + | Tast.Field _ | Tast.CaseField _ | Tast.Deref _ -> true + (* The address of a name, and the result of a call. Neither can carry an + environment: the first never did, and the second cannot because a + function that would return one is refused below. *) + | _ -> false) + | _ -> false + +(* The environment struct a capture built, which is the one aggregate a + suspect may be written into. See the header. *) +let is_env_struct n = String.length n >= 4 && String.sub n 0 4 = "env/" + +let escape_check (fn : Tast.fn) = + let suspects = ref [] in + List.iteri + (fun i ty -> match ty with Types.Fn _ -> suspects := i :: !suspects | _ -> ()) + fn.Tast.params; + (* Two refusals, because the two cases know different amounts. A literal + written here captures, full stop, and the message can name the frame its + copies are on. A function value that arrived as a parameter *may* carry + an environment and nothing at a definition can tell — so it is refused + where it is written rather than at the calls that would have been fine, + and the message says that is what happened. *) + let owner = match fn.Tast.fparent with Some p -> p | None -> fn.Tast.name in + (* Which of the two this is, found by following the same tails [escaping] + followed. The refused expression is often a form that *yields* the + suspect — a handler-bind, a branch — and the message has to describe what + is actually escaping and not the shape it arrived in. *) + let rec written_here (e : Tast.expr) = + let tail body = + match List.rev body with x :: _ -> written_here x | [] -> true + in + match e.Tast.e with + | Tast.Closure _ -> true + | Tast.Local _ | Tast.Field _ | Tast.CaseField _ | Tast.Deref _ -> false + | Tast.If (_, a, b) -> written_here a && written_here b + | Tast.Do body | Tast.Let (_, body) | Tast.Handled (_, body) + | Tast.WithAlloc (_, body) -> tail body + | Tast.Match (_, arms) -> + List.for_all (fun (a : Tast.arm) -> tail a.Tast.abody) arms + | Tast.RestartCase (cs, body) -> + written_here body + && List.for_all (fun (c : Tast.rclause) -> tail c.Tast.rbody) cs + | _ -> true + in + let refuse (e : Tast.expr) where = + if not (written_here e) then + Loc.failk "check/fn-escapes" e.Tast.loc + "this function value may carry an environment, and %s would outlive \ + the frame that environment is on. A value reaching %s as a parameter \ + was made by a caller this definition cannot see, so it is refused \ + here rather than at the calls that would be safe. Call it, pass it \ + down, or hold it in a let — an fn whose environment the collector \ + owns is spec-memory.md's case 3 and is not built yet" + where owner + else + Loc.failk "check/fn-escapes" e.Tast.loc + (* No "hold it in a let" here, unlike the message above: an fn literal + takes its types from the position it is written in, so there is no + let binding to offer — see fn-no-type.flan. Every suggestion this + compiler prints has to compile. *) + "this fn captures, and %s would outlive the frame its copies are on. \ + The copies are slots of %s, taken where the value was made, so a \ + reader reached after that frame has gone would read whatever \ + replaced them. Call it, or pass it down — an fn whose environment \ + the collector owns is spec-memory.md's case 3 and is not built yet" + where owner + in + let deny where es = List.iter (fun e -> if escaping suspects e then refuse e where) es in + let go (e : Tast.expr) = + (match e.Tast.e with + | Tast.Let (bs, _) -> + (* A binding is where a suspect spreads, and the only place it does. *) + List.iter + (fun (slot, v) -> if escaping suspects v then suspects := slot :: !suspects) + bs + | Tast.Set (_, v) -> deny "a store" [ v ] + | Tast.Return (Some v) -> deny "a return" [ v ] + | Tast.Some_ v -> deny "an Option" [ v ] + | Tast.Arr es -> deny "a fixed array" es + | Tast.MakeCase (_, _, es) -> deny "a data type's field" es + | Tast.Make (n, es) -> if not (is_env_struct n) then deny "a struct field" es + | Tast.Addr (Tast.Plocal s) -> + if List.mem s !suspects then + refuse e "a pointer to it" + (* Everything the runtime takes: a push into a Vec, a put into a Map, a + box into a dyn. All of them put the value somewhere this frame does + not own — and all of them take it *by address*, because the container + runtime is type-erased, so the address is what has to be caught and + not the value beside it. *) + | Tast.Prim (Tast.Rt _, es) -> + deny "a container" es; + List.iter + (fun (a : Tast.expr) -> + match a.Tast.e with + | Tast.Prim (Tast.AddrOf, [ v ]) -> deny "a container" [ v ] + | _ -> ()) + es + | Tast.Prim (Tast.AddrOf, [ v ]) -> deny "a pointer to it" [ v ] + | Tast.InvokeRestart (_, _, es, _, _, _) -> deny "a restart's argument" es + | _ -> ()) + in + (* Outermost first, which is the order [Tast.walk] gives and the order a + [let] has to be seen in: a binding must be recorded before anything that + reads the slot. *) + List.iter (fun e -> Tast.walk go e) fn.Tast.body; + (* And the defers on the transfer path, which are the same forms again but + are not reachable from [body] — they hang off the function, and a store + written in one is a store. *) + List.iter (fun e -> Tast.walk go e) fn.Tast.fdefers; + (* And the tail, which is a return with nothing written. *) + (match List.rev fn.Tast.body with + | last :: _ when (match fn.Tast.ret with Types.Fn _ -> true | _ -> false) -> + deny "a return" [ last ] + | _ -> ()) let build_program ~keep_going (decls : Ast.decl list) : Tast.program * env = let env = new_env () in @@ -11169,6 +11784,10 @@ let build_program ~keep_going (decls : Ast.decl list) : Tast.program * env = they are reached *by name* from arbitrary call sites, so they carry no [fparent] and a dev build gives each its own cell. *) let fns = fns @ List.rev env.instances in + (* Where a captured copy may go, asked of every function the program ended + up with. Here rather than inside [check] because it is a question about a + finished body — see the header on [escaping]. *) + List.iter escape_check fns; (* And the order the computed initialisers run in, which needs the whole function list: what a global reads is transitive through what it calls. *) let globals = init_order globals fns in diff --git a/lib/cimport.ml b/lib/cimport.ml index 6a7f1da6..3c9b8f95 100644 --- a/lib/cimport.ml +++ b/lib/cimport.ml @@ -413,8 +413,8 @@ let rec ty_source (t : Ast.texpr) = | Ast.Tarray (Ast.Lname n, e) -> Printf.sprintf "[%s %s]" n (ty_source e) | Ast.Tmap (k, v) -> Printf.sprintf "(Map %s %s)" (ty_source k) (ty_source v) - | Ast.Tfn (ps, r) -> - Printf.sprintf "(Fn [%s] %s)" + | Ast.Tfn (env, ps, r) -> + Printf.sprintf "(%s [%s] %s)" (if env then "Fn" else "CFn") (String.concat " " (List.map ty_source ps)) (ty_source r) let tname n = ty (Ast.Tname n) diff --git a/lib/dev.ml b/lib/dev.ml index c2bfdc5d..05b2e603 100644 --- a/lib/dev.ml +++ b/lib/dev.ml @@ -2484,7 +2484,7 @@ let render_addr (s : Session.t) ~addr ~(ty : Types.t) let thunk : Tast.fn = { Tast.name; params = []; ret = Types.Unit; body = (nullary "flan/dev-begin" :: parts) @ [ nullary "flan/dev-end" ]; - fdefers = []; fparent = None; floc = loc; + fdefers = []; fenv = None; fparent = None; floc = loc; slots = Array.of_list (List.rev !extra); (* Every slot in here is the walk's own scratch: what is being shown is storage this thunk reaches by address. *) diff --git a/lib/emit.ml b/lib/emit.ml index 215cfb03..8181c726 100644 --- a/lib/emit.ml +++ b/lib/emit.ml @@ -85,6 +85,38 @@ let cellname n = "@" ^ quoted (Mangle.cell n) written only by the guards this file emits. *) let xfer_param = "%xfer" +(* The environment parameter, the other name that is not a Flan name: the + address of the captured copies a function value was made with. + + **It is declared by exactly the bodies that can be reached through a + [(Fn ...)] value**, and it is the *last* parameter, after the transfer + channel. That set is: a lifted [fn] literal written into an [Fn] position, + capturing or not; every handler clause, because [flan_signal] passes one + to whichever clause matched and cannot know which of them captured; and + the widening thunks ([Tast.Thicken]), which exist to read it. + + Nothing else declares it. An ordinary [defn] therefore emits exactly the + signature it always did — its parameters and then the channel, and not a + byte more — and a call to it by name is unchanged. That is the whole of + what keeps capture free for everyone who does not use it, and it is the + author's ruling: the static side does not pay for the dynamic side. + + So **every indirect call is exactly typed**. The two conventions meet in + one place, the thunk, and nowhere does a caller pass an argument the callee + did not declare. An earlier design did rely on that — the environment last, + ignored by a body that never asked for it, which SysV allows and Swift's + thin-vs-thick convention is built on — and wasm32 killed it: [call_indirect] + compares the signature at the call site, so a spare argument is a trap and + not a register nobody reads. Being exactly typed is checkable by a verifier + rather than argued from a calling convention, which is the better property + to have had all along. *) +let env_param = "%env" + +(* What a call through a [(Fn ...)] value passes when it has no environment — + a value made out of a name, or one widened from a [CFn]. Spelled once so + the sites cannot drift. *) +let no_env = "ptr null" + (* The condition's own name, for the message an unhandled [error] prints. The checker has already refused anything that is not a struct. *) let struct_name_of (t : Types.t) = @@ -130,10 +162,13 @@ module Rt = struct let ll_of = function Ptr -> "ptr" | I32 -> "i32" | I64 -> "i64" let size_of = function Ptr | I64 -> 8 | I32 -> 4 - (* A handler frame: the one it displaced, the condition type it matches, and - the lifted function that runs. *) + (* A handler frame: the one it displaced, the condition type it matches, the + lifted function that runs, and the environment that function is handed — + the establishing function's captured copies, or null when the clause + captured nothing. *) let handler = - { sname = "handler"; fields = [ "prev", Ptr; "type", I32; "fn", Ptr ] } + { sname = "handler"; + fields = [ "prev", Ptr; "type", I32; "fn", Ptr; "env", Ptr ] } (* A restart frame. The first four fields are what the runtime's own [flan_restart] declares and their offsets do not move; the rest are §3's @@ -246,11 +281,13 @@ let rec ll (t : Types.t) = (* An [Allocator] is a pointer to the runtime's [flan_allocator] and never a copy of one: see Types. Opaque here in the same sense [ptr] is. *) | Types.Alloc -> "ptr" - (* A function value is a code address and nothing else. There is no - environment beside it — capture does not exist (check.ml refuses it by - name) — so it is one pointer, the same width as any other, and a backend - needs to know no more about it than that. *) - | Types.Fn _ -> "ptr" + (* A code address and the environment it is called with: two words, always, + whether or not this particular value captured anything. See [%fnv]. *) + | Types.Fn _ -> "%fnv" + (* The bare address, and nothing beside it: one pointer, the width of any + other. A [CFn] cannot capture, so there is nothing an environment + would hold. *) + | Types.CFn _ -> "ptr" (* ptr + len + cap + allocator, and two more words the runtime owns: see flan_rt.c's (Vec T) header for why they are in every build. Nothing in this file reads a field of one — every operation is a runtime call taking @@ -454,7 +491,8 @@ let rec lay m (t : Types.t) : int * int = | Types.Enum _ -> 4, 4 | Types.Ptr _ -> 8, 8 | Types.Alloc -> 8, 8 - | Types.Fn _ -> 8, 8 + | Types.Fn _ -> 16, 8 + | Types.CFn _ -> 8, 8 | Types.Vec _ | Types.Map _ -> 40, 8 (* [n x T] adds no padding of its own: T's size already carries its tail. *) | Types.Array (n, e) -> let s, a = lay m e in Int64.to_int n * s, a @@ -813,13 +851,26 @@ let rec dty m d (t : Types.t) : int = ("len", Types.Int Types.I64); ("log2cap", Types.Int Types.I64); ("allocator", Types.Alloc); ("epoch", Types.Int Types.I64) ] |> fun n -> ignore k; ignore v; n - (* A pointer to code, and lldb is told exactly that and no more. DWARF - has DW_TAG_subroutine_type for the signature behind it, and spelling - one out here would buy a reader nothing they cannot get from the - function it points at — [p f] answers with an address either way, and - the address is what resolves to a symbol. The name carries the - signature, which is where it is actually legible. *) + (* Two words, and shown as two, the same rule the Vec and the Map above + follow: a debugger told a function value were one pointer would put + every offset after it out by eight. [code] is the address that + resolves to a symbol, which is what [p f] was ever worth; [env] is + the captured copies, and there is nothing here that could say what is + in them — the environment is a struct the checker synthesised for one + literal, and DWARF for it would describe a type the program cannot + name. A reader who wants the copies asks the break loop for the + locals, where they are under the names the source gave them. *) | Types.Fn _ -> + composite (Types.to_string t) + [ ("code", Types.Ptr Types.Unit); ("env", Types.Ptr Types.Unit) ] + (* And the bare one is what it always was: a pointer to code, and lldb + is told exactly that and no more. DWARF has DW_TAG_subroutine_type + for the signature behind it, and spelling one out would buy a reader + nothing they cannot get from the function it points at — [p f] + answers with an address either way, and the address is what resolves + to a symbol. The name carries the signature, which is where it is + actually legible. *) + | Types.CFn _ -> dnode d (Printf.sprintf "!DIDerivedType(tag: DW_TAG_pointer_type, name: \"%s\", \ @@ -1763,19 +1814,41 @@ and value_at f (e : Tast.expr) : string = | Tast.Local _ | Tast.Global _ | Tast.Field _ | Tast.Deref _ -> (* Everything that denotes a location is a load from its address. *) load f (addr f e) e.Tast.ty - (* The symbol itself, not a load from it: a function's address is a link-time - constant. The same spelling the handler frames use for a lifted clause. *) - | Tast.FnAddr (Tast.Flanfn n) -> fname n - | Tast.FnAddr (Tast.Rtfn n) -> "@" ^ n - (* A function value someone wrote, which is the one [FnAddr] that is not the - symbol. In a dev build it is the cell's contents, so that a value taken - after a redefinition is the new body — the same load a direct call to the - same name would do, at the point the *address* is taken rather than at the - call. What that does not give is a value taken before a redefinition and - called after it: that one is still the old body, because there is nothing - left to re-resolve once the address is in a slot. Named in docs/BUILT.md rather - than papered over with a trampoline. *) - | Tast.FnAddr (Tast.Fnval n) -> body_of f n + (* A [(Fn ...)] value, which is two words: a code address and the + environment it is called with. A value made out of a name captures + nothing, so the second word is null and [zeroinitializer] has already put + it there. See [%fnv]. + + Only a [Fn]-typed one. The same three [fnref] constructors are also asked + for as bare addresses — carrying [CFn], and carrying [Alloc] for the + map's hash and equality pair and a handler frame's clause, which are + fields of structs the runtime declares — and those stay one word. The + node's type is what says which is being asked for. *) + | (Tast.FnAddr _ | Tast.Closure _ | Tast.Thicken _) + when (match e.Tast.ty with Types.Fn _ -> true | _ -> false) -> + let code, env = + match e.Tast.e with + | Tast.FnAddr r -> fnaddr f r, "null" + | Tast.Closure (r, env) -> fnaddr f r, value f env + (* The widening: the thunk's code, with the bare address stored where + an environment would be. The thunk reads it back out and calls it, + which is what keeps every indirect call exactly typed. *) + | Tast.Thicken (n, p) -> fname n, value f p + | _ -> assert false + in + let a = fresh f in + ins f "%s = insertvalue %%fnv zeroinitializer, ptr %s, 0" a code; + if String.equal env "null" then a + else begin + let b = fresh f in + ins f "%s = insertvalue %%fnv %s, ptr %s, 1" b a env; + b + end + | Tast.FnAddr r -> fnaddr f r + | Tast.Closure _ | Tast.Thicken _ -> + (* Unreachable: both are [Fn] values and the arm above has already taken + every [Fn]-typed node. Here because nothing else could be meant. *) + failwith "a closure is a function value" | Tast.Addr p -> fst (place f p) | Tast.Prim (p, args) -> prim f e p args | Tast.Call (name, args) -> @@ -2192,14 +2265,57 @@ and call f ret flan args = the middle of an argument list). *) and call_ptr f ret callee args = let c = value f callee in + (* A [(Fn ...)] is two words and both are taken before the arguments are + evaluated: an argument may itself make a function value, and the two + halves of *this* one have to come out of the same value. A + [(CFn ...)] is the address alone, and the call that follows is the + call a name would have produced. *) + let code, env = + match callee.Tast.ty with + | Types.Fn _ -> + let code = fresh f in + ins f "%s = extractvalue %%fnv %s, 0" code c; + let env = fresh f in + ins f "%s = extractvalue %%fnv %s, 1" env c; + code, Some ("ptr " ^ env) + | _ -> c, None + in let vs = map_lr (fun (a : Tast.expr) -> let v = value f a in Printf.sprintf "%s %s" (ll a.Tast.ty) v) args in - call_through f ret c vs + call_through f ?env ret code vs -and call_through f ret callee vs = +(* The code address behind one of the three [fnref]s, which is the same string + whether it is wanted as a bare [Alloc] pointer or as the first word of a + function value. + + [Flanfn] and [Rtfn] are the symbol itself, not a load from it: a function's + address is a link-time constant. [Fnval] is the one that is not — in a dev + build it is the cell's contents, so that a value taken after a redefinition + is the new body, the same load a direct call to the same name would do, at + the point the *address* is taken rather than at the call. What that does + not give is a value taken before a redefinition and called after it: that + one is still the old body, because there is nothing left to re-resolve once + the address is in a slot. Named in docs/BUILT.md rather than papered over + with a trampoline. *) +and fnaddr f (r : Tast.fnref) = + match r with + | Tast.Flanfn n -> fname n + | Tast.Rtfn n -> "@" ^ n + | Tast.Fnval n -> body_of f n + +(* [env] is present on exactly one kind of call: one through a [(Fn ...)] + value, which cannot know whether the body it reaches declared one. Every + other call — by name, through a [(CFn ...)] — passes what it always + passed. See [env_param] for why appending it is safe when the callee did + not ask for it. *) +and call_through f ?env ret callee vs = let t = fresh f in - ins f "%s = call %s %s(%s)" t (ll ret) callee - (String.concat ", " (vs @ [ "ptr " ^ xfer_param ])); + let tail = + match env with + | None -> [ "ptr " ^ xfer_param ] + | Some e -> [ "ptr " ^ xfer_param; e ] + in + ins f "%s = call %s %s(%s)" t (ll ret) callee (String.concat ", " (vs @ tail)); guard f; (* An aggregate with a dyn in it is spilled into a rooted slot the instant it arrives, the same move a dyn word gets in [prim] and for a sharper reason: @@ -2293,6 +2409,16 @@ and emit_handled f frames body = stack finds what it pushed still valid, which is what "old code is never unloaded" means. See NEXT.md, conditions step 1. *) ins f "store ptr %s, ptr %s" (fname h.Tast.hfn) fp; + (* And the environment the clause is called with, which is a pointer + into this very frame. Written unconditionally — null when the + clause captured nothing — because a frame the runtime reads a + field of must have every field written, not only the ones this + clause happens to use. *) + let ep = fresh f in + ins f "%s = getelementptr inbounds %%handler, ptr %s, i32 0, i32 3" + ep slot; + ins f "store ptr %s, ptr %s" + (match h.Tast.henv with Some e -> value f e | None -> "null") ep; ins f "call void @flan_handler_push(ptr %s)" slot; slot) frames @@ -3136,6 +3262,14 @@ let signature ~named (fn : Tast.fn) = analysis is an optimisation, and in a dev build a cell can hold anything, so the honest answer to "what can this call?" is "anything". *) let params = params @ [ (if named then "ptr " ^ xfer_param else "ptr") ] in + (* And the environment, last, and only on a body that can be reached + through an [Fn] value: see [env_param]. Everything else emits the + signature it always did. *) + let params = + match fn.Tast.fenv with + | None -> params + | Some _ -> params @ [ (if named then "ptr " ^ env_param else "ptr") ] + in Printf.sprintf "%s %s(%s)" (ll fn.Tast.ret) (fname fn.Tast.name) (String.concat ", " params) @@ -3205,6 +3339,14 @@ let emit_fn m ?(hidden = false) ?(pnames = []) (fn : Tast.fn) = Buffer.add_string f.allocas (Printf.sprintf " store %s %%p%d, ptr %s\n" (ll ty) i f.slots.(i))) fn.Tast.params; + (* And the environment, on the one kind of function that has one. Every + other function is handed it too and never reads it; there is no slot for + it there and nothing to store. *) + (match fn.Tast.fenv with + | Some slot -> + Buffer.add_string f.allocas + (Printf.sprintf " store ptr %s, ptr %s\n" env_param f.slots.(slot)) + | None -> ()); (* The dyn roots, and this is not gated on [m.dev]: the shadow stack below is a debugging convenience and a release build does without it, while a collector that cannot find its roots is a collector that frees live @@ -3709,7 +3851,7 @@ let emit_startup m ?(hidden = false) (globals : Tast.global list) = List.iter (emit_global m ~hidden) flags; emit_fn m ~hidden { Tast.name = ".init-globals"; params = []; slots = [||]; snames = [||]; - ret = Types.Unit; body; fdefers = []; fparent = None; + ret = Types.Unit; body; fdefers = []; fenv = None; fparent = None; floc = (List.hd computed).Tast.ginit.Tast.loc }; true @@ -3758,6 +3900,13 @@ let header = {|; Generated by flan. The layout is C's: no object headers anywher ; so a Flan struct is exactly its C struct and nothing marshals. %slice = type { ptr, i64 } +; A function value: the code address, and the environment the captured copies +; live in. Two words rather than one because the environment has to travel +; *with* the value — a callee that takes a (Fn [T] R) and calls it knows +; nothing about where the value came from, so there is nowhere else to put it. +; A value that captures nothing carries a null there and every call passes it +; on regardless; see [env_param]. +%fnv = type { ptr, ptr } ; (Vec T), spec-memory.md. The element type is nowhere in it: the runtime is ; type-erased and every operation is handed size and align at its call site. %vec = type { ptr, i64, i64, ptr, i64 } @@ -3765,8 +3914,9 @@ let header = {|; Generated by flan. The layout is C's: no object headers anywher ; nor value type appears in it, for the same reason: one type-erased runtime, ; handed the two sizes and a hash/equality pair at each call site. %map = type { ptr, i64, i64, ptr, i64 } -; A handler frame: the one it displaced, the condition type it matches, and -; the lifted function that runs. Allocated on the establishing frame's stack. +; A handler frame: the one it displaced, the condition type it matches, the +; lifted function that runs, and the environment that function is handed. +; Allocated on the establishing frame's stack. |} ^ Rt.ll_type Rt.handler ^ {| ; A restart frame: the one it displaced and the name it offers. There is no ; target field, because the frame's own address *is* the target — which makes @@ -4521,11 +4671,18 @@ let redefinition ?(checks = true) ?(dev = false) ?(debug = false) (* A clause lifted out of one of these comes with it: its body may have changed too, and it is reached by address from inside the module rather than through a cell. Every other lifted clause is invisible here — it - needs no declaration, since nothing in this module names it. *) + needs no declaration, since nothing in this module names it. + + And the widening thunks, every one of them, whichever body they belong + to: a module that hands a name to an [Fn]-typed parameter names one, and + the host has no cell for it to be reached through. They are hidden and + tiny, so a copy per module is the whole cost — and the alternative is an + undefined symbol at dlopen, which is the shape of bug [Fnval] was. *) let lifted = List.filter (fun (f : Tast.fn) -> match f.Tast.fparent with + | Some "" -> true | Some p -> List.mem p fns | None -> false) p.Tast.fns diff --git a/lib/js.ml b/lib/js.ml index a5fdd744..489b8bdb 100644 --- a/lib/js.ml +++ b/lib/js.ml @@ -220,7 +220,8 @@ let rec refuse_ty loc (t : Types.t) = | Types.Never | Types.Named _ | Types.Enum _ -> () | Types.Slice t | Types.Array (_, t) | Types.Option t -> refuse_ty loc t | Types.Vec t -> refuse_ty loc t - | Types.Fn (ps, r) -> List.iter (refuse_ty loc) ps; refuse_ty loc r + | Types.Fn (ps, r) | Types.CFn (ps, r) -> + List.iter (refuse_ty loc) ps; refuse_ty loc r | Types.Ptr _ -> at loc "(Ptr T) is not in the JS dialect — JavaScript has no addresses, so a \ @@ -698,6 +699,17 @@ let rec value f (e : Tast.expr) : string = "the runtime entry point %s has no JS counterpart — it is C in \ flan_rt.c, and this dialect has no C" n + (* A capturing fn literal. A JS function closes over its enclosing scope for + free, so this dialect would not need the environment at all — but the + environment is a struct the checker synthesised and the captured copies + are read out of it by index, which is machinery this backend has nothing + to lower. Refused by name rather than emitted as a plain function that + would read the *current* value of a local instead of the copy. *) + | Tast.Closure _ | Tast.Thicken _ -> + at e.Tast.loc + "an fn that captures has no JS lowering yet — the environment is a \ + struct laid out for the two native backends, and this dialect has no \ + layout" | Tast.Prim (p, args) -> prim f e p args | Tast.Call (n, args) -> Printf.sprintf "%s(%s)" (fname n) (String.concat ", " (call_args f args)) diff --git a/lib/load.ml b/lib/load.ml index c1d3af8c..4636fd21 100644 --- a/lib/load.ml +++ b/lib/load.ml @@ -206,8 +206,9 @@ let rec rename_texpr owned alias (t : Ast.texpr) : Ast.texpr = Ast.Tmap (rename_texpr owned alias k, rename_texpr owned alias v) | Ast.Tapp (n, args) -> Ast.Tapp (n, List.map (rename_texpr owned alias) args) - | Ast.Tfn (ps, r) -> - Ast.Tfn (List.map (rename_texpr owned alias) ps, rename_texpr owned alias r) + | Ast.Tfn (env, ps, r) -> + Ast.Tfn (env, List.map (rename_texpr owned alias) ps, + rename_texpr owned alias r) in { t with Ast.t = k } @@ -746,7 +747,7 @@ let rec texpr_uses acc (t : Ast.texpr) = 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 + | 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 diff --git a/lib/parse.ml b/lib/parse.ml index 52fb2470..4181c0a0 100644 --- a/lib/parse.ml +++ b/lib/parse.ml @@ -96,11 +96,16 @@ let rec texpr (f : Form.t) : Ast.texpr = confused with. *) | Map _ -> fail f "a map type is written (Map K V), not in braces" - | List ({ v = Sym "Fn"; _ } :: rest) -> + (* The two function types. [Fn] is the one almost every signature wants — a + value that may carry an environment — and [CFn] is the bare address, + for a C callback or a table of them. Parsed together because they differ + in one word and the refusal should name both. *) + | List ({ v = Sym (("Fn" | "CFn") as which); _ } :: rest) -> + let env = String.equal which "Fn" in (match rest with | [ { v = Vec params; _ }; ret ] -> - mk (Ast.Tfn (List.map texpr params, texpr ret)) - | _ -> fail f "a function type is (Fn [T ...] R)") + mk (Ast.Tfn (env, List.map texpr params, texpr ret)) + | _ -> fail f "a function type is (%s [T ...] R)" which) | List ({ v = Sym name; _ } :: args) when args <> [] -> mk (Ast.Tapp (name, List.map texpr args)) | _ -> fail f "expected a type, found %s" (Form.to_string f) diff --git a/lib/reach.ml b/lib/reach.ml index f7803d46..a3000a3b 100644 --- a/lib/reach.ml +++ b/lib/reach.ml @@ -50,7 +50,12 @@ let expr_refs f (e : Tast.expr) = name used as a value is never a [Call], so without the second one the one function a program passes to [map] is the one function the link drops. [Rtfn] is C in flan_rt.c and is linked whatever happens. *) - | Tast.FnAddr (Tast.Flanfn n) | Tast.FnAddr (Tast.Fnval n) -> f n + | Tast.FnAddr (Tast.Flanfn n) | Tast.FnAddr (Tast.Fnval n) + | Tast.Closure (Tast.Flanfn n, _) | Tast.Closure (Tast.Fnval n, _) + (* And the widening thunk, which is reached by address from the value + it builds and from nowhere else. Without this edge the one function + a program widens is the one function the link drops. *) + | Tast.Thicken (n, _) -> f n | Tast.Set (Tast.Pglobal n, _) | Tast.Addr (Tast.Pglobal n) -> f n | Tast.Handled (frames, _) -> List.iter (fun (h : Tast.hframe) -> f h.Tast.hfn) frames diff --git a/lib/session.ml b/lib/session.ml index 77dcf351..73ecd749 100644 --- a/lib/session.ml +++ b/lib/session.ml @@ -373,6 +373,16 @@ let compatible ?(origin = fun _ -> None) ?(relaxed = []) ~loc new_.Tast.globals; List.iter (fun (s : Tast.structure) -> + (* An environment the checker synthesised for a capturing fn is not + subject to this rule, and that is not a loophole. The layout rule is + about values the running program is *holding*: every other struct can + be in a global, in a container, in a frame that is on the stack right + now. An environment can be in exactly one place — a slot of the frame + the literal was written in — and it is written there by the same + module that reads it, on every entry. So editing which locals an fn + names is an ordinary body change, and demanding a restart for it + would take the dev loop away from the feature it was built for. *) + if Check.is_env_struct s.Tast.sname then () else match List.find_opt (fun (r : Tast.structure) -> String.equal r.Tast.sname s.Tast.sname) @@ -992,7 +1002,7 @@ let eval ?(origin = "") ?pause t src : change = Some { Tast.name = Printf.sprintf "install/%d" t.thunks; params = []; ret = Types.Unit; body; - fdefers = []; fparent = None; floc = loc; + fdefers = []; fenv = None; fparent = None; floc = loc; slots = [||]; snames = [||] } in let ir = @@ -1319,7 +1329,7 @@ let render_locals ?(origin = "") t ~frame ~(fn : Tast.fn) ~bound let thunk : Tast.fn = { Tast.name; params = []; ret = Types.Unit; body = (nullary "flan/dev-begin" :: body) @ [ nullary "flan/dev-end" ]; - fdefers = []; fparent = None; floc = loc; + fdefers = []; fenv = None; fparent = None; floc = loc; slots = Array.of_list (List.rev !extra); (* Every slot in here is the walk's own scratch: the locals being shown are the *other* frame's, and this thunk reaches them by address. *) @@ -1408,7 +1418,7 @@ let render_condition t ~(st : Tast.structure) : change * (string * string) list let thunk : Tast.fn = { Tast.name; params = []; ret = Types.Unit; body = (nullary "flan/dev-begin" :: body) @ [ nullary "flan/dev-end" ]; - fdefers = []; fparent = None; floc = loc; + fdefers = []; fenv = None; fparent = None; floc = loc; slots = Array.of_list (List.rev !extra); snames = Array.make (List.length !extra) None } in @@ -1662,7 +1672,7 @@ let render_slot ?(origin = "") t ~frame ~(fn : Tast.fn) ~slot ~path { Tast.name = tname; params = []; ret = Types.Unit; body = (nullary "flan/dev-begin" :: parts) @ [ nullary "flan/dev-end" ]; - fdefers = []; fparent = None; floc = loc; + fdefers = []; fenv = None; fparent = None; floc = loc; slots = Array.of_list (List.rev !extra); snames = Array.make (List.length !extra) None } in @@ -1932,7 +1942,7 @@ let write_slot ?(origin = "") t ~frame ~(fn : Tast.fn) ~slot ~path stores @ (nullary "flan/dev-begin" :: parts) @ [ nullary "flan/dev-end" ]; - fdefers = []; fparent = None; floc = loc; + fdefers = []; fenv = None; fparent = None; floc = loc; slots = Array.append base (Array.of_list (List.rev !extra)); (* The stored expressions' own [let]s keep their names; the slots [render] added behind them are the walk's own @@ -2030,7 +2040,7 @@ let render_globals ?(origin = "") t ~(globals : Tast.global list) let thunk : Tast.fn = { Tast.name; params = []; ret = Types.Unit; body = (nullary "flan/dev-begin" :: body) @ [ nullary "flan/dev-end" ]; - fdefers = []; fparent = None; floc = loc; + fdefers = []; fenv = None; fparent = None; floc = loc; slots = Array.of_list (List.rev !extra); (* Every slot in here is the walk's own scratch: what is being shown is the program's storage, which this thunk reaches by name. *) @@ -2118,7 +2128,7 @@ let eval_expr ?(origin = "") ?(pause = false) t src : change = t.thunks <- t.thunks + 1; let name = Printf.sprintf "eval/%d" t.thunks in let thunk : Tast.fn = - { Tast.name; params = []; ret = Types.Unit; body; fdefers = []; fparent = None; floc = loc; + { Tast.name; params = []; ret = Types.Unit; body; fdefers = []; fenv = None; fparent = None; floc = loc; slots = Array.append base (Array.of_list (List.rev !extra)); (* The expression's own [let]s keep their names; the slots [render] added behind them are the walk's own scratch and have none to keep. *) diff --git a/lib/tast.ml b/lib/tast.ml index c2ff3feb..deec3a91 100644 --- a/lib/tast.ml +++ b/lib/tast.ml @@ -112,6 +112,42 @@ and expr_kind = dev build is not the symbol but whatever the indirection cell holds, and carries the Flan type [Fn]. *) | FnAddr of fnref + (* A function value with an environment: the lifted body, and the address of + the copies the enclosing frame is holding for it. The environment is a + [Make] of a struct the checker synthesised, stored into a slot of the + frame the literal was written in, so this node's second half is an + [Addr (Plocal _)] and the copies were taken where the value was made. + + Its own node rather than a field on [FnAddr] because the two answer + different questions: [FnAddr] is an address, and is asked for by three + unrelated readers that want a bare symbol ([Alloc]-typed, see [fnref]), + while this is a *value* of type [Fn] and can never be anything else. + + What stops it dangling is the checker, not this node: a value carrying an + environment may not leave the frame that owns it, so every position that + would outlive the frame is refused. spec-memory.md's case 2, and the + escaping half — an environment the collector allocates — is the case the + refusals name. *) + | Closure of fnref * expr + (* A (CFn ...) value where a (Fn ...) is wanted. The one coercion between + the two function types, and it goes this way only: there is nowhere for + an environment to go in the other direction. + + The pair it builds is {thunk, the address}: the *thunk's* code, one per + signature, with the original bare address stored where an environment + would be. The thunk reads it back out and calls it. So a value reached + through this is reached by a body that really does take an environment, + which is what keeps every indirect call exactly typed — including on + wasm32, where [call_indirect] checks the signature and an argument the + callee did not declare is a trap rather than a register nobody reads. + + The string is the thunk's name, minted and memoised by the checker: the + backends emit the pair and derive nothing. What it costs is one hop per + call, paid by a *name* handed to an [Fn]-typed parameter and by nothing + else — a literal, capturing or not, is compiled to take an environment + and needs no thunk. A signature that wants the address alone writes + [CFn] and pays nothing at all, which is what the type is for. *) + | Thicken of string * expr (* A call through a function value: the callee is an expression of type [Fn], not a name. Its own node rather than a [Call] with an expression in the name slot, because everything that walks this IR treats [Call]'s @@ -246,9 +282,16 @@ and place = | Pindex of expr * expr list | Pderef of expr -(* A pushed handler: which condition type it matches, and the lifted function - that runs when one is signalled. *) -and hframe = { htype : int; hfn : string } +(* A pushed handler: which condition type it matches, the lifted function that + runs when one is signalled, and the environment that function is handed. + + [henv] is the address of the establishing frame's copies of whatever the + clause captured, or [None] when it captured nothing. It is sound for the + same reason the frame itself is: a handler frame is popped by the body that + pushed it, so it can never be reached from outside the extent of the + function whose stack both it and the environment live on. There is no + escaping case here to defer. *) +and hframe = { htype : int; hfn : string; henv : expr option } (* A restart clause. [rname_id] is what [invoke-restart] matches by name; the body is a branch in the function that wrote it, because unlike a handler a @@ -307,6 +350,19 @@ type fn = { cell and no registry slot, and a redefinition of the parent carries its own copy. *) fparent : string option; + (* The slot the environment parameter is stored into, on a function that + was lifted out of something and captures one of its locals. Every + emitted signature takes the environment (see Emit's [env_param]) and + almost every function ignores it; this is the one that does not, and it + says where the pointer goes rather than fixing an index by convention, + because the slot is minted by [fresh_slot] like any other and a rule of + the form "the slot after the parameters" would be a second thing to keep + in step with the allocation order. + + [None] on everything anyone wrote. A capturing body reads its copies out + of this pointer once, at entry, into named slots of its own — so the + copy the value was made with is the copy the body sees. *) + fenv : int option; floc : Loc.t; } @@ -403,9 +459,10 @@ let rec walk (f : expr -> unit) (e : expr) = | Set (p, v) -> walk_place f p; go v | Addr p -> walk_place f p | Field (t, _) | Deref t | CaseField (t, _, _) | Some_ t | UnwrapSome t - | Signal (_, _, t) -> go t + | Signal (_, _, t) | Closure (_, t) | Thicken (_, t) -> go t | Match (sc, arms) -> go sc; List.iter (fun a -> gos a.abody) arms - | Handled (_, body) -> gos body + | Handled (hs, body) -> + List.iter (fun h -> Option.iter go h.henv) hs; gos body | RestartCase (cs, body) -> List.iter (fun c -> gos c.rbody) cs; go body | WithAlloc (a, body) -> go a; gos body diff --git a/lib/types.ml b/lib/types.ml index 20f026ba..2cc236e3 100644 --- a/lib/types.ml +++ b/lib/types.ml @@ -48,7 +48,50 @@ type t = at the call site, which is exactly where the two numbers are produced. *) | Vec of t | Option of t (* (Option T) *) + (* The two function types, and the difference between them is what a value + of each one *is* rather than what it may do. + + [(Fn [T ...] R)] is a code address and the environment it is called + with: two words. It is the common case and keeps the short name, because + it is what almost every higher-order signature wants — a caller may pass + it a name, a non-capturing literal, or one that captured half the frame, + and the callee neither knows nor cares. + + [(CFn [T ...] R)] is the bare address: one word, no environment, and + therefore nothing that can capture. + + **The [C] is information, not decoration.** A value with no environment + is the only kind that could ever cross to C, and under the + [--no-conditions] direction FIX.org records — where a signature that + cannot transfer drops the channel too — one becomes literally a C + function pointer. The name points at what the type *is* and at where it + is going. + + What it does **not** point at is a capability that exists now: a + [declare] cannot take a function type at all today, because a Flan + signature ends with the transfer channel and a C caller knows nothing + about one. Anyone reaching for [CFn] straight after writing a + [declare-c] is reaching too early, and [crossable] says so where they + will meet it. + + The whole of the reason there are two: a uniform environment would tax + every function in every program for a feature most of them never use, + and the static side is not to pay for the dynamic side's existence. With + two types an ordinary [defn] keeps exactly the signature it always had. + + **Nobody ever needs [CFn].** [Fn] accepts everything a [CFn] does, so + the narrow one is reached for on purpose, for one of four reasons: + handing a function to C (later, as above); a table of bare addresses; + forbidding capture at a boundary; and the one that is likeliest in + practice — a *named* function passed to an [Fn] parameter goes through + the widening thunk and pays an indirect hop per call, where a [CFn] + parameter is a direct call. [(map-in-place s double)] is the example. + + One-way: a [CFn] value satisfies an [Fn] (paired with a null + environment), and an [Fn] does not satisfy a [CFn] — there is nowhere + for the environment to go. *) | Fn of t list * t (* (Fn [T ...] R) *) + | CFn of t list * t (* (CFn [T ...] R) *) | Var of string (* a type variable — milestone 5 *) (* [dyn]: one machine word whose contents the runtime knows and this module does not. It is a written type — [(defonce x dyn 5)] boxes the 5 — and it @@ -142,7 +185,10 @@ let rec equal a b = | Alloc, Alloc -> true | Vec x, Vec y -> equal x y | Option x, Option y -> equal x y - | Fn (ps, r), Fn (ps', r') -> + (* The two are *not* equal to each other, in either direction. One-way + coercion lives in [Check.expect], where it can build the value the + wider type needs; here there is only identity. *) + | Fn (ps, r), Fn (ps', r') | CFn (ps, r), CFn (ps', r') -> List.length ps = List.length ps' && List.for_all2 equal ps ps' && equal r r' @@ -167,6 +213,9 @@ let rec to_string = function | Fn (ps, r) -> Printf.sprintf "(Fn [%s] %s)" (String.concat " " (List.map to_string ps)) (to_string r) + | CFn (ps, r) -> + Printf.sprintf "(CFn [%s] %s)" + (String.concat " " (List.map to_string ps)) (to_string r) | Var n -> n | Dyn -> "dyn" diff --git a/lib/x86.ml b/lib/x86.ml index 2bc86f38..2c4dc4c8 100644 --- a/lib/x86.ml +++ b/lib/x86.ml @@ -498,9 +498,15 @@ let alignof md t = snd (Emit.lay md t) than SysV's eight. *) let is_agg (t : Types.t) = match t with + (* A [(CFn ...)] is one word and crosses exactly as a pointer does, which + is the whole of its reason for existing. *) | Types.Int _ | Types.Float _ | Types.Bool | Types.Ptr _ | Types.Enum _ - | Types.Alloc | Types.Fn _ -> false + | Types.Alloc | Types.CFn _ -> false | Types.Unit | Types.Never -> false + (* A [(Fn ...)] is two words — the code address and the environment beside + it — so it crosses the way a slice does. [Emit.lay] is the one place that + says how wide it is and this agrees with it by asking. *) + | Types.Fn _ -> true | Types.String | Types.Slice _ | Types.Array _ | Types.Map _ | Types.Vec _ | Types.Option _ | Types.Named _ -> true (* A scalar, and trivially one: runtime/flan_dyn.h says [typedef uint64_t @@ -1189,6 +1195,27 @@ let load_sym f ~dst s = end else load_int f.b ~dst ~mm:(Sym (s, 0)) ~size:8 ~signed:false +(* The code address behind one of the three [fnref]s, which is the same + sequence whether it is wanted as a bare [Alloc] pointer or as the first + word of a function value. + + [Flanfn] and [Rtfn] are the symbol itself, not a load from it: a function's + address is a link-time constant, and [Flanfn] is the spelling a lifted + handler clause is reached by. [Fnval] is the one that is not — in a release + build there is nothing to redefine and it is the symbol after all; in a dev + build it is the cell's contents, so that a value taken after a redefinition + is the new body. What that does not give — and [emit.ml] names it rather + than papering over it with a trampoline — is a value taken *before* a + redefinition and called after it. Once the address is in a slot there is + nothing left to re-resolve. *) +let fnaddr f ~reg (r : Tast.fnref) = + match r with + | Tast.Flanfn n -> addr_sym f ~dst:reg (fsym n) + | Tast.Rtfn n -> addr_sym f ~dst:reg n + | Tast.Fnval n -> + if f.md.Emit.dev then load_sym f ~dst:reg (csym n) + else addr_sym f ~dst:reg (fsym n) + let scalar_size f (t : Types.t) = match t with Types.Bool -> 1 | _ -> max 1 (sizeof f.md t) @@ -1454,6 +1481,7 @@ let agg_tmp f (ty : Types.t) = let h_size = Emit.Rt.size Emit.Rt.handler let h_type = Emit.Rt.field Emit.Rt.handler "type" let h_fn = Emit.Rt.field Emit.Rt.handler "fn" +let h_env = Emit.Rt.field Emit.Rt.handler "env" let r_size = Emit.Rt.size Emit.Rt.restart let r_field = Emit.Rt.field Emit.Rt.restart @@ -1477,6 +1505,11 @@ type arg = | Aflt of loc * Types.t | Aptr of loc | Alen of loc + (* A null pointer, which is what a call site with no environment to pass + hands over — every Flan signature takes one. It is its own case rather + than a frame temporary holding zero because there is nothing to spill: + the register is zeroed where it is placed. *) + | Anull (* The C boundary, and the one place this backend must match SysV rather than pick. [check.ml] rejects an aggregate in a [declare] signature and the shim @@ -1525,6 +1558,7 @@ let emit_args f (args : arg list) = | Alen l -> load_int f.b ~dst:reg ~mm:(lmem f (shift l 8) ~scratch:r11) ~size:8 ~signed:true + | Anull -> xor_rr f.b ~dst:reg ~src:reg in (* The stack half first, because it uses rax as its courier and a register argument must not already be sitting in rax while that happens. *) @@ -1720,27 +1754,34 @@ and lower_at f (e : Tast.expr) (dst : loc) : unit = let l = place f p in addr_into f ~reg:rax l; store_int f.b ~src:rax ~mm:(lmem f dst ~scratch:r11) ~size:8 - (* The symbol itself, not a load from it: a function's address is a - link-time constant, and this is the spelling a lifted handler clause is - reached by. [emit.ml] says the same of [Flanfn]. *) - | Tast.FnAddr (Tast.Flanfn n) -> - addr_sym f ~dst:rax (fsym n); - store_int f.b ~src:rax ~mm:(lmem f dst ~scratch:r11) ~size:8 - (* A function value someone wrote, which is the one [FnAddr] that is not the - symbol. In a release build there is nothing to redefine and it is the - symbol after all; in a dev build it is the cell's contents, so that a - value taken after a redefinition is the new body. What that does not give - — and [emit.ml] names it rather than papering over it with a trampoline — - is a value taken *before* a redefinition and called after it. Once the - address is in a slot there is nothing left to re-resolve. *) - | Tast.FnAddr (Tast.Fnval n) -> - if f.md.Emit.dev then - load_sym f ~dst:rax (csym n) - else addr_sym f ~dst:rax (fsym n); - store_int f.b ~src:rax ~mm:(lmem f dst ~scratch:r11) ~size:8 - | Tast.FnAddr (Tast.Rtfn n) -> - addr_sym f ~dst:rax n; + (* A [(Fn ...)] value: the code address, then the environment beside it. + Two words — see [Emit]'s %fnv. Only a [Fn]-typed node; the same three + constructors are also asked for as bare addresses, carrying [CFn] or + [Alloc], and those stay one word. The node's type says which. *) + | (Tast.FnAddr _ | Tast.Closure _ | Tast.Thicken _) + when (match t with Types.Fn _ -> true | _ -> false) -> + let env = + match e.Tast.e with + | Tast.FnAddr r -> fnaddr f ~reg:rax r; None + | Tast.Closure (r, env) -> fnaddr f ~reg:rax r; Some env + (* The widening: the thunk's code, with the bare address stored where + an environment would be. The thunk reads it back out and calls it, + which is what keeps every indirect call exactly typed. *) + | Tast.Thicken (n, p) -> addr_sym f ~dst:rax (fsym n); Some p + | _ -> assert false + in + store_int f.b ~src:rax ~mm:(lmem f dst ~scratch:r11) ~size:8; + (match env with + | None -> xor_rr f.b ~dst:rax ~src:rax + | Some ev -> let l = eval f ev in load_loc f ~reg:rax l (Types.Ptr Types.Unit)); + store_int f.b ~src:rax ~mm:(lmem f (shift dst 8) ~scratch:r11) ~size:8 + | Tast.FnAddr r -> + fnaddr f ~reg:rax r; store_int f.b ~src:rax ~mm:(lmem f dst ~scratch:r11) ~size:8 + | Tast.Closure _ | Tast.Thicken _ -> + (* Unreachable: the arm above has taken every [Fn]-typed node, and both of + these are function values and can be nothing else. *) + unsupported "a closure that is not a function value" | Tast.Prim (p, args) -> prim f e p args dst | Tast.Call (name, args) -> (match Hashtbl.find_opt f.externs name with @@ -1752,8 +1793,17 @@ and lower_at f (e : Tast.expr) (dst : loc) : unit = ~target:(if f.md.Emit.dev then `Cell (csym name) else `Sym (fsym name)) ~args ~rty:t dst) | Tast.CallPtr (callee, args) -> + (* Through a [(Fn ...)]: both words out of one value, the code address as + the call target and the environment beside it as the extra argument. + Through a [(CFn ...)]: the address alone, and the call that follows + is the call a name would have produced. *) let c = eval f callee in - call_flan f ~target:(`Loc c) ~args ~rty:t dst + let env = + match callee.Tast.ty with + | Types.Fn _ -> Some (Aint (shift c 8, Types.Ptr Types.Unit)) + | _ -> None + in + call_flan f ?env ~target:(`Loc c) ~args ~rty:t dst | Tast.Do body -> block f body dst t | Tast.Let (bs, body) -> List.iter @@ -1953,6 +2003,16 @@ and emit_handled f frames body dst t = name it and it lives only for this body. *) addr_sym f ~dst:rax (fsym h.Tast.hfn); store_int f.b ~src:rax ~mm:(Frame (slot + h_fn)) ~size:8; + (* And the environment the clause is called with, a pointer into this + very frame. Written unconditionally — null when the clause + captured nothing — because the runtime reads the field either + way. *) + (match h.Tast.henv with + | Some ev -> + let l = scoped f (fun () -> eval f ev) in + load_loc f ~reg:rax l (Types.Ptr Types.Unit) + | None -> xor_rr f.b ~dst:rax ~src:rax); + store_int f.b ~src:rax ~mm:(Frame (slot + h_env)) ~size:8; lea f.b ~dst:rdi ~mm:(Frame slot); xor_rr f.b ~dst:rax ~src:rax; call_sym f.b "flan_handler_push"; @@ -2812,7 +2872,7 @@ and ret_loc f = if is_agg f.fret then Lp (f.sret_off, 0) else Lf f.retval integer or SSE sequence, every aggregate by pointer, a hidden [sret] in the first integer register when the result is an aggregate, and the transfer channel last of all. *) -and call_flan f ~target ~args ~rty dst = +and call_flan f ?env ~target ~args ~rty dst = let vals = List.map (fun (a : Tast.expr) -> eval f a, a.Tast.ty) args in let callee = match target with @@ -2832,7 +2892,13 @@ and call_flan f ~target ~args ~rty dst = (* The channel is this frame's own: a callee that transfers writes through the pointer we were handed, so one cell serves the whole chain. *) let chan = [ Aint (Lf f.xfer_off, Types.Ptr Types.Unit) ] in - ignore (emit_args f (head @ body @ chan)); + (* And the environment last of all, on exactly one kind of call: one through + a [(Fn ...)] value, which cannot know whether the body it reaches + declared one. Every other call passes what it always passed — this is + where an ordinary [defn] keeps costing nothing. [Emit.env_param] is where + the position is argued. *) + let tail = match env with None -> [] | Some a -> [ a ] in + ignore (emit_args f (head @ body @ chan @ tail)); (* The cell is loaded *after* the arguments, and [emit.ml] has the same as a load-bearing comment: a redefinition that lands between two calls still must not land in the middle of one. [r11] is scratch and no argument @@ -3371,11 +3437,12 @@ let frame_bytes f = ((f.maxframe + f.outgoing + 15) / 16) * 16 (* Where each argument arrives, in the order the header lays down: a hidden [sret] first when the result is an aggregate, then the parameters, then the - transfer channel. Answers one entry per incoming value — a register number, - or a positive [rbp] displacement for the ones that came on the stack. *) + environment, then the transfer channel. Answers one entry per incoming + value — a register number, or a positive [rbp] displacement for the ones + that came on the stack. *) type incoming = Ireg of int | Isse of int | Istk of int -let incoming_of ~sret (params : Types.t list) = +let incoming_of ~sret ~env (params : Types.t list) = let ints = ref 0 and sses = ref 0 and stk = ref 0 in let next_int () = if !ints < n_int_args then (incr ints; Ireg int_args.(!ints - 1)) @@ -3395,7 +3462,17 @@ let incoming_of ~sret (params : Types.t list) = else next_int ()) params in - sret_at, ps, next_int () + (* Left to right, and the two [next_int ()] calls must be sequenced: OCaml's + argument evaluation order is unspecified, so a tuple built in one + expression could hand the channel's register to the environment. + + The channel, then the environment, and the environment only on a body + that declared one — which is exactly the set of bodies an [Fn] value can + reach. Every other function is never the target of an env-passing call, + so the two never meet out of step. See [Emit.env_param]. *) + let xfer_at = next_int () in + let env_at = if env then Some (next_int ()) else None in + sret_at, ps, env_at, xfer_at (* ── The frame map ───────────────────────────────────────────────────── *) @@ -3422,7 +3499,7 @@ let where_from = function let frame_map (md : Emit.m) (fn : Tast.fn) ~slots ~fixed ~total ~outgoing ~xfer_off ~sret_off ~retval ~dframe ~dslotv ~sret ~sret_at ~param_at - ~xfer_at = + ~env_at ~xfer_at = let b = Buffer.create 1024 in let line s = Buffer.add_string b (if s = "" then "#\n" else "# " ^ s ^ "\n") in (* The prose paragraphs wrap; the table below does not, because its columns @@ -3493,10 +3570,22 @@ let frame_map (md : Emit.m) (fn : Tast.fn) ~slots ~fixed ~total ~outgoing (Types.to_string fn.Tast.ret) (if is_float fn.Tast.ret then "xmm0" else "rax"))); para (Printf.sprintf - "The transfer channel arrives last of all, %s. It is a pointer to the cell a \ - callee writes its target into, and reading it is what every guard below \ - does." - (where_from xfer_at)); + "The transfer channel arrives after the parameters, %s. It is a pointer to the \ + cell a callee writes its target into, and reading it is what every guard \ + below does.%s" + (where_from xfer_at) + (match env_at with + | None -> + " Nothing follows it: no (Fn ...) value can reach this function, so it \ + declares no environment — which is what lets an ordinary defn cost \ + exactly what it did before capture existed." + | Some at -> + Printf.sprintf + " And then the environment, %s, because a (Fn ...) value can reach this \ + function and every such call passes one. It holds the captured copies \ + when there are any and is ignored when there are not; either way the \ + signature declares it, so the call is exactly typed." + (where_from at))); line ""; para (Printf.sprintf "The frame is 0x%x bytes below rbp. %s" total @@ -3716,7 +3805,9 @@ let emit_fn (md : Emit.m) ~externs ~fns ?(ext = fun _ -> false) high-water mark of the temporaries and this is the boundary below which they start. It is the frame map's last line. *) let fixed = f.frame in - let sret_at, param_at, xfer_at = incoming_of ~sret fn.Tast.params in + let sret_at, param_at, env_at, xfer_at = + incoming_of ~sret ~env:(fn.Tast.fenv <> None) fn.Tast.params + in (* An aggregate parameter arrives as a pointer to the caller's copy and has to be copied into its slot before anything else runs — and [rep movsb] eats rdi, rsi and rcx, which is where three of the other parameters still @@ -3975,6 +4066,18 @@ let emit_fn (md : Emit.m) ~externs ~fns ?(ext = fun _ -> false) | _ -> max 1 (fst (Emit.lay md ty))) end) fn.Tast.params; + (* The environment, on the one kind of function that declared one. Every + other function never asks where it is, which is exactly why a call site + may append it whether or not the callee wanted it. *) + (match fn.Tast.fenv, env_at with + | Some slot, Some at -> + (match at with + | Ireg r -> store_int pb ~src:r ~mm:(Frame f.slots.(slot)) ~size:8 + | Istk d -> + load_int pb ~dst:rax ~mm:(Frame d) ~size:8 ~signed:false; + store_int pb ~src:rax ~mm:(Frame f.slots.(slot)) ~size:8 + | Isse _ -> unsupported "the environment in an SSE register") + | _ -> ()); (match xfer_at with | Ireg r -> store_int pb ~src:r ~mm:(Frame f.xfer_off) ~size:8 | Istk d -> @@ -4052,7 +4155,7 @@ let emit_fn (md : Emit.m) ~externs ~fns ?(ext = fun _ -> false) (frame_map md fn ~slots:f.slots ~fixed ~total:(frame_bytes f) ~outgoing:f.outgoing ~xfer_off:f.xfer_off ~sret_off:f.sret_off ~retval:f.retval ~dframe:f.dframe ~dslotv:f.dslotv ~sret ~sret_at - ~param_at ~xfer_at); + ~param_at ~env_at ~xfer_at); Buffer.add_string out (Printf.sprintf "\t.globl\t%s\n" sym); (* [emit.ml:2072] says this is load-bearing and it is: default visibility in a shared object is interposable, and that applies to taking the address @@ -4191,6 +4294,8 @@ let emit_main ?(cfi = false) ?(ann = false) ?(startup = false) ?(gc = false) let xfer = -8 and argv = -32 in xor_rr b ~dst:rax ~src:rax; store_int b ~src:rax ~mm:(Frame xfer) ~size:8; + (* [main] declares no environment — it is not reached through a function + value — so this is the call it always was. *) (match fn.Tast.params with | [] -> lea b ~dst:rdi ~mm:(Frame xfer) | [ _ ] -> @@ -4857,10 +4962,14 @@ let redefinition ~checks ?(dev = true) ?(known = fun _ -> true) (* A clause lifted out of a target comes with it: its body may have changed too, and it is reached by address from inside this module rather than through a cell. Every other lifted clause is invisible here. *) + (* The widening thunks come whole, for the reason [Emit.redefinition] + gives: a module that hands a name to an [Fn]-typed parameter names one + and the host has no cell for it. *) let lifted = List.filter (fun (f : Tast.fn) -> match f.Tast.fparent with + | Some "" -> true | Some q -> List.mem q fns | None -> false) p.Tast.fns diff --git a/runtime/flan_rt.c b/runtime/flan_rt.c index 2e79e6c9..50d92863 100644 --- a/runtime/flan_rt.c +++ b/runtime/flan_rt.c @@ -33,10 +33,21 @@ * A type is a number rather than a pointer to anything, so that a module * compiled later against a running program agrees with it: see Check.type_id. */ +/* [env] is the establishing function's copies of whatever the clause + * captured, or NULL. It is passed after the channel, and *every* clause + * declares it whether or not it captured — this walk cannot know which one + * it is about to reach, and a call whose signature is one argument longer + * than the callee's is a trap on wasm32, where call_indirect compares them. + * Emit's env_param is where the rule is written. + * + * It points into the establishing frame, which is alive for exactly as long + * as the handler frame below it is on this stack — a handler frame is popped + * by the body that pushed it, so there is no dangling case here to defer. */ typedef struct flan_handler { struct flan_handler *prev; uint32_t type_id; - void (*fn)(void *condition, void *xfer); + void (*fn)(void *condition, void *xfer, void *env); + void *env; } flan_handler; static flan_handler *handlers; @@ -64,7 +75,7 @@ void flan_handler_pop(flan_handler *h) { void flan_signal(uint32_t type_id, void *condition, void *xfer) { for (flan_handler *h = handlers; h != NULL; h = h->prev) if (h->type_id == type_id) { - h->fn(condition, xfer); + h->fn(condition, xfer, h->env); if (*(void **)xfer != NULL) return; } } @@ -1992,7 +2003,9 @@ static uint64_t flan_hash_mem(const uint8_t *p, int64_t n, uint64_t seed) { * * The pointer form has to match flan_hash_fn, whose last parameter exists * because a hash function emitted for a struct key is an ordinary Flan - * function and every Flan function's signature ends with the transfer channel. + * function and every Flan function's signature ends with the transfer + * channel. No environment: a hasher is reached from this file and never + * through a function value, so it declares none and is handed none. * The direct form has to match what such an emitted function *calls*, and an * emitted function has no channel to hand on — it would be passing its own, * which is not the same thing and not something a leaf hasher should see. So diff --git a/test/programs/fn-capture-dyn.flan b/test/programs/fn-capture-dyn.flan new file mode 100644 index 00000000..03ee5b6d --- /dev/null +++ b/test/programs/fn-capture-dyn.flan @@ -0,0 +1,13 @@ +;; A dyn is the one thing a capture refuses outright, and for the reason a +;; struct field of dyn already refuses: the collector's roots are frames, and +;; nothing pushes the fields of the environment struct a capture synthesises. +;; A copy in there would be a live value reachable only through memory the +;; marker never walks. Milestone 2's per-type descriptors lift it, alongside +;; the condition payload's and the struct field's. +(defn run [f (Fn [] i64)] i64 (f)) + +;; [d] is unannotated, which is what makes it a dyn. +(defn use [d] i64 + (run (fn [] (i64 d)))) + +(defn main [] i32 (println (use 7)) 0) diff --git a/test/programs/fn-capture-set.flan b/test/programs/fn-capture-set.flan new file mode 100644 index 00000000..6e2bc66f --- /dev/null +++ b/test/programs/fn-capture-set.flan @@ -0,0 +1,10 @@ +;; A captured name is a copy, taken where the value was made. A store into it +;; would change the copy and leave the local it came from as it was, which is +;; a silent disagreement — so it is refused, and the message says which of the +;; two would have moved. +(defn run [f (Fn [] i32)] i32 (f)) + +(defn main [] i32 + (let [n 1] + (println (run (fn [] (set n 2) n)))) + 0) diff --git a/test/programs/fn-capture.flan b/test/programs/fn-capture.flan index 7b9975f3..934e8b8e 100644 --- a/test/programs/fn-capture.flan +++ b/test/programs/fn-capture.flan @@ -1,11 +1,116 @@ -;; Capture does not exist. An fn is lifted into a function of its own and is -;; handed nothing but its parameters, so a reference to a local of the -;; enclosing function is refused by name rather than resolved to something it -;; did not mean. spec-memory.md's capture cases, and escaping closures with -;; them, are deferred; this is the refusal that says so where it happens. -(defn use [f (Fn [] i32)] i32 (f)) +;; Capture by value into a stack environment — spec-memory.md's case 2. +;; +;; An fn is still lifted into a function of its own, but it is no longer handed +;; nothing but its parameters: a local of the enclosing function that it names +;; is *copied* into an environment on that function's frame when the value is +;; made, and the lifted body reads the copy. The value is the code address and +;; that environment beside it, which is why a callee that knows only +;; (Fn [i32] i32) can still call it. +;; +;; What is not here is the escaping half — a value carrying an environment may +;; not outlive the frame the copies are on, and fn-escape*.flan is where each +;; of those refusals is written down. + +(defn double [x i32] i32 (* x 2)) + +(defn apply2 [f (Fn [i32] i32) x i32] i32 (f x)) +(defn call0 [f (Fn [] i32)] i32 (f)) +(defn twice [f (Fn [i32] i32) x i32] i32 (f (f x))) + +;; The copy is taken where the value is made and not where it is read, and +;; this is what proves it: the local is changed *after* the fn value exists +;; and before it is called, through a pointer, so nothing about the order can +;; be an accident of evaluation. +(defn bump-then-call [f (Fn [] i32) p (Ptr i32)] i32 + (set (deref p) 99) + (f)) + +(defstruct Pt [x i32 y i32]) + +(defstruct TooBig [n i32]) +(defonce seen i32) + +(defn checked [x i32] i32 + (when (> x 100) (signal (TooBig {.n x}))) + x) + +;; A handler clause is lifted the same way and captures the same way, and is +;; sound with nothing left over: a handler frame is popped by the body that +;; pushed it, so the establishing frame is alive whenever the clause runs. +;; [budget] is read out of the environment; the accumulator is a global, +;; because a captured copy is a copy and a store into one would leave the +;; local it came from as it was. +(defn handles [] i32 + (let [budget 1000 + xs [5 200 7 300] + s (slice xs 0 4) + t 0] + (handler-bind [(TooBig [c] (set seen (+ seen (+ budget (.n c)))))] + (dotimes [i 4] + (set t (+ t (checked (at s i)))))) + (print t) (print " ") (println seen) + seen)) (defn main [] i32 - (let [n 7] - (println (use (fn [] n)))) + ;; The motivating program. + (let [bonus 10] + (println (apply2 (fn [x] (+ x bonus)) 5))) + + ;; Copy at creation: the fn answers 1 and the local is 99. + (let [n 1] + (print (bump-then-call (fn [] n) (addr n))) + (print " ") + (println n)) + + ;; What may be captured. A string and a slice are two words copied as two + ;; words — the bytes stay whoever's they were, which is fine exactly while + ;; the value cannot outlive the frame that owns them. A struct and a fixed + ;; array are copied whole. A function value is copied as a function value. + (let [s "hi" + arr [1 2 3 4] + sl (slice arr 0 4) + p (Pt {.x 3 .y 4}) + g double] + (println (call0 (fn [] (i32 (length s))))) + (println (call0 (fn [] (at sl 2)))) + (println (call0 (fn [] (+ (.x p) (.y p))))) + (println (call0 (fn [] (at arr 3)))) + (println (apply2 (fn [x] (g (+ x 1))) 4))) + + ;; An fn inside an fn, each capturing. The inner one names a local neither + ;; of them declared, so the outer one captures it too and the inner one + ;; copies the outer one's copy. + (let [a 100 + b 20] + (println (apply2 (fn [x] (+ x (call0 (fn [] (+ a b))))) 3))) + + ;; A loop variable: what the fn sees is the value at the iteration it was + ;; made on, not the last one. 0 + 1 + 2 + 3. + (let [total 0] + (dotimes [i 4] + (set total (+ total (call0 (fn [] i))))) + (println total)) + + ;; And the same again where the loop variable is rebound by a recur rather + ;; than stepped by a dotimes, which is a store into the slot the copy is + ;; taken from: 100 + 101 + 102. + (println + (let [base 100] + (loop [i 0 acc 0] + (if (< i 3) + (recur (+ i 1) (+ acc (call0 (fn [] (+ base i))))) + acc)))) + + ;; Called twice, so the environment is read more than once and a body that + ;; consumed it would show. + (let [k 5] + (println (twice (fn [x] (+ x k)) 1))) + + ;; An fn's own let may shadow a name the enclosing function also has, and a + ;; store into *that* one is an ordinary store: the refusal is about a + ;; captured copy and not about the spelling. 5 + 1. + (let [n 5] + (println (+ n (call0 (fn [] (let [n 0] (set n 1) n)))))) + + (println (handles)) 0) diff --git a/test/programs/fn-cfn-captures.flan b/test/programs/fn-cfn-captures.flan new file mode 100644 index 00000000..d021597b --- /dev/null +++ b/test/programs/fn-cfn-captures.flan @@ -0,0 +1,10 @@ +;; A CFn is the bare address, so a literal written into one has nowhere to +;; keep the copies. Refused with the name of what it captured, because that is +;; the fact to act on, and with the fix named: widen the position to Fn, which +;; is what the type is for. +(defn apply-bare [f (CFn [i32] i32) x i32] i32 (f x)) + +(defn main [] i32 + (let [bonus 10] + (println (apply-bare (fn [x] (+ x bonus)) 5))) + 0) diff --git a/test/programs/fn-cfn-narrow.flan b/test/programs/fn-cfn-narrow.flan new file mode 100644 index 00000000..cd101f38 --- /dev/null +++ b/test/programs/fn-cfn-narrow.flan @@ -0,0 +1,13 @@ +;; Coercion between the two function types goes one way only. A (CFn ...) +;; widens into a (Fn ...) through a per-signature thunk, and a (Fn ...) does +;; not narrow: there is nowhere for the environment to go, and nothing at this +;; definition can know whether there is one. +;; +;; Refused by the ordinary type message, which names both spellings and is the +;; right sentence for it: the fix is to widen the position, not to convert the +;; value. +(defn apply-bare [f (CFn [i32] i32) x i32] i32 (f x)) + +(defn hand-on [f (Fn [i32] i32) x i32] i32 (apply-bare f x)) + +(defn main [] i32 0) diff --git a/test/programs/fn-cfn.flan b/test/programs/fn-cfn.flan new file mode 100644 index 00000000..2ab8ed9a --- /dev/null +++ b/test/programs/fn-cfn.flan @@ -0,0 +1,67 @@ +;; The narrow function type. A (CFn [T ...] R) is the bare code address — +;; one word, no environment, and therefore nothing that can capture. A +;; (Fn [T ...] R) is that address and the environment beside it, two words. +;; +;; The reason there are two rather than one: an environment on every signature +;; would tax every function in every program for a feature most of them never +;; use. With CFn written where it is wanted, an ordinary defn emits exactly +;; the signature it emitted before capture existed, and a call to it by name +;; is byte-for-byte what it was. +;; +;; The C is information and not decoration. A value with no environment is the +;; only kind that could ever cross to C, and under the --no-conditions +;; direction FIX.org records — where a signature that cannot transfer drops +;; the channel too — one becomes literally a C function pointer. It is not +;; that today: a declare cannot take a function type at all, and the refusal +;; it meets says so. The name points at what the type is, and at where it is +;; going. +;; +;; **Nobody needs CFn.** An Fn accepts everything a CFn does, so the narrow +;; one is reached for on purpose, for one of four reasons: handing a function +;; to C, later; a table of bare addresses; forbidding capture at a boundary; +;; and the one that is likeliest in practice — a *named* function handed to an +;; Fn parameter goes through the widening thunk and pays an indirect hop per +;; call, where a CFn parameter is a direct call. (map-in-place s double) is +;; the example, and [apply-bare] below is it in miniature. +;; +;; Coercion is one-way. A defn's address and a non-capturing literal satisfy +;; both. An Fn does not narrow to a CFn — there is nowhere for the +;; environment to go — and fn-cfn-narrow.flan is that refusal. + +(defn double [x i32] i32 (* x 2)) +(defn negate [x i32] i32 (- 0 x)) + +;; Taking the narrow one. Nothing that reaches here can carry an environment, +;; which is what the signature is saying. +(defn apply-bare [f (CFn [i32] i32) x i32] i32 (f x)) + +;; And the wide one, which is what almost every higher-order signature wants. +(defn apply-any [f (Fn [i32] i32) x i32] i32 (f x)) + +;; A CFn returned. It is a link-time constant with nothing behind it, so +;; handing one back is no different from handing it down — which is exactly +;; what a capturing value cannot do. +(defn pick [up bool] (CFn [i32] i32) (if up double negate)) + +;; A CFn parameter widened to an Fn at a call: the address goes where an +;; environment would be and the thunk reads it back out. This is the hop the +;; narrow type exists to avoid. +(defn through [f (CFn [i32] i32) x i32] i32 (apply-any f x)) + +(defn main [] i32 + ;; A name into a CFn, and into an Fn. + (println (apply-bare double 4)) + (println (apply-any negate 4)) + ;; A literal that captures nothing into a CFn. + (println (apply-bare (fn [x] (+ x 1)) 4)) + ;; And one that does capture, into an Fn. + (let [k 10] + (println (apply-any (fn [x] (+ x k)) 4))) + ;; A returned CFn, called through a computed head. + (println ((pick true) 21)) + (println ((pick false) 21)) + ;; The widening, twice over: a CFn local through a CFn parameter into + ;; an Fn parameter. + (let [g double] + (println (through g 5))) + 0) diff --git a/test/programs/fn-escape-copy.flan b/test/programs/fn-escape-copy.flan new file mode 100644 index 00000000..b9f3a1ea --- /dev/null +++ b/test/programs/fn-escape-copy.flan @@ -0,0 +1,19 @@ +;; The hole a capture could otherwise be laundered through, and the reason +;; "the result of a call is clean" is a rule and not a hope. +;; +;; [sneak]'s literal captures [g], so its body holds a *copy* of a function +;; value that may itself carry an environment — and the copy is read out of an +;; environment, which is the one aggregate a function value is ever stored in. +;; If a copy read back out were treated as clean, the literal could return it, +;; the return would arrive at [sneak]'s caller as an ordinary call result, and +;; a capturing value would be out of the frame that owns it with nothing +;; having refused anything. +;; +;; So a function value read out of a struct, a case or a pointer is suspect, +;; and the refusal lands inside the lifted body where the return is written. +(defn getf [f (Fn [] (Fn [] i32))] (Fn [] i32) (f)) + +(defn sneak [g (Fn [] i32)] (Fn [] i32) + (getf (fn [] g))) + +(defn main [] i32 0) diff --git a/test/programs/fn-escape-handled.flan b/test/programs/fn-escape-handled.flan new file mode 100644 index 00000000..8e8fd54e --- /dev/null +++ b/test/programs/fn-escape-handled.flan @@ -0,0 +1,12 @@ +;; A handler-bind is an expression and its value is its body's, so it is a way +;; for a function value to be a function's answer — and it would have walked +;; straight past a check that only looked at [return] and at the last form of +;; a block. with-allocator and restart-case are the same shape and are checked +;; the same way. +(defstruct C [id i32]) +(defonce seen i32) + +(defn keep [f (Fn [] i32)] (Fn [] i32) + (handler-bind [(C [c] (set seen (.id c)))] f)) + +(defn main [] i32 0) diff --git a/test/programs/fn-escape-param.flan b/test/programs/fn-escape-param.flan new file mode 100644 index 00000000..6cba4ed2 --- /dev/null +++ b/test/programs/fn-escape-param.flan @@ -0,0 +1,11 @@ +;; The hard case, answered without looking at a single call site: a function +;; value that arrives as a parameter may carry an environment on its caller's +;; frame, so a function that *stores* one is refused where it is written. +;; +;; That is what makes passing a capturing fn down safe everywhere — no callee +;; can keep it — and it is also the conservative half: this particular [keep] +;; would be harmless for a caller that passed a name, and there is no way for +;; the definition to know that it did. +(defn keep [f (Fn [] i32)] (Fn [] i32) f) + +(defn main [] i32 (println ((keep (fn [] 1)))) 0) diff --git a/test/programs/fn-escape-return.flan b/test/programs/fn-escape-return.flan new file mode 100644 index 00000000..c56617af --- /dev/null +++ b/test/programs/fn-escape-return.flan @@ -0,0 +1,10 @@ +;; The refusal that defines "non-escaping". The copies live in a slot of +;; [make]'s frame, and the value would still be pointing at them after that +;; frame has gone. +;; +;; A returned function value is still fine when it captures nothing — +;; fn-values.flan returns one — so this is about the environment and not about +;; the shape of the value. +(defn make [n i32] (Fn [] i32) (fn [] n)) + +(defn main [] i32 (println ((make 3))) 0) diff --git a/test/programs/fn-escape-store.flan b/test/programs/fn-escape-store.flan new file mode 100644 index 00000000..248c3619 --- /dev/null +++ b/test/programs/fn-escape-store.flan @@ -0,0 +1,7 @@ +;; A store through a pointer is the same escape wearing a different hat: the +;; pointer names storage this frame does not own, so the value would outlive +;; the environment it carries. +(defn stash [p (Ptr (Fn [] i32)) f (Fn [] i32)] () + (set (deref p) f)) + +(defn main [] i32 0) diff --git a/test/programs/fn-escape-vec.flan b/test/programs/fn-escape-vec.flan new file mode 100644 index 00000000..affa50f5 --- /dev/null +++ b/test/programs/fn-escape-vec.flan @@ -0,0 +1,9 @@ +;; A Vec's elements are in a block the allocator owns and the frame does not, +;; so a function value pushed into one outlives whatever environment it +;; carries. Refused for that, and not for the shape of the element type: a Vec +;; of function values is a perfectly good thing to want, and is what case 3 +;; is for. +(defn stash [v (Vec (Fn [] i32)) f (Fn [] i32)] () + (push v f)) + +(defn main [] i32 0) diff --git a/test/programs/fn-extern.flan b/test/programs/fn-extern.flan index 1cf28821..aa74ed0e 100644 --- a/test/programs/fn-extern.flan +++ b/test/programs/fn-extern.flan @@ -1,6 +1,8 @@ ;; A foreign function's address is not a Flan function value. A Flan -;; function's emitted signature ends with the transfer channel and a C one -;; does not, so nothing could call the resulting pointer correctly — and an +;; function's emitted signature ends with the environment and the transfer +;; channel and a C one does not, so nothing could call the resulting pointer +;; correctly — and the gap is wider since capture arrived, because a Flan +;; function value is two words and a C symbol is one — and an ;; aggregate crossing the boundary is flattened by a generated shim, which the ;; raw symbol knows nothing about. Refused for what it is, with the wrapper ;; named as the way to get one. diff --git a/test/programs/fn-in-struct.flan b/test/programs/fn-in-struct.flan index 510b9b6c..661e0c32 100644 --- a/test/programs/fn-in-struct.flan +++ b/test/programs/fn-in-struct.flan @@ -4,6 +4,17 @@ ;; union's first case. So it is refused where the field is written rather than ;; left to crash at the call, and the same rule covers a global, a fixed ;; array's element and (zeroed). +;; +;; Capture sharpened the reason behind this one without changing it. A struct +;; outlives the frame it was built on, so a field could not hold a value +;; carrying an environment either — see fn-escape-*.flan. The zero is still +;; what the message names, because it is the objection that applies to every +;; function value and not only to a capturing one. +;; +;; Which means a (CFn ...) field is refused too, and for the zero alone — +;; a table of function pointers is exactly what that type is for, and nothing +;; about capture stands in its way. An (Option (CFn ...)) field is already +;; legal and is the shape that works; FIX.org carries the rest as its own item. (defstruct Ops [run (Fn [i32] i32)]) (defn main [] i32 0) diff --git a/test/programs/fn-no-type.flan b/test/programs/fn-no-type.flan index 2189b49e..944a5af2 100644 --- a/test/programs/fn-no-type.flan +++ b/test/programs/fn-no-type.flan @@ -2,6 +2,10 @@ ;; so it takes them from the position it is written in. An argument position ;; says what is wanted, because the callee's signature is threaded into every ;; argument; a let binding does not, and is refused saying so. +;; +;; The one thing capture did not change. It is about where the *types* come +;; from and not about what the body may see, so an fn is still written where +;; something says what it takes. (defn main [] i32 (let [f (fn [x] (* x 2))] (println (f 3))) diff --git a/test/programs/fn-values.flan b/test/programs/fn-values.flan index e618b5a8..52362f23 100644 --- a/test/programs/fn-values.flan +++ b/test/programs/fn-values.flan @@ -1,5 +1,13 @@ -;; Function values, the non-escaping kind: a code address and no environment -;; beside it. Capture does not exist, so nothing here can outlive anything. +;; Function values, and specifically the ones with no environment. Nothing +;; here captures, which is what makes every one of these safe to return and to +;; hand around — fn-capture.flan is the other half, and fn-escape-*.flan is +;; the line between them. +;; +;; Every signature below says (Fn ...), which is the wide one: it admits a +;; capturing value and so pays for a two-word value and a widening thunk where +;; a name is handed to it. Written as (CFn ...) these would pay neither, and +;; fn-cfn.flan is where that is spelled out — the spellings are kept apart +;; here so that the two programs cover the two conventions between them. ;; ;; This is a Lisp-1 — one top-level namespace, enforced — so a bare function ;; name *is* the function and there is no #' to write. diff --git a/test/reload_host.c b/test/reload_host.c index c22ac294..c0c0448f 100644 --- a/test/reload_host.c +++ b/test/reload_host.c @@ -43,7 +43,10 @@ /* The trailing ptr is the transfer channel spec-conditions.md §6 puts in every * Flan signature. This host never transfers, so it passes a slot of its own * that stays null — but the parameter is not optional: getting it wrong reads - * garbage as the channel and fails nowhere near here. */ + * garbage as the channel and fails nowhere near here. + * + * No environment: [outer] is called by name and not through a function value, + * so it declares none. That is the point of there being two function types. */ extern int64_t flan_outer(void *xfer) __asm__("flan.outer"); extern int64_t flan_counter __asm__("flan.counter"); diff --git a/test/test_acceptance.ml b/test/test_acceptance.ml index e6e5b395..51a8864e 100644 --- a/test/test_acceptance.ml +++ b/test/test_acceptance.ml @@ -3928,12 +3928,78 @@ level "1" outputs ~opt:"-O0" "the prelude's map, filter, reduce and sort-by, -O0" "programs/higher-order.flan" higher_order_out; - (* What function values do *not* include, each refused by name. Capture is - the headline: an fn is lifted into a function of its own and handed - nothing but its parameters, so spec-memory.md's capture cases and - escaping closures with them stay deferred. *) - refuses "an fn cannot capture" "programs/fn-capture.flan" - "cannot see n"; + (* Capture by value into a stack environment — spec-memory.md's case 2. + Three opt levels for the reason the case above has them, and for one + more: the environment is a struct in the frame and the value carries + its address, which is exactly the shape -O2 is entitled to make + disappear. -O0 is what proves there is a real store and a real load + behind it. A dev build is here because the value's code half still + comes out of the indirection cell and the environment half must not + have disturbed that. + + The two lines worth naming. "1 99" is copy-at-creation: the local is + changed through a pointer after the value exists and before it is + called, so no evaluation order can account for the fn still answering + 1. And "512 2500" is the handler clause reading a captured budget, + which is the same machinery in the one place where there is no + escaping case left over. *) + let fn_capture_out = + "15\n1 99\n2\n3\n7\n4\n10\n123\n6\n303\n11\n6\n512 2500\n2500\n" + in + outputs "an fn capturing by value" "programs/fn-capture.flan" + fn_capture_out; + outputs ~opt:"-O0" "an fn capturing by value, -O0" "programs/fn-capture.flan" + fn_capture_out; + (* The narrow function type, and the one-way coercion. What this asserts + that no checker test can: a CFn widened into an Fn and called through + the wider signature reaches the same body and answers the same thing, + on both opt levels — so the null environment a widening pairs with the + address really is ignored by a body that declared none. *) + let fn_ptr_out = "8\n-4\n5\n14\n42\n-21\n10\n" in + outputs "the two function types" "programs/fn-cfn.flan" fn_ptr_out; + outputs ~opt:"-O0" "the two function types, -O0" "programs/fn-cfn.flan" + fn_ptr_out; + (* And a dev build, which is the one that exercises the widening thunk + over an indirection cell: a name widened into an Fn is a cell load for + the address and the thunk for the call, and the two have to compose. *) + outputs ~dev:true "the two function types, dev" "programs/fn-cfn.flan" + fn_ptr_out; + outputs ~dev:true "an fn capturing by value, dev" "programs/fn-capture.flan" + fn_capture_out; + + (* What function values do *not* include, each refused by name. Escape is + the headline now that capture is not: the copies live in the frame the + literal was written in, so a value carrying their address may be + called, passed down and copied about, and may not outlive that frame. + Each of these names case 3 — the collector-allocated environment — + because "not yet" is the true sentence. *) + refuses "a captured fn cannot be returned" "programs/fn-escape-return.flan" + "a return would outlive the frame"; + refuses "a function value parameter cannot be kept" + "programs/fn-escape-param.flan" "may carry an environment"; + refuses "a function value cannot be stored through a pointer" + "programs/fn-escape-store.flan" "a store would outlive the frame"; + refuses "a function value cannot be pushed into a Vec" + "programs/fn-escape-vec.flan" "a container would outlive the frame"; + (* The two an escape check written by eye would have missed. A function + value read back out of an environment is a copy of something that may + carry one, and a handler-bind is an expression whose value is its + body's — so both are ways for a suspect to be a function's answer. *) + refuses "a captured function value cannot be handed back" + "programs/fn-escape-copy.flan" "a return would outlive the frame"; + refuses "a handler-bind's value is a return too" + "programs/fn-escape-handled.flan" "a return would outlive the frame"; + refuses "a captured local is a copy and cannot be assigned" + "programs/fn-capture-set.flan" "cannot assign to n"; + (* The two function types, and the line between them. A CFn is the bare + address, so nothing that captures can be one and nothing that may + capture can narrow into one. *) + refuses "an fn that captures is not a CFn" + "programs/fn-cfn-captures.flan" "and not a (CFn [i32] i32)"; + refuses "an Fn does not narrow to a CFn" + "programs/fn-cfn-narrow.flan" "expected (CFn [i32] i32)"; + refuses "an fn cannot capture a dyn" "programs/fn-capture-dyn.flan" + "the collector finds its roots by frame"; refuses "an fn with no type to take" "programs/fn-no-type.flan" "nothing here says what this fn"; refuses "a function value would be zeroed" "programs/fn-in-struct.flan" diff --git a/test/test_flan.ml b/test/test_flan.ml index d3faadd2..183c9747 100644 --- a/test/test_flan.ml +++ b/test/test_flan.ml @@ -473,7 +473,7 @@ let () = (match ty "(Map string i32)" with | Tapp ("Map", [ _; _ ]) -> () | _ -> check "(Map K V) is a map type" false); (match ty "(Fn [a a] bool)" with - | Tfn ([ _; _ ], _) -> () | _ -> check "(Fn [T] R)" false); + | Tfn (_, [ _; _ ], _) -> () | _ -> check "(Fn [T] R)" false); (* ── Declarations ──────────────────────────────────────────────── *) (match (parse_decl "(defn f [x i32] bool x)").d with @@ -3668,14 +3668,21 @@ let () = rejects_check "signal in value position" "(defstruct C [id i32])\n\ (defn f [] i32 (signal (C {.id 1})))" ~needle:"expected i32"; - (* A handler is lifted into a function of its own, so the establishing - function's locals are not there. Capturing them is a closure, which is - milestone 5 — until then it is refused for the reason it is refused for - rather than as an unknown name. *) - rejects_check "a handler capturing a local" + (* A handler clause captures the establishing function's locals by value — + spec-memory.md's case 2 — so it can read one. A *store* is the thing that + is not there: the clause holds a copy, and writing to it would leave the + local it came from as it was, which is a silent disagreement and not a + feature. Refused for that reason, with the accumulation case pointed at a + global. *) + accepts "a handler reading a local" + "(defstruct C [id i32])\n\ + (defonce seen i32)\n\ + (defn f [] () (let [n 7] (handler-bind [(C [c] (set seen (+ n (.id c))))] \ + (signal (C {.id 2})))))"; + rejects_check "a handler assigning to a captured local" "(defstruct C [id i32])\n\ (defn f [] () (let [n 0] (handler-bind [(C [c] (set n 1))] (signal (C {.id 2})))))" - ~needle:"a handler cannot see n"; + ~needle:"a handler cannot assign to n"; (* The frames are popped on the way out of the body, so an early exit would leave them on the stack pointing into a function that has gone. *) rejects_check "return inside handler-bind" @@ -3761,14 +3768,18 @@ let () = accepts "handler-case with several clauses" (boom ^ "(defn f [] i32 (handler-case 1 [(Boom [c] (.id c)) \ (Dud [c] (+ 1 (.id c)))]))"); - (* The whole difference from handler-bind: a clause runs at the form, in the - function that wrote it, so it sees that function's locals. The same body - under a handler-bind is refused by name. *) + (* The difference from handler-bind is narrower than it was. Both see the + establishing function's locals now — a handler-case clause *is* that + function, and a handler-bind clause captures them by value. What only a + handler-case clause can do is *assign* to one, because it is not holding + a copy. *) accepts "a handler-case clause sees the establishing function's locals" (boom ^ "(defn f [] i32 (let [n 1] (handler-case 0 [(Boom [c] n)])))"); + accepts "and may assign to one, which a handler-bind clause may not" + (boom ^ "(defn f [] i32 (let [n 1] (handler-case 0 [(Boom [c] (set n 2) n)])))"); rejects_check "a handler-bind clause still cannot" (boom ^ "(defn f [] i32 (let [n 1] (handler-bind [(Boom [c] (set n 2))] 0)))") - ~needle:"a handler cannot see n — it is a local of the enclosing function"; + ~needle:"a handler cannot assign to n"; (* Nothing static refuses a condition no clause lists: it installs no frame that matches, so it goes past untouched and the body carries on. *) accepts "a condition no clause lists" diff --git a/test/test_session.ml b/test/test_session.ml index 8bb2d271..a5017ac3 100644 --- a/test/test_session.ml +++ b/test/test_session.ml @@ -1305,7 +1305,7 @@ let () = if Session.strip_rebind "~2" <> "~2" then fail "a name that is only a suffix was stripped"; (let fn snames : Tast.fn = { Tast.name = "f"; params = []; ret = Types.Unit; body = []; - fdefers = []; fparent = None; floc = Loc.unknown; + fdefers = []; fenv = None; fparent = None; floc = Loc.unknown; slots = Array.make (Array.length snames) (Types.Int Types.I32); snames } in