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

A capturing fn's environment belongs to the collector, so a closure may outlive the frame that made it

Browse Source
This commit is contained in:
Joseph Ferano 2026-09-25 11:13:57 +07:00
parent bf827dc55b
commit 389e93ff09
24 changed files with 1169 additions and 618 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

27
TODO.org
View File

@ -492,14 +492,23 @@ an ordinary =defn= declares no environment and is byte-for-byte what it was. The
static side does not pay for the dynamic side. Rejected names: Closure, Proc, Fun,
Func, Fnptr.
** NEXT Escaping closures, allocated on the GC side
Decided 2026-09-25: start it. It must work on wasm32.
The second half of "do both". What changes is where the environment points — a
frame slot today, a collector allocation then — and the escape check goes away
with it, along with the refusals on returning, storing, pointing at and pushing a
capturing value. Two things for it to know: a widening thunk's environment holds a
code pointer rather than a GC object, and capturing a dyn stays refused until a
synthesised environment has a descriptor.
** DONE Escaping closures, allocated on the GC side
CLOSED: [2026-09-25]
A capturing =fn='s environment is a collector allocation, so the value may be
returned, stored, pointed at and pushed; the escape check is gone and a dyn may be
captured. Capture stays by value — shared state goes through a captured reference
such as a dyn map. The collector follows an =Fn='s second word only when it is an
environment it allocated, so a widened name's code address is never read through.
A =Map= holding function values is refused; a =Vec= is walked. A program with no
capturing =fn= roots no =Fn= and is unchanged. Rules out a tag bit on the
environment word and a thunk that allocates. See docs/BUILT.md, "Escape: the
environment is the collector's".
** TODO A stale Vec header is marked through
A =Vec= copied by value keeps its old pointer after another copy's push
reallocates, and the collector reads that old block when it marks a =Vec= of
function values. Harmless while the block stays mapped; a fault if the allocator
unmapped it. docs/BUILT.md, "Escape: the environment is the collector's".
** TODO CFn and C's calling convention
A Flan function's signature ends with the transfer channel and a C caller knows
@ -1114,6 +1123,8 @@ the buffer.
** TODO Marking through a descriptor an x86 reload module emitted
The module links and runs. What is not proved is a collection running while a live
instance of a dyn-holding struct sits in a frame of a body that module delivered.
The same holds for a closure environment a reload module allocated: the module
builds on both backends, and nothing yet collects while one is live.
For the next sweep rather than for a lane.
** TODO A sliced string loses the trailing NUL

138
docs/BUILT.md
View File

@ -4047,8 +4047,9 @@ feature. This compiles:
(apply2 (fn [x] (+ x bonus)) 5))
```
`bonus` is **copied** into an environment on the enclosing function's frame at the instant the `fn` value is made,
and the lifted body reads the copy. Not a reference: `fn-capture.flan` changes the local through a pointer *after*
`bonus` is **copied** into an environment at the instant the `fn` value is made, and the lifted body reads the copy.
The environment was a slot of the enclosing frame when this section was written and is a collector allocation now;
see "Escape: the environment is the collector's" below. Not a reference: `fn-capture.flan` changes the local through a pointer *after*
the value exists and *before* it is called, and the `fn` still answers with the old one. That test is the whole
claim, and it is the one no evaluation order can fake.
@ -4214,76 +4215,90 @@ A redefinition that changes which locals an `fn` names changes an environment's
place, a slot of the frame the literal was written in, written by the same module that reads it on every entry. A
restart for editing a capture list would take the dev loop away from the feature it was built for.
### Escape, which is what makes "case 2" a bounded claim
### Escape: the environment is the collector's
A value carrying an environment may be **called, passed down, and held in a `let`**. It may not be **returned,
stored, pointed at, or pushed into a container**. The check runs over the typed IR of every function the program
ends up with — including the lifted ones, so an `fn` inside an `fn` needs no special case — and classifies
function-typed values as *suspect* or clean:
spec-memory.md's **case 3**, and the section that stood here — an escape check refusing to let a capturing value be
returned, stored, pointed at or pushed — is gone with the check. A capturing `fn`'s environment is allocated by the
collector (`flan_dyn_env_new`), so the value may go anywhere a function value may: returned, handed back through a
parameter, stored through a pointer, pushed into a `Vec`, kept in an `(Option (Fn ...))` field or global.
`programs/fn-escape.flan` does each of those and calls the value after a forced collection.
- suspect: a capturing literal (`Tast.Closure`, the only node that makes one); a **parameter** of type `Fn`, in
every function; an `Fn` read back out of a struct, a case or a pointer; a local bound to any of those,
transitively; a branch or a valued form whose value is one.
- clean: the address of a name, the result of any call, and **everything of type `CFn`** — the last for free,
because a `CFn` has no environment to dangle and the type says so. The second follows from the first refusal,
which is what stops a function from returning a suspect at all.
**Capture stays by value.** The environment holds copies taken when the value is made; a store into a captured name
is still refused (`fn-capture-set.flan`). State shared between calls goes through something that is itself a
reference — a captured dyn map, a pointer to a global. The fixture's counter is a captured `{:n 0}`.
The two types made this pass narrower rather than wider, which is the point of having them: a signature that says
`CFn` has already promised what the analysis would otherwise have to prove, and nothing written against one is
ever examined.
**What the checker builds.** `Tast.Closure (code, copies)`, where `copies` is the `Make` of the synthesised
environment struct. The backend evaluates the copies (every field a read of a rooted slot), calls
`flan_dyn_env_new(size, descriptor)`, stores the struct into it and pairs the address with the code. Between the
allocation and the value reaching a root the object is in the runtime's allocation ring. A handler clause's
environment is unchanged: still a frame slot, because a handler frame cannot outlive the frame that pushed it.
**The clean set is the enumeration, not the suspect set**, and that is a correction. It read the other way round —
`Field`, `CaseField` and `Deref` named as suspect, everything else clean — and had a hole exactly where a list like
this cannot: `(at s 0)` over a slice of `Fn` is a `Prim`, so it came out clean while the `Vec`, struct and pointer
spellings of the same act were refused. Nothing can write an `Fn` into a slice today, so it was unreachable; but
the pass claims its enumeration is closed, and a default of "clean" is how that claim stops being true without
anyone noticing. `fn-escape-at.flan` pins it. The same inversion fixed which of the two refusal messages an index
read gets.
**Three things can be in an `Fn`'s second word**: null (a name, or an `fn` that captured nothing), a collector
environment, or — for a name widened into an `Fn` — that name's code address, which the widening thunk reads back.
Nothing in the word says which, and no tag bit is free on the code side: on wasm32 a code address is a table index,
a small integer with any low bits. So the collector keeps the **set of environment addresses it has handed out**
and follows a word only when the set has it (`mark_env` in `runtime/flan_dyn.c`); it never reads through a word it
did not allocate. That also makes a stale or unwritten word harmless — at worst a live environment is kept a little
longer — which is what lets the descriptor name words the collector cannot prove are function values (below). The set
is rebuilt from the sweep list after any sweep that freed an environment.
Two of those arms are there because leaving them out is unsound rather than merely conservative, and each has a
program. **A function value read out of an environment** (`fn-escape-copy.flan`): a lifted body holds *copies* of
what it captured, read back with `Field(Deref env, i)`, so a copy of a captured function value carries whatever
environment the original did. Treat it as clean and the lifted body can return it, the return arrives at the outer
caller as an ordinary call result, and the whole "a call result is clean" rule has been walked around from inside.
**A valued form's tail** (`fn-escape-handled.flan`): `handler-bind`, `with-allocator` and `restart-case` are
expressions whose value is their body's — and a `restart-case`'s is a clause's too — so each is a way for a suspect
to be a function's answer that a check looking only at `return` and at the last form of a block would step over.
**The descriptor grew two tables.** `flan_desc` is now the size and three counted tables: dyn words, environment
words, and `Vec` headers whose elements hold either, each with its element's descriptor. A `Vec` entry is marked
through its header's pointer and length as they stand, and skipped when the header's allocator has moved to a later
epoch. A data type may hold a `Vec` of itself, so how deep `Vec`s nest is the data's and not the type's: the marker
queues them on an explicit stack rather than recursing, and a descriptor may name itself as its element's.
`Emit.gc_layout` computes all three for a type; `traced` is the rooting question every site used to ask of
`dyn_offsets`. Environment words are gathered through `Option`, data type payloads and unions — every case's, since
the live case is a tag this table cannot read — which is sound only because of the set above. Dyn words are gathered
where they always were.
**The parameter rule is the whole answer to the hard case.** A capturing `fn` 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:
`(defn keep [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. `fn-escape-param.flan` is that refusal, written down as a
refusal of something that would sometimes have been fine.
**The offsets are constant expressions in LLVM.** Each word carries both its x86-64 byte offset (`goff`, what the
hand-written backend writes) and a `getelementptr` path (`gpath`); the LLVM descriptor writes
`ptrtoint (getelementptr (... ptr null ...))`, so the offset is the target's own. On wasm32 a pointer is four bytes
and an `Fn`'s environment is at offset 4, not 8, and a number computed by `lay` would have marked the wrong word. The
same change fixes a dyn field behind a pointer field on wasm32, which was wrong before this and unexercised. The
prologue's root zeroing walks the same paths. The descriptors now follow the function bodies in the module, because
LLVM wants a named type defined before a constant `getelementptr` can size it. The `size` field stays `lay`'s number:
it is read only as a `Vec`'s element stride, and every push is handed that stride by `SizeOf`.
Refusing `Addr` of a suspect matters more than it looks: without it, `deref` of a `(Ptr (Fn ...))` launders a
suspect into a clean value and the return refusal has been walked around. Treating the `deref` itself as suspect is
the other half of that door, and it is free: 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 already.
**The static side does not pay.** `Emit.m.gcfn` is true only when the program contains a capturing `fn` (or in a dev
build, where a redefinition can add the first one). When it is false an `Fn` holds no environment the collector could
own, `gc_layout` answers nothing for it, and the output has no root push and no `flan_gc_init` it did not have
before — `fn-values.flan` and `higher-order.flan` are asserted to stay that way. When it is true every
`Fn`-holding slot is rooted with a descriptor, including a parameter of a function that captures nothing itself. A
non-capturing `fn` never allocates; a `defn` and a `CFn` are unchanged.
Name resolution inside a lifted body now asks the enclosing function's locals **before** the globals, which is a
deliberate tightening: inside the enclosing function a local shadows a global of the same name, so a body lifted out
of it must mean the same thing. The old order was an accident of where the refusal sat.
**What is refused.**
Every one of these messages names **case 3** — the escaping closure, with an environment the collector owns —
because "this cannot be done" and "this cannot be done yet" are different sentences and the second is the true one.
Five programs: `fn-escape-return.flan`, `fn-escape-param.flan`, `fn-escape-store.flan`, `fn-escape-vec.flan`, and
`fn-capture-set.flan`.
- A `Map` whose values hold a function value (`fn-in-map.flan`): a `Map`'s storage is not walked, so the collector
would free an environment still in it. A `Vec` is walked; a `(CFn ...)` has no environment and may go in a `Map`.
The refusal does not depend on whether the program captures anything, so a program does not start failing when
someone adds a closure elsewhere.
- Under `--no-gc`, a capturing `fn` is a site like a dyn, with its own sentence.
- A bare `Fn` field, global or fixed-array element is still refused for its zero (`fn-in-struct.flan`); that is the
ZII rule and has nothing to do with the environment. `(Option (Fn ...))` is the spelling that holds one.
**Known gaps, not refused.**
- A `Vec` header copied by value goes stale when another copy's push reallocates — that is ordinary `Vec`
behaviour — and the marker still reads the stale header's elements. On freed-but-mapped memory that is a harmless
read of words the set rejects; if the old block was large enough for the allocator to have unmapped it, a
collection there faults. It needs a stale header in a live frame and a collection before that frame ends.
- A value made by an expression the dev daemon evaluates in a module it then unloads carries a code address, and now
an environment descriptor, inside that module. Storing such a value somewhere that outlives the evaluation was
already a dangling code pointer; the descriptor is a second one.
- `wasm32`'s `SizeOf` for a type with pointers in it is x86-64's, so a `Vec` of `Fn` there has a 16-byte stride over
8-byte values. Consistent everywhere it is read, and older than this.
### What may be captured
Anything but a **dyn**. A scalar, a struct and a fixed array copy whole. A string, a slice and a `Vec` or `Map`
header copy as their words, aliasing whatever they pointed at — which is exactly right while the value cannot
outlive the frame that owns the storage, and is exactly what would break under escape. A function value copies as a
function value, environment included; capturing one into another `fn`'s environment is the one place a suspect may
be written into an aggregate, and it is sound because the outer literal is itself suspect, so the pair of
environments lives and dies with one frame.
A **dyn is refused**, for the reason a struct field of dyn already is (`A struct cannot hold a dyn field the
collector would never find`): the collector's roots are frames, and nothing pushes the fields of a synthesised
environment. 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 — and case 3's
collector-allocated environment is where it belongs anyway. `fn-capture-dyn.flan`.
Anything. A scalar, a struct and a fixed array copy whole. A string, a slice and a `Vec` or `Map` header copy as their
words and alias what they point at — the same borrow a struct holding a slice has when it is returned, which the
static side leaves to the program; there is no ownership tracking to refuse it with. A function value copies as a
function value, environment included, and the environment's descriptor names the copy's environment word, so a
closure capturing a closure keeps it alive. A **dyn** copies as a dyn word and the descriptor names it
(`fn-capture-dyn.flan`); the refusal that stood here waited for exactly this descriptor. A handler clause may capture a
dyn for the same reason: its frame slot holding the copies is rooted with the environment struct's descriptor.
### Handlers, which get this for free and have no case 3 to wait for
@ -4327,7 +4342,8 @@ after it, seeing the last iteration's copies — cannot be written: a captured v
### What each backend cost
Very little, which was the point of putting the environment in a frame slot and passing it as an ordinary argument
at the one call that needs it.
at the one call that needs it. (The environment has since moved to the collector's heap; what that cost is in the
escape section above.)
`emit.ml`: a `%fnv` type and a 16-byte layout for `Fn`, `ptr` and eight for `CFn`; an `insertvalue` pair where a
symbol used to stand alone; two `extractvalue`s at a call through an `Fn`; one appended operand on that call and on

2
lib/ast.ml
View File

@ -127,7 +127,7 @@ and expr_kind =
| ArrayFill of len list * expr
| ArrayGen of len list * expr
(* These bind names or alter control flow, so none of them can be a call. *)
| Fn of string list * expr list (* (fn [x y] ...) — non-escaping *)
| Fn of string list * expr list (* (fn [x y] ...) *)
(* (dotimes :o [i n] ...), (dotimes [i start stop] ...) and
(dotimes [i start stop step] ...). The bounds are a record rather than
three positional fields because the one-bound form is the common one and

447
lib/check.ml
View File

@ -681,19 +681,7 @@ let rec capture ctx loc name =
| 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
(* [what] is a descriptor — "an fn", "a handler" — so it reads as the
subject of a sentence and nowhere else. It used to be substituted
into a noun slot as well, which produced "the environment an fn is
handed"; the environment belongs to *this* capture and naming it
twice said less, not more. *)
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 would be a live \
value nothing walks. Pass it in as a parameter, or hold it in a \
global"
what name;
| Some _, Some (outer : binding) ->
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 }
@ -1021,12 +1009,9 @@ 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.
The zero is the whole reason: a capturing value's environment belongs to
the collector and may be kept anywhere, and [(Option (Fn ...))] is how a
field or a global holds one.
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
@ -1155,9 +1140,8 @@ let rec resolve env ?(seen = []) (t : Ast.texpr) : Types.t =
(resolve env ~seen v)
(* (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.
of an [fn] that captures carries the address of an environment the
collector allocated, holding the copies — so the value may go anywhere.
(CFn [T ...] R) is the address alone, one word, and nothing that can
capture — see [Types] for why the C is information rather than
@ -2012,7 +1996,7 @@ let unit_at loc = mk loc Types.Unit Tast.Unit
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 =
let close_over ~heap ~fname (octx : ctx) (fctx : ctx) loc =
match fctx.caught with
| [] -> (fun body -> body), None, None, None
| caught ->
@ -2033,7 +2017,6 @@ let close_over ~fname (octx : ctx) (fctx : ctx) loc =
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,
@ -2042,8 +2025,11 @@ let close_over ~fname (octx : ctx) (fctx : ctx) loc =
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)))
if heap then prefix, Some eslot, None, Some make
else
let mslot = fresh_slot octx ety 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],
@ -3978,15 +3964,13 @@ 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.
**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.
**Capture is by value.** 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 at the instant the value is made (see
[capture] and [close_over]). The environment is allocated by the
collector, so the value is two words, the second of them a heap address,
and it may be returned, stored or pushed like any other value:
spec-memory.md's case 3.
**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
@ -4095,7 +4079,7 @@ and check_fn ctx ~want ?gen loc (params : string list) body =
(* 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
let prefix, fenv, _, copies = close_over ~heap:true ~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
@ -4134,15 +4118,13 @@ and check_fn ctx ~want ?gen loc (params : string list) body =
symbol, and asking for one is how a redefinition module came to reference
a cell nothing declares. *)
let v =
match addr with
match copies 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 ]))
(* The value, carrying the copies it is to be made with. The backend
allocates the environment from the collector and stores them into it,
so the value may go anywhere a function value may: returned, stored,
pushed, kept in a global. *)
| Some copies -> mk loc fty (Tast.Closure (Tast.Flanfn fname, copies))
in
expect ctx loc ~want v
@ -4227,9 +4209,10 @@ and check_handler_bind ctx ?want ?(what = "handler-bind") loc clauses body =
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. *)
alive. So its copies stay on the establishing frame, in
a slot rooted with the environment's descriptor. *)
let prefix, fenv, bind, addr =
close_over ~fname ctx hctx c.Ast.hloc
close_over ~heap:false ~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
@ -11822,8 +11805,82 @@ let value_sites (p : Tast.program) ?(after_fn = fun (_ : Tast.fn) -> ())
(* Over the whole program rather than at each declaration, because the type
that hides a dyn may be declared after the one that names it — and because
a struct nobody ever holds a value of costs nothing either way. *)
(* Does a value of this type hold an (Fn ...) in its own storage — the
function values a collector-allocated environment may hang off. A
pointer and a slice are views of storage checked where it is declared. *)
let rec holds_fn p seen (t : Types.t) =
let go = holds_fn p seen in
match t with
| Types.Fn _ -> true
| Types.Array (_, e) | Types.Vec e | Types.Option e -> go e
| Types.Map (k, v) -> go k || go v
| Types.Named n when not (List.mem n seen) ->
let seen = n :: seen in
let field (fl : Tast.field) = holds_fn p seen fl.Tast.fty in
(match List.find_opt (fun (s : Tast.structure) -> s.Tast.sname = n)
p.Tast.structs with
| Some s -> List.exists field s.Tast.fields
| None ->
match List.find_opt (fun (u : Tast.data) -> u.Tast.dname = n)
p.Tast.datas with
| Some u ->
List.exists
(fun (c : Tast.variant) -> List.exists field c.Tast.vfields)
u.Tast.cases
| None ->
match List.find_opt (fun (u : Tast.structure) -> u.Tast.sname = n)
p.Tast.unions with
| Some u -> List.exists field u.Tast.fields
| None -> false)
| _ -> false
(* The first Map under this type whose values hold a function value. A
closure's environment is found by walking the storage a function value
sits in, and a Map's storage is not walked — so an (Fn ...) there would be
one the collector frees under it. A Vec's is, which is the container to
use; and a (CFn ...) carries no environment and may go in a Map freely. *)
let rec map_of_fn p seen (t : Types.t) : Types.t option =
match t with
| Types.Map (k, v) when holds_fn p [] k || holds_fn p [] v -> Some t
| Types.Array (_, e) | Types.Vec e | Types.Option e
| Types.Ptr e | Types.Slice e -> map_of_fn p seen e
| Types.Map (_, v) -> map_of_fn p seen v
| Types.Named n when not (List.mem n seen) ->
let seen = n :: seen in
let fields =
match List.find_opt (fun (s : Tast.structure) -> s.Tast.sname = n)
p.Tast.structs with
| Some s -> s.Tast.fields
| None ->
match List.find_opt (fun (u : Tast.data) -> u.Tast.dname = n)
p.Tast.datas with
| Some u -> List.concat_map (fun (c : Tast.variant) -> c.Tast.vfields) u.Tast.cases
| None ->
match List.find_opt (fun (u : Tast.structure) -> u.Tast.sname = n)
p.Tast.unions with
| Some u -> u.Tast.fields
| None -> []
in
List.fold_left
(fun acc (fl : Tast.field) ->
match acc with Some _ -> acc | None -> map_of_fn p seen fl.Tast.fty)
None fields
| _ -> None
let dyn_descriptors (p : Tast.program) =
let check loc what (t : Types.t) =
(match map_of_fn p [] t with
| Some at ->
Loc.failk "check/fn-in-map" loc
"%s is %s%s, a Map whose values are function values. A function \
value's environment is found by walking the storage it sits in, \
and a Map's storage is not walked, so the collector would free an \
environment still in use. Keep the function values in a Vec, or \
make them (CFn ...) if they capture nothing"
what (Types.to_string t)
(if Types.equal t at then ""
else Printf.sprintf ", and holds %s" (Types.to_string at))
| None -> ());
(match hidden_dyn p [] t with
| Some at ->
Loc.failk "check/dyn-descriptor" loc
@ -11897,241 +11954,10 @@ 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
(* And then the clean list, which is short, closed, and stated as a list
rather than as a default — a *read* of an [Fn] from anywhere is
suspect unless it is one of these.
It used to be the other way round, with [Field], [CaseField] and
[Deref] named as suspect and everything else clean, and that spelling
had a hole in it exactly where a list like this cannot: an [(at s 0)]
over a slice of [Fn] is a [Prim], so it read as clean while the [Vec]
and pointer spellings of the same thing were refused. Nothing can
write an [Fn] into a slice today, so it was not reachable — but the
header above claims this enumeration is closed, and a default of
[false] is how that claim stops being true without anyone noticing.
What is clean, and why. The address of a name never carried an
environment. A widening carries a thunk and a code pointer, which is
not a frame address. And the result of a call cannot carry one,
because a function that would return one is refused below — that
refusal is what this arm rests on, which is why the two have to be
read together. *)
| Tast.FnAddr _ | Tast.Thicken _ | Tast.Call _ | Tast.CallPtr _ -> false
(* Everything else that can produce an [Fn]: read out of a struct — which
for a function value means read out of an *environment*, the one
aggregate a capture may be written into — out of a case, through a
pointer, or out of a container. 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. *)
| _ -> true)
| _ -> false
(* The environment struct a capture built, which is the one aggregate a
suspect may be written into. See the header. *)
(* The environment struct a capture built. [Session]'s layout guard exempts
these; see there. *)
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.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
(* Everything else is a *read* of a value made elsewhere — a local, a
field, an index, a load through a pointer — and the message that fits
one is the other message, about a value this definition did not make
and cannot see into. The literal is the short list here, exactly as
the clean set is the short list in [escaping]; whichever is short is
the one to write out. *)
| _ -> false
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 one of the two places it
does. *)
List.iter
(fun (slot, v) -> if escaping suspects v then suspects := slot :: !suspects)
bs
(* And the other: an arm's pattern binds the case's fields to slots, and
the store that fills them is inside the branch rather than in a form
this walk reads as a binding. Reading the same field by hand is a
[CaseField] and suspect — a copy of a captured function value carries
whatever environment the original did — so the slot the pattern binds
it to is suspect too, or [(match o (Some f) f ...)] would hand back
through a name what [(case-field o ...)] cannot hand back at all.
Every arm's binds, not only an [Option]'s: a data type's field of
function type is written through [MakeCase], which denies suspects,
and read back through this. *)
| Tast.Match (_, arms) ->
List.iter
(fun (a : Tast.arm) ->
List.iter
(fun s ->
match fn.Tast.slots.(s) with
| Types.Fn _ -> suspects := s :: !suspects
| _ -> ())
a.Tast.binds)
arms
| 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
let decls = Parse.program (Prelude.forms ()) @ decls in
@ -12215,10 +12041,6 @@ 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
@ -12386,7 +12208,7 @@ let expression env ?want (e : Ast.expr) :
let dyn_sites (p : Tast.program) : Loc.diag list =
let found = ref [] in
let add loc what = found := (loc, what) :: !found in
let add loc what = found := (loc, `Dyn what) :: !found in
(* A type that *holds* a dyn and not only the type [dyn] itself. A struct
with a dyn field is a collected value as much as a bare one is, and since
the per-type descriptors it is a value a program can have without any
@ -12413,17 +12235,28 @@ let dyn_sites (p : Tast.program) : Loc.diag list =
&& String.length sym > 8
&& String.sub sym 0 8 = "flan_dyn" ->
add e.Tast.loc (Printf.sprintf "this value in %s" fn.Tast.name)
(* A capturing fn: its environment is a collector allocation,
which is a different sentence from a dyn and has a different
fix. *)
| Tast.Closure _ -> found := (e.Tast.loc, `Closure) :: !found
| _ -> ()))
fn.Tast.body);
List.rev_map
(fun (loc, what) ->
(fun (loc, site) ->
Loc.diag ~kind:"check/no-gc" loc
(Printf.sprintf
"%s holds a dyn, and --no-gc says this program carries no \
collector. A \
dyn value is one the runtime allocates and the collector owns, so \
there is nothing smaller to compile it to — write the type"
what))
(match site with
| `Dyn what ->
Printf.sprintf
"%s holds a dyn, and --no-gc says this program carries no \
collector. A \
dyn value is one the runtime allocates and the collector owns, \
so there is nothing smaller to compile it to — write the type"
what
| `Closure ->
"this fn captures, and --no-gc says this program carries no \
collector. The copies a capturing fn is made with live in an \
environment the collector allocates — pass what it names in as \
parameters instead"))
!found
let no_gc (p : Tast.program) =
@ -12582,19 +12415,25 @@ let memory_sites ?file (p : Tast.program) : Loc.diag list =
let found = ref [] in
let seen = Hashtbl.create 64 in
let look (e : Tast.expr) =
match e.Tast.e with
| Tast.Prim (Tast.Rt sym, args) ->
(match memory_class sym args with
| None -> ()
| Some (kind, msg) ->
let loc = e.Tast.loc in
let key = (loc.Loc.file, loc.Loc.line, loc.Loc.col, kind) in
if (match file with None -> true | Some f -> String.equal f loc.Loc.file)
&& not (Hashtbl.mem seen key) then begin
Hashtbl.replace seen key ();
found := Loc.diag ~kind loc msg :: !found
end)
| _ -> ()
let cls =
match e.Tast.e with
| Tast.Prim (Tast.Rt sym, args) -> memory_class sym args
| Tast.Closure _ ->
Some ("memory/gc",
"allocates: an fn that captures keeps its copies in an \
environment on the collector's heap")
| _ -> None
in
match cls with
| None -> ()
| Some (kind, msg) ->
let loc = e.Tast.loc in
let key = (loc.Loc.file, loc.Loc.line, loc.Loc.col, kind) in
if (match file with None -> true | Some f -> String.equal f loc.Loc.file)
&& not (Hashtbl.mem seen key) then begin
Hashtbl.replace seen key ();
found := Loc.diag ~kind loc msg :: !found
end
in
(* A global's initialiser runs at startup and allocates there as much as a
body does — [(defonce names (vec-new dyn))] is a heap object before main

427
lib/emit.ml
View File

@ -388,6 +388,34 @@ let dfile d path =
let align_up x a = if a <= 1 then x else ((x + a - 1) / a) * a
(* One word inside an instance that the collector follows, located twice.
[goff] is the byte offset under [lay]'s numbers, which are x86-64's and are
what the hand-written backend writes. [gpath] is the same place as a walk
an LLVM [getelementptr] can take — each step a type and its indices — so
the LLVM backend can write the offset as a constant expression and let the
target's own layout answer it. That is the difference on wasm32, where a
pointer is four bytes and [goff] would name the wrong word. *)
type gcword = { goff : int; gpath : (string * string list) list }
(* Every word of an instance the collector follows, by kind — the three
tables of runtime/flan_dyn.h's [flan_desc]. [gvec] carries each Vec's
element type, whose own descriptor the entry points at. *)
type gclayout = {
gdyn : gcword list;
genv : gcword list;
gvec : (gcword * Types.t) list;
}
(* A descriptor this module has to write out: its symbol, the words, the
instance size, and the symbol of each Vec entry's element descriptor in
[gvec]'s order. *)
type desc = {
dsym : string;
dlay : gclayout;
dsize : int;
dvecs : string list;
}
(* ── Module-level state ────────────────────────────────────────────── *)
type m = {
@ -410,6 +438,15 @@ type m = {
externs : (string, string) Hashtbl.t;
checks : bool; (* emit bounds checks *)
dev : bool; (* call through cells (below) *)
(* Whether an [(Fn ...)] value may carry an environment the collector owns,
which is what makes its second word something to root and to mark. True
when the program makes a capturing [fn] anywhere, and always in a dev
build — a redefinition can add the first one, and the frames of the
running program would then hold function values nobody had rooted. When
it is false every [Fn] word is a code address or null and the output is
byte for byte what it was before closures could escape: the static side
does not pay for the dynamic one. See [gc_layout]. *)
gcfn : bool;
(* Was this name in the build the running process came from? False only in a
redefinition module, and only for a name introduced since. *)
known : string -> bool;
@ -461,7 +498,7 @@ type m = {
and no value of any type points at one. A redefinition module naming a
type the base program already named therefore gets its own copy, which is
harmless — a descriptor is read-only and has no identity. *)
descs : (string, string * int list * int) Hashtbl.t;
descs : (string, desc) Hashtbl.t;
}
(* The attribute group every emitted function names, empty unless sanitizing.
@ -679,20 +716,198 @@ let desc_mangle (t : Types.t) =
order is deterministic. Private or local in both backends, so a redefinition
module naming the same type as the program it patches is not a duplicate
symbol. *)
let desc_of m (t : Types.t) : string option =
match dyn_offsets m t with
| [] -> None
| offs ->
let rec desc_of m (t : Types.t) : string option =
let l = gc_layout m t in
if l.gdyn = [] && l.genv = [] && l.gvec = [] then None
else
let key = Types.to_string t in
match Hashtbl.find_opt m.descs key with
| Some (sym, _, _) -> Some sym
| Some d -> Some d.dsym
| None ->
let sym =
Printf.sprintf "flan.desc.%s.%d" (desc_mangle t) (Hashtbl.length m.descs)
in
Hashtbl.replace m.descs key (sym, offs, fst (lay m t));
(* Claimed before the elements are asked for, so the counter a nested
element's symbol takes cannot be this one's. *)
Hashtbl.replace m.descs key
{ dsym = sym; dlay = l; dsize = fst (lay m t); dvecs = [] };
let dvecs =
List.map
(fun (_, e) ->
match desc_of m e with
| Some s -> s
| None -> internal "a Vec entry whose element has no words")
l.gvec
in
Hashtbl.replace m.descs key
{ dsym = sym; dlay = l; dsize = fst (lay m t); dvecs };
Some sym
(* ── The words the collector follows ─────────────────────────────────
What [dyn_offsets] answers, widened by the two words closures added: the
environment half of an [(Fn ...)] value, and a [(Vec T)] whose elements hold
one. Both only when [m.gcfn] — a program that never makes a capturing [fn]
has no environment anywhere for the collector to find, so its [Fn] values
are code addresses and null and are rooted by nothing, exactly as before.
The dyn words are gathered where [dyn_offsets] gathers them and nowhere
else: a dyn inside an [Option], a data type's payload, a union or a Vec is
refused by [Check.hidden_dyn], so there is nothing more to find.
The environment words are gathered through all of those as well. An
[(Option (Fn ...))] is how a struct field or a global holds a function
value — a bare one would be zeroed — and a data type or a union overlays
its cases, so which bytes are a function value depends on a tag this table
cannot read. Naming every case's word is sound here, and would not be for
a dyn, because the collector never reads *through* an environment word it
did not allocate: it asks its own set first (runtime/flan_dyn.c's
[mark_env]). The word of a case that is not the live one is an integer or
half of something else, it is not in the set, and it is passed over.
Duplicates are kept apart by path, not by offset. Two cases can put a word
at the same x86-64 offset and at different wasm32 ones, and marking a word
twice costs nothing. *)
and gc_layout m (t : Types.t) : gclayout =
let dyn = ref [] and env = ref [] and vec = ref [] in
let step ty idx path = path @ [ (ty, idx) ] in
let rec go ~full seen off path (t : Types.t) =
match t with
| Types.Dyn -> if full then dyn := { goff = off; gpath = path } :: !dyn
| Types.Fn _ when m.gcfn ->
env := { goff = off + 8; gpath = step "%fnv" [ "i32 0"; "i32 1" ] path }
:: !env
(* Asked with [reaches_fn] and not by laying the element out: a data type
may hold a Vec of itself, and the element's own descriptor, which
[desc_of] claims before it recurses, is what closes that loop. *)
| Types.Vec e when m.gcfn ->
if reaches_fn m [] e then vec := ({ goff = off; gpath = path }, e) :: !vec
| Types.Array (n, e) ->
let s, _ = lay m e in
for i = 0 to Int64.to_int n - 1 do
go ~full seen (off + (i * s))
(step (ll t) [ "i32 0"; Printf.sprintf "i64 %d" i ] path) e
done
| Types.Option e when m.gcfn ->
let _, _, offs = lay_fields m [ Types.Int Types.I8; e ] in
go ~full:false seen (off + List.nth offs 1)
(step (ll t) [ "i32 0"; "i32 1" ] path) e
| Types.Named nm when not (List.mem nm seen) ->
let seen = nm :: seen in
(match Hashtbl.find_opt m.structs nm with
| Some st ->
let tys = List.map (fun (fl : Tast.field) -> fl.Tast.fty) st.Tast.fields in
let _, _, offs = lay_fields m tys in
List.iteri
(fun i (ty, o) ->
go ~full seen (off + o)
(step (sname nm) [ "i32 0"; Printf.sprintf "i32 %d" i ] path) ty)
(List.combine tys offs)
| None when not m.gcfn -> ()
| None ->
match Hashtbl.find_opt m.datas nm with
| Some u ->
let size, align = payload_lay m u in
if size > 0 then begin
let _, _, poffs =
lay_fields m
[ Types.Int Types.I32;
Types.Array (Int64.of_int (size / align),
Types.Int (int_kind (align * 8))) ]
in
let poff = off + List.nth poffs 1 in
let ppath = step (sname nm) [ "i32 0"; "i32 1" ] path in
List.iter
(fun (c : Tast.variant) ->
let tys =
List.map (fun (fl : Tast.field) -> fl.Tast.fty) c.Tast.vfields
in
let _, _, offs = lay_fields m tys in
List.iteri
(fun i (ty, o) ->
go ~full:false seen (poff + o)
(step (sname (nm ^ "." ^ c.Tast.vname))
[ "i32 0"; Printf.sprintf "i32 %d" i ] ppath) ty)
(List.combine tys offs))
u.Tast.cases
end
| None ->
match Hashtbl.find_opt m.unions nm with
| Some u ->
(* Every member starts where the union does, so the walk goes on
from the same place with the member's own type. *)
List.iter
(fun (fl : Tast.field) -> go ~full:false seen off path fl.Tast.fty)
u.Tast.fields
| None -> ())
| _ -> ()
in
go ~full:true [] 0 [] t;
let order (a : gcword) (b : gcword) =
match compare a.goff b.goff with 0 -> compare a.gpath b.gpath | c -> c
in
let uniq l = List.sort_uniq order l in
{ gdyn = uniq !dyn; genv = uniq !env;
gvec = List.sort_uniq (fun (a, _) (b, _) -> order a b) !vec }
(* Whether an [(Fn ...)] is anywhere in a value's storage, a Vec's elements
included. A type met again on the way contributes nothing more, which
terminates a data type holding a Vec of itself without losing a function
value found along another path. *)
and reaches_fn m seen (t : Types.t) =
match t with
| Types.Fn _ -> true
| Types.Array (_, e) | Types.Vec e | Types.Option e -> reaches_fn m seen e
| Types.Named nm when not (List.mem nm seen) ->
let seen = nm :: seen in
let fields =
match Hashtbl.find_opt m.structs nm with
| Some st -> st.Tast.fields
| None ->
match Hashtbl.find_opt m.datas nm with
| Some u -> List.concat_map (fun (c : Tast.variant) -> c.Tast.vfields) u.Tast.cases
| None ->
match Hashtbl.find_opt m.unions nm with
| Some u -> u.Tast.fields
| None -> []
in
List.exists (fun (fl : Tast.field) -> reaches_fn m seen fl.Tast.fty) fields
| _ -> false
(* Whether the collector has anything to follow in a value of this type —
the question every rooting decision asks. [dyn_offsets <> []] was that
question until an [Fn] could hold an environment. *)
let traced m (t : Types.t) =
t = Types.Dyn
|| (let l = gc_layout m t in l.gdyn <> [] || l.genv <> [] || l.gvec <> [])
(* The words to clear before an instance at a pushed root can be marked, as
x86-64 byte offsets of eight-byte words: each dyn word, each environment
word, and each Vec header's pointer and length. The LLVM backend walks
[gpath] instead; see [zero_words]. *)
let gc_zero_offsets m (t : Types.t) : int list =
if t = Types.Dyn then [ 0 ]
else
let l = gc_layout m t in
List.map (fun w -> w.goff) l.gdyn
@ List.map (fun w -> w.goff) l.genv
@ List.concat_map (fun (w, _) -> [ w.goff; w.goff + 8 ]) l.gvec
(* A [gpath] as an LLVM constant expression over [base]: nested constant
[getelementptr]s, one per step. Over [ptr null] and through [ptrtoint] it
is the word's byte offset on whatever target the module is compiled for. *)
let path_const base path =
List.fold_left
(fun acc (ty, idx) ->
Printf.sprintf "getelementptr (%s, ptr %s, %s)" ty acc
(String.concat ", " idx))
base path
let offset_const (w : gcword) =
match w.gpath with
| [] -> "0"
| p -> Printf.sprintf "ptrtoint (ptr %s to i64)" (path_const "null" p)
(* A DWARF type node for a Flan type, memoised by the type's printed form so
the pool holds one node per distinct type. *)
let rec dty m d (t : Types.t) : int =
@ -1252,7 +1467,7 @@ type rootplan = {
it needs nothing, and neither backend evaluates one through either hook. *)
let held_operands m (e : Tast.expr) : Tast.expr list =
let holds (x : Tast.expr) =
(x.Tast.ty = Types.Dyn || dyn_offsets m x.Tast.ty <> [])
traced m x.Tast.ty
&& (match x.Tast.e with
| Tast.Call _ | Tast.CallPtr _ -> false
| Tast.Prim (Tast.Rt _, _) -> x.Tast.ty <> Types.Dyn
@ -1301,11 +1516,11 @@ let root_plan m (fn : Tast.fn) : rootplan =
let rslots = ref [] in
Array.iteri
(fun i t ->
if t = Types.Dyn || dyn_offsets m t <> [] then
if traced m t then
rslots := (i, t) :: !rslots)
fn.Tast.slots;
let dyn = ref 0 and agg = ref [] in
let want (t : Types.t) = t <> Types.Dyn && dyn_offsets m t <> [] in
let want (t : Types.t) = t <> Types.Dyn && traced m t in
(* The pinned operands first, as a set of nodes. The checker shares a node
between two positions now and then — the same [Local] read in two places
— and the backends spill by identity, so a node pinned in one position is
@ -2049,7 +2264,26 @@ and value_at f (e : Tast.expr) : string =
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 copies, made here as a struct value and stored into an
environment the collector allocates. Built before the allocation:
every field is a read of a slot, and those slots are still rooted
while the allocation collects. The fresh object is in the
runtime's allocation ring until this value reaches a root. *)
| Tast.Closure (r, copies) ->
let v = value f copies in
let ety = copies.Tast.ty in
let desc =
match desc_of f.md ety with
| Some s -> Printf.sprintf "@\"%s\"" s
| None -> "null"
in
let p = fresh f in
ins f
"%s = call ptr @flan_dyn_env_new(i64 ptrtoint (ptr getelementptr (%s, \
ptr null, i32 1) to i64), ptr %s)"
p (ll ety) desc;
ins f "store %s %s, ptr %s" (ll ety) v p;
fnaddr f r, p
(* 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. *)
@ -2288,7 +2522,7 @@ and addr f (e : Tast.expr) : string =
unrooted copy. [root_plan] counts exactly these two callers. *)
and addr_rooted f (e : Tast.expr) : string =
if addr_is_place e || e.Tast.ty = Types.Dyn
|| dyn_offsets f.md e.Tast.ty = [] then addr f e
|| not (traced f.md e.Tast.ty) then addr f e
else begin
let tmp = agg_tmp f e.Tast.ty in
let v = value f e in
@ -2554,7 +2788,7 @@ and call_through f ?env ret callee vs =
let slot = dyn_tmp f in
ins f "store i64 %s, ptr %s" t slot
end
else if dyn_offsets f.md ret <> [] then begin
else if traced f.md ret then begin
let slot = agg_tmp f ret in
ins f "store %s %s, ptr %s" (ll ret) t slot
end;
@ -3595,22 +3829,39 @@ let emit_fn m ?(hidden = false) ?(pnames = []) (fn : Tast.fn) =
in
if nroots > 0 then begin
let nparams = List.length fn.Tast.params in
(* Zeroing the dyn words at [base], which is the whole of the contract
runtime/flan_dyn.h states for a pushed root. *)
(* Zeroing the words the collector reads at [base], which is the whole of
the contract runtime/flan_dyn.h states for a pushed root: each dyn
word, each environment word, and each Vec header's pointer and length.
Reached through the word's [gpath], so the store lands where the
target lays the word out and not where x86-64 would. *)
let zero_dyn base (ty : Types.t) =
if ty = Types.Dyn then
Buffer.add_string f.allocas (Printf.sprintf " store i64 0, ptr %s\n" base)
else
else begin
let at path =
List.fold_left
(fun acc (sty, idx) ->
let p = Printf.sprintf "%%z%d" f.n in
f.n <- f.n + 1;
Buffer.add_string f.allocas
(Printf.sprintf " %s = getelementptr inbounds %s, ptr %s, %s\n"
p sty acc (String.concat ", " idx));
p)
base path
in
let store what path =
Buffer.add_string f.allocas
(Printf.sprintf " store %s, ptr %s\n" what (at path))
in
let l = gc_layout m ty in
List.iter (fun w -> store "i64 0" w.gpath) l.gdyn;
List.iter (fun w -> store "ptr null" w.gpath) l.genv;
List.iter
(fun off ->
let p = Printf.sprintf "%%z%d" f.n in
f.n <- f.n + 1;
Buffer.add_string f.allocas
(Printf.sprintf " %s = getelementptr inbounds i8, ptr %s, i64 %d\n"
p base off);
Buffer.add_string f.allocas
(Printf.sprintf " store i64 0, ptr %s\n" p))
(dyn_offsets m ty)
(fun ((w : gcword), _) ->
store "ptr null" (w.gpath @ [ ("%vec", [ "i32 0"; "i32 0" ]) ]);
store "i64 0" (w.gpath @ [ ("%vec", [ "i32 0"; "i32 1" ]) ]))
l.gvec
end
in
let push base (ty : Types.t) =
match (if ty = Types.Dyn then None else desc_of m ty) with
@ -4278,6 +4529,7 @@ declare i64 @flan_dyn_view_vec(ptr, i32)
declare i64 @flan_dyn_view_flat(ptr, i64, i32)
declare void @flan_dyn_root_push(ptr)
declare void @flan_dyn_root_push_desc(ptr, ptr)
declare ptr @flan_dyn_env_new(i64, ptr)
declare void @flan_dyn_root_pop(i64)
declare void @flan_dyn_root_globals_begin()
declare void @flan_dyn_root_globals_end()
@ -4356,7 +4608,23 @@ declare i8 @flan_slurp_into(ptr, ptr, i64, i64, ptr, i64)
Every shape a dyn can take is one of these: a global of that type, a
signature that mentions it, a slot that holds one, or an expression that
produces one. *)
let makes_closures (p : Tast.program) =
let found = ref false in
let see (e : Tast.expr) =
match e.Tast.e with Tast.Closure _ -> found := true | _ -> ()
in
List.iter
(fun (fn : Tast.fn) ->
List.iter (Tast.walk see) fn.Tast.body;
List.iter (Tast.walk see) fn.Tast.fdefers)
p.Tast.fns;
List.iter (fun (g : Tast.global) -> Tast.walk see g.Tast.ginit) p.Tast.globals;
!found
(* A program that makes a capturing [fn] allocates its environments from the
collector, so it has a heap to set up even if no dyn is ever written. *)
let uses_dyn (p : Tast.program) =
makes_closures p ||
let structs = Hashtbl.create 16 in
List.iter
(fun (s : Tast.structure) -> Hashtbl.replace structs s.Tast.sname s)
@ -4532,7 +4800,8 @@ let new_module ~checks ~dev ~known ?(debug = false) ?(sanitize = false)
unions = Hashtbl.create 16;
globals = Hashtbl.create 16;
externs = Hashtbl.create 32;
checks; dev; known; nstr = 0; nfi = 0; sanitize;
checks; dev; gcfn = dev || makes_closures p;
known; nstr = 0; nfi = 0; sanitize;
descs = Hashtbl.create 8;
dbg = (if debug then Some (new_dbg p) else None);
} in
@ -4634,35 +4903,61 @@ let dmodule d =
Buffer.add_buffer b d.dout;
Buffer.contents b
(* The per-type dyn descriptors, as runtime/flan_dyn.h's [flan_desc] laid out
by hand: two i64s and a pointer to the offset table. [private] because a
redefinition module may name a type the program it patches already named,
and a private constant has no symbol for the two to collide over. Sorted, so
the .ll is reproducible build to build. *)
(* The per-type descriptors, as runtime/flan_dyn.h's [flan_desc] laid out by
hand: the size, then a count and a table for each of the three kinds of
word. An empty table is a null pointer rather than a zero-length array.
[private] because a redefinition module may name a type the program it
patches already named, and a private constant has no symbol for the two to
collide over. Sorted, so the .ll is reproducible build to build.
Every offset is a constant expression over the word's [gpath] rather than
a number, so the offset is the one the target lays the type out with — on
wasm32 a pointer is four bytes, and [goff]'s x86-64 number would name the
wrong word. [size] stays [lay]'s number: it is only read as a Vec's
element stride, and a Vec's elements are placed at that stride by the
[SizeOf] every push is handed. *)
let descriptors m =
let b = Buffer.create 256 in
let table sym suffix ty rows =
if rows = [] then "null"
else begin
Buffer.add_string b
(Printf.sprintf "@\"%s.%s\" = private unnamed_addr constant [%d x %s] [%s]\n"
sym suffix (List.length rows) ty (String.concat ", " rows));
Printf.sprintf "@\"%s.%s\"" sym suffix
end
in
let word (w : gcword) = "i64 " ^ offset_const w in
Hashtbl.fold (fun k v acc -> (k, v) :: acc) m.descs []
|> List.sort (fun (a, _) (c, _) -> String.compare a c)
|> List.iter
(fun (_, (sym, offs, size)) ->
(fun (_, d) ->
let l = d.dlay in
let offs = table d.dsym "offs" "i64" (List.map word l.gdyn) in
let envs = table d.dsym "envs" "i64" (List.map word l.genv) in
let vecs =
table d.dsym "vecs" "{ i64, ptr }"
(List.map2
(fun ((w : gcword), _) e ->
Printf.sprintf "{ i64, ptr } { i64 %s, ptr @\"%s\" }"
(offset_const w) e)
l.gvec d.dvecs)
in
Buffer.add_string b
(Printf.sprintf
"@\"%s.offs\" = private unnamed_addr constant [%d x i64] [%s]\n"
sym (List.length offs)
(String.concat ", "
(List.map (Printf.sprintf "i64 %d") offs)));
Buffer.add_string b
(Printf.sprintf
"@\"%s\" = private unnamed_addr constant { i64, i64, ptr } \
{ i64 %d, i64 %d, ptr @\"%s.offs\" }\n"
sym size (List.length offs) sym));
"@\"%s\" = private unnamed_addr constant \
{ i64, i64, ptr, i64, ptr, i64, ptr } \
{ i64 %d, i64 %d, ptr %s, i64 %d, ptr %s, i64 %d, ptr %s }\n"
d.dsym d.dsize (List.length l.gdyn) offs (List.length l.genv)
envs (List.length l.gvec) vecs));
Buffer.contents b
(* The same table in the other backend's syntax. It lives here rather than in
x86.ml so that the two renderings sit beside each other and the layout the
runtime reads is agreed in one place. [.L] so the labels never reach the
symbol table, which is what lets a redefinition module name a type the
program it patches already named. *)
program it patches already named. The offsets are [goff]'s numbers, which
are this backend's own layout. *)
let descriptors_asm m =
let b = Buffer.create 256 in
let rows =
@ -4671,10 +4966,11 @@ let descriptors_asm m =
in
if rows <> [] then
Buffer.add_string b
"\n# The per-type dyn descriptors — runtime/flan_dyn.h's flan_desc: the\n\
# size of one instance, how many dyn words it holds, and where they are.\n\
# Read by the collector through flan_dyn_root_push_desc and by nothing\n\
# else; no value points at one.\n\
"\n# The per-type descriptors — runtime/flan_dyn.h's flan_desc: the size\n\
# of one instance, then the dyn words, the environment words of its\n\
# function values, and the Vec headers whose elements hold either, each\n\
# as a count and a table. Read by the collector through\n\
# flan_dyn_root_push_desc and flan_dyn_env_new and by nothing else.\n\
#\n\
# .data.rel.ro and not .rodata, because a descriptor holds the address\n\
# of its own offset table. That is a relocation, and a relocation in a\n\
@ -4684,20 +4980,41 @@ let descriptors_asm m =
# for exactly this: relocated at load and read-only from then on.\n\
\t.section\t.data.rel.ro,\"aw\",@progbits\n";
List.iter
(fun (_, (sym, offs, size)) ->
Buffer.add_string b (Printf.sprintf "\t.align\t8\n.L%s.offs:\n" sym);
List.iter
(fun o -> Buffer.add_string b (Printf.sprintf "\t.quad\t%d\n" o))
offs;
(fun (_, d) ->
let l = d.dlay in
let table suffix lines =
if lines = [] then "0"
else begin
Buffer.add_string b
(Printf.sprintf "\t.align\t8\n.L%s.%s:\n" d.dsym suffix);
List.iter (fun s -> Buffer.add_string b ("\t.quad\t" ^ s ^ "\n")) lines;
Printf.sprintf ".L%s.%s" d.dsym suffix
end
in
let offs = table "offs" (List.map (fun w -> string_of_int w.goff) l.gdyn) in
let envs = table "envs" (List.map (fun w -> string_of_int w.goff) l.genv) in
let vecs =
table "vecs"
(List.concat
(List.map2
(fun ((w : gcword), _) e -> [ string_of_int w.goff; ".L" ^ e ])
l.gvec d.dvecs))
in
Buffer.add_string b
(Printf.sprintf
"\t.align\t8\n.L%s:\n\t.quad\t%d\n\t.quad\t%d\n\t.quad\t.L%s.offs\n"
sym size (List.length offs) sym))
"\t.align\t8\n.L%s:\n\t.quad\t%d\n\t.quad\t%d\n\t.quad\t%s\n\
\t.quad\t%d\n\t.quad\t%s\n\t.quad\t%d\n\t.quad\t%s\n"
d.dsym d.dsize (List.length l.gdyn) offs (List.length l.genv) envs
(List.length l.gvec) vecs))
rows;
Buffer.contents b
(* The descriptors go after the body, because their offsets are constant
expressions over the module's named types and LLVM wants a type defined
before a [getelementptr] can size it. A global may be named before it is
defined, so the functions that push them are unaffected. *)
let finish m =
header ^ Buffer.contents m.strs ^ descriptors m ^ "\n" ^ Buffer.contents m.out
header ^ Buffer.contents m.strs ^ Buffer.contents m.out ^ "\n" ^ descriptors m
^ (if m.sanitize then "\nattributes #0 = { sanitize_address }\n" else "")
^ (match m.dbg with None -> "" | Some d -> dmodule d)
@ -4869,7 +5186,7 @@ let program ?(checks = true) ?(dev = false) ?(debug = false) ?(pnames = [])
~dyn_globals:
(List.filter_map
(fun (g : Tast.global) ->
if g.Tast.gty = Types.Dyn || dyn_offsets m g.Tast.gty <> []
if traced m g.Tast.gty
then Some (g.Tast.gname, g.Tast.gty) else None)
p.Tast.globals)
fn

17
lib/session.ml
View File

@ -383,13 +383,16 @@ let compatible ?(origin = fun _ -> None) ?(relaxed = []) ~loc
(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. *)
about values the running program reads with code newer than the code
that wrote them. An environment is only ever read by the lifted body
that was compiled beside the literal that made it: a function value
carries that body's own symbol, not a cell, and a redefinition module
carries its own copy of every lifted body it replaces. A value made
before the reload keeps calling the old body over the old layout —
and each environment carries the descriptor it was allocated with —
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

20
lib/tast.ml
View File

@ -112,22 +112,18 @@ 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.
(* A function value with an environment: the lifted body, and the copies it
is made with — a [Make] of a struct the checker synthesised, one field per
captured name, every field a read of a local. The backend allocates the
environment from the collector ([flan_dyn_env_new], with the struct's
descriptor), stores the copies into it, and pairs its address with the
code. So the copies are taken where the value is made, and the value may
outlive the frame: spec-memory.md's case 3.
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. *)
while this is a *value* of type [Fn] and can never be anything else. *)
| 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

36
lib/x86.ml
View File

@ -480,7 +480,8 @@ let layout_ctx ~checks ~dev (p : Tast.program) : Emit.m =
p.Tast.globals;
{ Emit.out = Buffer.create 1; strs = Buffer.create 1; structs; datas; unions;
globals; externs = Hashtbl.create 1; checks;
dev; known = (fun _ -> true); dbg = None; sanitize = false;
dev; gcfn = dev || Emit.makes_closures p;
known = (fun _ -> true); dbg = None; sanitize = false;
nstr = 0; nfi = 0; descs = Hashtbl.create 8 }
let sizeof md t = fst (Emit.lay md t)
@ -1770,17 +1771,36 @@ and lower_at f (e : Tast.expr) (dst : loc) : unit =
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 environment first, into a frame temporary: allocated by the
collector, then filled with the copies — every field a read of a
slot, so nothing between the allocation and the last store can
collect. The object is in the runtime's allocation ring until the
value reaches a root. *)
| Tast.Closure (r, copies) ->
let ety = copies.Tast.ty in
let p = ptmp f in
imm_into f ~reg:rdi (Int64.of_int (sizeof f.md ety));
(match desc_label f.md ety with
| Some l -> lea f.b ~dst:rsi ~mm:(Sym (l, 0))
| None -> xor_rr f.b ~dst:rsi ~src:rsi);
xor_rr f.b ~dst:rax ~src:rax;
call_sym f.b "flan_dyn_env_new";
store_int f.b ~src:rax ~mm:(Frame p) ~size:8;
lower f copies (Lp (p, 0));
fnaddr f ~reg:rax r;
Some (`Made p)
(* 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
| Tast.Thicken (n, p) -> addr_sym f ~dst:rax (fsym n); Some (`Expr 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));
| Some (`Made p) -> load_int f.b ~dst:rax ~mm:(Frame p) ~size:8 ~signed:false
| Some (`Expr 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;
@ -2445,7 +2465,7 @@ and lvalue f (e : Tast.expr) : loc =
decided how many of these slots to mint asked that same function. *)
and lvalue_rooted f (e : Tast.expr) : loc =
if Emit.addr_is_place e || e.Tast.ty = Types.Dyn
|| Emit.dyn_offsets f.md e.Tast.ty = [] then lvalue f e
|| not (Emit.traced f.md e.Tast.ty) then lvalue f e
else begin
let o = agg_tmp f e.Tast.ty in
lower f e (Lf o);
@ -2979,7 +2999,7 @@ and call_flan f ?env ~target ~args ~rty dst =
let o = dyn_tmp f in
store_int f.b ~src:rax ~mm:(Frame o) ~size:8
end
else if (not (is_void rty)) && Emit.dyn_offsets f.md rty <> [] then begin
else if (not (is_void rty)) && Emit.traced f.md rty then begin
let o = agg_tmp f rty in
copy_loc f ~dst:(Lf o) ~src:dst (sizeof f.md rty)
end
@ -3888,7 +3908,7 @@ let emit_fn (md : Emit.m) ~externs ~fns ?(ext = fun _ -> false)
else
List.iter
(fun d -> store_int f.b ~src:rax ~mm:(Frame (off + d)) ~size:8)
(Emit.dyn_offsets f.md ty))
(Emit.gc_zero_offsets f.md ty))
!droot_zero;
List.iter
(fun (off, ty) ->
@ -4853,7 +4873,7 @@ let program ~checks ?(dev = false) ?(debug = false) ?(annotate = false)
~dyn_globals:
(List.filter_map
(fun (g : Tast.global) ->
if g.Tast.gty = Types.Dyn || Emit.dyn_offsets md g.Tast.gty <> []
if Emit.traced md g.Tast.gty
then Some (g.Tast.gname, g.Tast.gty) else None)
p.Tast.globals)
md fn)

216
runtime/flan_dyn.c
View File

@ -111,15 +111,40 @@ int8_t flan_vec_push(void *v, const void *elem, int64_t size, int64_t align,
typedef uint64_t flan_dyn;
/* A type's dyn map: where the dyn words are inside one instance of it. The
* compiler emits one of these per type that has any, as static data, and hands
* a pointer to it to [flan_dyn_root_push_desc]. Nothing here ever writes one.
* [size] is not read by the collector; it is the stride an array of the type
* has, which is what the typed-container view will need. */
/* A type's map of the words the collector follows: where they are inside one
* instance of it. The compiler emits one of these per type that has any, as
* static data, and hands a pointer to it to [flan_dyn_root_push_desc] or
* [flan_dyn_env_new]. Nothing here ever writes one.
*
* Three kinds of word, one table each:
*
* - [offs]: a dyn word, marked by [mark_value].
* - [envs]: the environment half of an (Fn ...) value, pointer-sized. It holds
* a collector-allocated environment, null, or — for a named function widened
* into an Fn — that function's code address. [mark_env] follows only the
* first, and tells them apart by asking [envset] rather than by reading the
* word, so a code address is never dereferenced.
* - [vecs]: a (Vec T) header whose elements hold words of their own, with the
* element's descriptor. The marker reads the header's pointer and length
* where they are, so a push that reallocated is seen.
*
* [size] is the stride of one instance as the compiler's element-size
* arithmetic counts it, which is what a Vec's elements are laid out at. The
* collector reads it only through a [vecs] entry's element descriptor. */
struct flan_desc;
typedef struct flan_desc_vec {
int64_t off;
const struct flan_desc *elem;
} flan_desc_vec;
typedef struct flan_desc {
int64_t size;
int64_t n;
const int64_t *offs;
int64_t size;
int64_t n;
const int64_t *offs;
int64_t nenv;
const int64_t *envs;
int64_t nvec;
const flan_desc_vec *vecs;
} flan_desc;
#define DYN_QNAN 0xFFF8000000000000ULL
@ -188,6 +213,10 @@ static inline flan_dyn dyn_make(unsigned tag, uint64_t payload) {
#define OBJ_INT 2 /* an i64 too wide for the payload */
#define OBJ_MAP 3 /* keys and values interleaved: k0 v0 k1 v1 ... */
#define OBJ_VIEW 4 /* a typed container crossing into dyn as a view */
#define OBJ_ENV 5 /* a closure's environment: bytes after the header,
marked through the descriptor it was made with.
Never a dyn value — nothing boxes one — so no tag
word, printer or operation ever sees this kind. */
/* flan_vec, restated. This file must not name flan_rt.c's [flan_vec] — see
* the "if either table changes, change both" note above [flan_vec_push] —
@ -295,6 +324,10 @@ typedef struct flan_obj {
at the crossing, for a slice or a fixed array, neither of which moves.
[elem] is one of FLAN_VIEW_I64/F64/BOOL. */
struct { void *base; int64_t len; int32_t elem; int32_t is_vec; } view;
/* OBJ_ENV: the descriptor the environment's bytes are marked through,
or NULL when it holds nothing the collector follows. [len] is the
byte count, and the bytes trail the header as a text's do. */
struct { const struct flan_desc *desc; } env;
/* OBJ_TEXT's bytes trail the header; see [obj_text_bytes]. */
} u;
} flan_obj;
@ -311,7 +344,7 @@ typedef struct flan_obj {
* is what keeps a future change to the marking gate from silently trusting
* this function's default arm instead of failing loudly. */
static inline int64_t obj_words(flan_obj *o) {
if (o->kind == OBJ_VIEW) return 0;
if (o->kind == OBJ_VIEW || o->kind == OBJ_ENV) return 0;
return o->kind == OBJ_MAP ? o->len * 2 : o->len;
}
@ -966,9 +999,11 @@ static int64_t mstack_n, mstack_cap;
static void mark_push(flan_obj *o) {
if (o == NULL || o->mark) return;
o->mark = 1;
/* Only a vec and a map have anything to trace. A text and a boxed int are
* leaves, and marking them is the whole of their visit. */
if (o->kind != OBJ_VEC && o->kind != OBJ_MAP) return;
/* Only a vec, a map and an environment with a descriptor have anything to
* trace. A text and a boxed int are leaves, and marking them is the whole
* of their visit. */
if (o->kind != OBJ_VEC && o->kind != OBJ_MAP
&& !(o->kind == OBJ_ENV && o->u.env.desc != NULL)) return;
if (mstack_n == mstack_cap) {
int64_t cap = mstack_cap ? mstack_cap * 2 : 64;
flan_obj **m = (flan_obj **)realloc(mstack, (size_t)cap * sizeof *m);
@ -983,22 +1018,143 @@ static void mark_value(flan_dyn v) {
if (dyn_boxed(v) && dyn_box(v) == BOX_OBJ) mark_push(dyn_obj(v));
}
/* ── Environments ──────────────────────────────────────────────────────
*
* The second word of an (Fn ...) value is one of three things: null, for a
* value made from a name or from an fn that captured nothing; the address of
* an environment this file allocated; or, for a named function widened into
* an Fn, that function's code address, which the widening thunk reads back
* and calls. The marker meets all three at the same offset and must follow
* only the second.
*
* Nothing in the word says which. A code address can have any low bits — on
* wasm32 it is a table index, a small integer — so no tag bit is free on that
* side, and dereferencing one to look for a header would read code or trap.
* So the collector keeps the set of environment addresses it has handed out
* and follows a word only when the set has it. An address that is not an
* environment is never read through, which also makes a stale or unwritten
* word harmless: at worst it keeps a live environment alive a little longer.
*
* Open addressing, rebuilt from the sweep list after any sweep that freed an
* environment, because deletion from a linear-probe table is the fiddly part
* and a rebuild is one pass over objects the sweep has just walked anyway. */
static uintptr_t *envset;
static int64_t envset_cap, envset_n;
static inline uint64_t env_hash(uintptr_t p) {
uint64_t x = (uint64_t)p;
x ^= x >> 33;
x *= 0xff51afd7ed558ccdULL;
x ^= x >> 33;
return x;
}
static void envset_put(uintptr_t p);
static void envset_grow(int64_t cap) {
uintptr_t *old = envset;
int64_t oldcap = envset_cap, i;
envset = (uintptr_t *)calloc((size_t)cap, sizeof *envset);
if (envset == NULL) trap_oom(cap * (int64_t)sizeof *envset);
envset_cap = cap;
envset_n = 0;
for (i = 0; i < oldcap; i++)
if (old[i] != 0) envset_put(old[i]);
free(old);
}
static void envset_put(uintptr_t p) {
uint64_t h;
if ((envset_n + 1) * 2 > envset_cap)
envset_grow(envset_cap ? envset_cap * 2 : 64);
h = env_hash(p) & (uint64_t)(envset_cap - 1);
while (envset[h] != 0) {
if (envset[h] == p) return;
h = (h + 1) & (uint64_t)(envset_cap - 1);
}
envset[h] = p;
envset_n++;
}
static int envset_has(uintptr_t p) {
uint64_t h;
if (envset_cap == 0 || p == 0) return 0;
h = env_hash(p) & (uint64_t)(envset_cap - 1);
while (envset[h] != 0) {
if (envset[h] == p) return 1;
h = (h + 1) & (uint64_t)(envset_cap - 1);
}
return 0;
}
static void mark_env(uintptr_t w) {
if (envset_has(w)) mark_push((flan_obj *)w - 1);
}
/* Vecs still to walk, as (header, element descriptor). Explicit for the mark
* stack's reason: a data type can hold a Vec of itself, so how deep Vecs nest
* is the data's and not the type's, and recursion would put it on the C
* stack. */
typedef struct { flan_dyn_vec_hdr *h; const flan_desc *e; } vec_work;
static vec_work *vstack;
static int64_t vstack_n, vstack_cap;
/* The words [d] names inside the instance at [base]. A Vec entry is queued
* rather than walked here; [mark_desc] drains the queue before it returns. A
* header whose allocator has moved on to a later epoch was released by
* [free-all] and its elements are not the Vec's any more, so they are passed
* over — the same test [flan_vec_check] traps on. */
static void mark_words(char *base, const flan_desc *d) {
int64_t j;
for (j = 0; j < d->n; j++) mark_value(*(flan_dyn *)(base + d->offs[j]));
for (j = 0; j < d->nenv; j++) mark_env(*(uintptr_t *)(base + d->envs[j]));
for (j = 0; j < d->nvec; j++) {
flan_dyn_vec_hdr *h = (flan_dyn_vec_hdr *)(base + d->vecs[j].off);
if (h->ptr == NULL || h->len <= 0 || d->vecs[j].elem == NULL) continue;
if (h->alloc != NULL
&& (int64_t)((flan_dyn_alloc_hdr *)h->alloc)->epoch != h->epoch)
continue;
if (vstack_n == vstack_cap) {
int64_t cap = vstack_cap ? vstack_cap * 2 : 16;
vec_work *v = (vec_work *)realloc(vstack, (size_t)cap * sizeof *v);
if (v == NULL) trap_oom(cap * (int64_t)sizeof *v);
vstack = v;
vstack_cap = cap;
}
vstack[vstack_n].h = h;
vstack[vstack_n].e = d->vecs[j].elem;
vstack_n++;
}
}
static void mark_desc(char *base, const flan_desc *d) {
mark_words(base, d);
while (vstack_n > 0) {
vec_work w = vstack[--vstack_n];
int64_t i;
for (i = 0; i < w.h->len; i++)
mark_words((char *)w.h->ptr + i * w.e->size, w.e);
}
}
static void gc_mark_all(void) {
int64_t i;
unsigned k;
for (i = 0; i < roots_n; i++) {
const flan_desc *d = roots[i].desc;
if (d == NULL) mark_value(*(flan_dyn *)roots[i].base);
else {
int64_t j;
for (j = 0; j < d->n; j++)
mark_value(*(flan_dyn *)((char *)roots[i].base + d->offs[j]));
}
else mark_desc((char *)roots[i].base, d);
}
for (k = 0; k < RING; k++) mark_push(ring[k]);
while (mstack_n > 0) {
flan_obj *o = mstack[--mstack_n];
int64_t n = obj_words(o);
int64_t n;
if (o->kind == OBJ_ENV) {
mark_desc((char *)(o + 1), o->u.env.desc);
continue;
}
n = obj_words(o);
for (i = 0; i < n; i++) mark_value(o->u.v.items[i]);
}
}
@ -1006,6 +1162,7 @@ static void gc_mark_all(void) {
static void gc_sweep(void) {
flan_obj **link = &gc_all;
flan_obj *o = gc_all;
int envs_freed = 0;
while (o != NULL) {
flan_obj *next = o->next;
if (o->mark) {
@ -1013,7 +1170,8 @@ static void gc_sweep(void) {
link = &o->next;
} else {
int64_t held = (int64_t)sizeof(flan_obj);
if (o->kind == OBJ_TEXT) held += o->len;
if (o->kind == OBJ_TEXT || o->kind == OBJ_ENV) held += o->len;
if (o->kind == OBJ_ENV) envs_freed = 1;
if (o->kind == OBJ_VEC || o->kind == OBJ_MAP) {
int64_t per = o->kind == OBJ_MAP ? 2 : 1;
held += o->u.v.cap * per * (int64_t)sizeof(flan_dyn);
@ -1026,6 +1184,24 @@ static void gc_sweep(void) {
}
o = next;
}
/* A freed environment's address must leave the set before malloc can hand
it out again as something else. */
if (envs_freed) {
memset(envset, 0, (size_t)envset_cap * sizeof *envset);
envset_n = 0;
for (o = gc_all; o != NULL; o = o->next)
if (o->kind == OBJ_ENV) envset_put((uintptr_t)(o + 1));
}
}
void *flan_dyn_env_new(int64_t size, const flan_desc *d) {
flan_obj *o = gc_alloc(OBJ_ENV, size);
o->len = size;
o->u.env.desc = (d != NULL && (d->n > 0 || d->nenv > 0 || d->nvec > 0))
? d : NULL;
memset(o + 1, 0, (size_t)size);
envset_put((uintptr_t)(o + 1));
return (void *)(o + 1);
}
static void root_add(void *base, const flan_desc *d) {
@ -1049,7 +1225,7 @@ void flan_dyn_root_push(flan_dyn *slot) { root_add(slot, NULL); }
* compiler found no dyn in — but it still occupies an entry, because the count
* is what the epilogue knows, and it is turned into an empty descriptor rather
* than stored as NULL, which on this stack means something else. */
static const flan_desc desc_empty = { 0, 0, NULL };
static const flan_desc desc_empty = { 0, 0, NULL, 0, NULL, 0, NULL };
void flan_dyn_root_push_desc(void *base, const flan_desc *d) {
root_add(base, d == NULL ? &desc_empty : d);

41
runtime/flan_dyn.h
View File

@ -48,16 +48,33 @@ typedef uint64_t flan_dyn;
* outer offset plus the inner one, and there is no walking of a type graph at
* run time and no second descriptor to follow.
*
* [size] is the stride of one instance. The collector does not read it; the
* typed-container view will, which is the reason it is here now rather than
* being added later to data both lanes already emit.
* [size] is the stride of one instance, which is what a [vecs] entry's
* element descriptor is read for.
*
* Nothing in this ABI ever writes a descriptor, and no value ever points at
* one. See [flan_dyn_root_push_desc]. */
* Besides the dyn words, two more kinds of word the collector follows:
* [envs], the environment half of each (Fn ...) value inside the instance —
* pointer-sized, holding a collector-allocated environment, null, or a
* widened function's code address, told apart by the collector's own set of
* environments and never by dereferencing — and [vecs], each a (Vec T)
* header at [off] whose live elements are marked through [elem]. A descriptor
* with only dyn words leaves the last four fields zero.
*
* Nothing in this ABI ever writes a descriptor. See [flan_dyn_root_push_desc]
* and [flan_dyn_env_new]. */
struct flan_desc;
typedef struct flan_desc_vec {
int64_t off;
const struct flan_desc *elem;
} flan_desc_vec;
typedef struct flan_desc {
int64_t size;
int64_t n;
const int64_t *offs;
int64_t size;
int64_t n;
const int64_t *offs;
int64_t nenv;
const int64_t *envs;
int64_t nvec;
const flan_desc_vec *vecs;
} flan_desc;
/* ── Constructors ──────────────────────────────────────────────────── */
@ -361,6 +378,14 @@ void flan_dyn_root_pop(int64_t n);
* lifetime of the program; nothing copies it. */
void flan_dyn_root_push_desc(void *base, const flan_desc *d);
/* A closure's environment: [size] zeroed bytes the collector owns, marked
* through [d] (NULL when the environment holds nothing to follow). Answers
* the address of the first byte, which is what an (Fn ...) value carries as
* its second word. The object is in the allocation ring until 64 more
* allocations have happened, so the caller has that long to store the
* address somewhere rooted. [d] is static data and must outlive the object. */
void *flan_dyn_env_new(int64_t size, const flan_desc *d);
/* ── Extensions ────────────────────────────────────────────────────────
*
* Additions to the agreed ABI, none of which the compiler lane has to emit.

2
test/dyn_ops.c
View File

@ -893,7 +893,7 @@ static void desc(void) {
(int64_t)offsetof(desc_row, tail)
};
static const flan_desc row_desc = {
(int64_t)sizeof(desc_row), 3, offs
(int64_t)sizeof(desc_row), 3, offs, 0, NULL, 0, NULL
};
desc_row row;
flan_dyn was_label, was_note;

9
test/programs/fn-capture-dyn.flan
View File

@ -1,9 +1,6 @@
;; 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.
;; A dyn captured by an fn. The copy lives in the fn's environment, which the
;; collector allocated and marks through the environment's descriptor, so the
;; value it names stays alive for as long as the function value does.
(defn run [f (Fn [] i64)] i64 (f))
;; [d] is unannotated, which is what makes it a dyn.

13
test/programs/fn-escape-at.flan
View File

@ -1,13 +0,0 @@
;; An index read is a read, and the escape check's clean list has to be a
;; list. A function value out of a slice is refused exactly as one out of a
;; Vec, a struct or a pointer is — the four are the same act and there is no
;; reason for a reader to have to remember which spellings were enumerated.
;;
;; Not reachable today: nothing can write an Fn into a slice, because every
;; position that would have to hold one is refused. It is here so that the
;; day one can, this is already true — the alternative was a default of
;; "clean" for anything the enumeration had not thought of, which is how a
;; closed list quietly stops being closed.
(defn leak [s [(Fn [] i32)]] (Fn [] i32) (at s 0))
(defn main [] i32 0)

19
test/programs/fn-escape-copy.flan
View File

@ -1,19 +0,0 @@
;; 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)

12
test/programs/fn-escape-handled.flan
View File

@ -1,12 +0,0 @@
;; 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)

16
test/programs/fn-escape-match.flan
View File

@ -1,16 +0,0 @@
;; A match arm's binding is a binding, and the escape check has to see it.
;;
;; Reading the payload by hand is a case-field read, which is suspect: a copy
;; of a function value carries whatever environment the original did. Binding
;; it to a name in an arm is the same read, and the store that fills the arm's
;; slot is inside the branch rather than in any form the walk reads as a
;; binding — so without the arm's slots being taken as suspect too, the Vec,
;; slice, struct and pointer spellings of this were all refused while the one
;; that goes through Option and a name was not.
(defn leak [o (Option (Fn [] i32))] (Fn [] i32)
(match o
(Some f) f
None (fn [] 0)))
(defn main [] i32 0)

11
test/programs/fn-escape-param.flan
View File

@ -1,11 +0,0 @@
;; 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)

10
test/programs/fn-escape-return.flan
View File

@ -1,10 +0,0 @@
;; 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)

7
test/programs/fn-escape-store.flan
View File

@ -1,7 +0,0 @@
;; 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)

9
test/programs/fn-escape-vec.flan
View File

@ -1,9 +0,0 @@
;; 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)

198
test/programs/fn-escape.flan Normal file
View File

@ -0,0 +1,198 @@
;; Closures that outlive the frame they were made in. The environment is
;; allocated by the collector, so a capturing fn may be returned, kept in a
;; Vec, an Option field of a struct or a global, and called after any number
;; of collections. Every line below is called after a forced collection that
;; would have freed an environment nobody rooted.
;;
;; Capture is by value: the environment holds copies of the locals taken when
;; the fn was made. A counter shares state through a captured dyn map, which
;; is a reference to one object on the collector's heap.
(declare gc-collect [] () "flan_gc_collect")
(defn churn [] ()
(let [i 0]
(while (< i 2000)
(let [v (vec-new dyn)] (push v i) (push v "junk"))
(set i (+ i 1))))
(gc-collect))
(defn make-adder [n i64] (Fn [i64] i64)
(fn [x] (+ x n)))
;; Two captures deep: the inner fn captures the outer one's copy of [base],
;; and the returned value captures a function value that captures.
(defn make-scaled [base i64 k i64] (Fn [i64] i64)
(let [add (make-adder base)]
(fn [x] (* k (add x)))))
(defn keep [f (Fn [i64] i64)] (Fn [i64] i64) f)
;; A function value read back out of an environment and handed on: [sneak]'s
;; literal captures [g], and [getf] returns the copy.
(defn getf [f (Fn [] (Fn [i64] i64))] (Fn [i64] i64) (f))
(defn sneak [g (Fn [i64] i64)] (Fn [i64] i64) (getf (fn [] g)))
;; Stored through a pointer into a slot of the caller's frame.
(defn stash [p (Ptr (Fn [i64] i64)) f (Fn [i64] i64)] () (set (deref p) f))
(defn make-counter [] (Fn [] i64)
(let [st {:n 0}]
(fn []
(put st :n (+ (get st :n) 1))
(i64 (get st :n)))))
;; A dyn captured and returned: the text is on the collector's heap and
;; reachable only through the environment.
(defn make-greeter [who] (Fn [] i64)
(let [msg (vec-new dyn)]
(push msg who)
(push msg "and")
(push msg who)
(fn [] (i64 (length msg)))))
(defstruct Button [label string on-click (Option (Fn [] i64))])
(defonce handler (Option (Fn [i64] i64)))
(defn call-opt [o (Option (Fn [i64] i64)) x i64] i64
(match o
(Some f) (f x)
None -1))
(defn double [x i64] i64 (* 2 x))
;; A handler clause keeps its copies on the establishing frame, and may now
;; capture a dyn and a closure like an fn may.
(defstruct Ping [n i64])
(defonce heard i64)
(defn pinged [x i64] i64 (signal (Ping {.n x})) x)
(defn keep-handled [f (Fn [i64] i64)] (Fn [i64] i64)
(handler-bind [(Ping [c] (set heard 0))] f))
(defn handled [] ()
(let [names (vec-new dyn)
f (make-adder 50)]
(push names "a")
(push names "b")
(handler-bind [(Ping [c] (churn) (set heard (+ (f (.n c)) (i64 (length names)))))]
(pinged 1))
(println heard)))
;; A data type's case holding a function value, in a Vec, and a Vec of Vecs.
;; The collector names every case's function-value word and follows only the
;; ones that hold an environment it made.
(defdata Action
[Idle
(Run [f (Option (Fn [i64] i64)) n i64])
(Pair [k i64 g (Option (Fn [i64] i64))])])
(defn act [a Action x i64] i64
(match a
Idle 0
(Run f n) (+ n (call-opt f x))
(Pair k g) (+ k (call-opt g x))))
(defn shapes [] ()
(let [acts (vec-new Action)
a (arena-new 65536)
outer (vec-new (Vec (Fn [i64] i64)) a)]
(push acts (Action.Run {.f (Some (make-adder 1)) .n 10}))
(push acts (Action.Pair {.k 20 .g (Some (make-adder 2))}))
(push acts Action.Idle)
(let [inner (vec-new (Fn [i64] i64) a)]
(push inner (make-adder 3))
(push outer inner))
(churn)
(println (+ (act (at acts 0) 1) (+ (act (at acts 1) 1) (act (at acts 2) 1)))
((at (at outer 0) 0) 1))))
;; A data type holding a Vec of itself: the collector walks as deep as the
;; data goes, and the function value two levels down is still found.
(defdata Tree [(Node [f (Option (Fn [i64] i64)) kids (Vec Tree)])])
(defn tree-sum [t Tree x i64] i64
(match t
(Node f kids)
(let [s (call-opt f x)
i 0]
(while (< i (length kids))
(set s (+ s (tree-sum (at kids i) x)))
(set i (+ i 1)))
s)))
(defn trees [] ()
(let [a (arena-new 65536)
leaf-kids (vec-new Tree a)
kids (vec-new Tree a)]
(push kids (Tree.Node {.f (Some (make-adder 5)) .kids leaf-kids}))
(let [root (Tree.Node {.f None .kids kids})]
(churn)
(println (tree-sum root 1)))))
;; Environments nobody holds are collected: a hundred thousand of them made
;; and dropped leave the heap as small as it was.
(declare gc-live-bytes [] i64 "flan_gc_live_bytes")
(defn many [] ()
(let [sum (i64 0)]
(dotimes [i 100000]
(set sum (+ sum ((make-adder 1) 0))))
(gc-collect)
(println sum (< (gc-live-bytes) 1000000))))
(defn main [] i32
;; Returned, then called after a collection.
(let [add5 (make-adder 5)]
(churn)
(println (add5 10)))
;; Nested, and passed through a function that hands its parameter back.
(let [f (keep (make-scaled 1 3))]
(churn)
(println (f 4)))
;; Out of an environment, through a handler-bind's value, and through a
;; pointer.
(let [f (keep-handled (sneak (make-adder 20)))
slot (make-adder 0)]
(stash (addr slot) (make-adder 7))
(churn)
(println (f 1) (slot 1)))
;; A Vec of function values, one capture per iteration plus a widened name.
(let [fs (vec-new (Fn [i64] i64))]
(let [i 0]
(while (< i 5)
(push fs (make-adder (* i 100)))
(set i (+ i 1))))
(push fs double)
(churn)
(let [total (i64 0)]
(let [i 0]
(while (< i (length fs))
(set total (+ total ((at fs i) 1)))
(set i (+ i 1))))
(println total)))
;; A counter over a captured dyn map: two calls on one value see one state.
(let [c (make-counter)]
(c)
(churn)
(c)
(println (c)))
;; A captured dyn.
(let [g (make-greeter "world")]
(churn)
(println (g)))
;; A struct field and a global, both through Option.
(let [b (Button {.label "ok" .on-click (Some (make-counter))})]
(churn)
(match (.on-click b)
(Some f) (do (f) (println (f)))
None (println "none")))
(set handler (Some (make-adder 1000)))
(churn)
(println (call-opt handler 7))
(handled)
(shapes)
(trees)
(many)
0)

9
test/programs/fn-in-map.flan Normal file
View File

@ -0,0 +1,9 @@
;; A closure's environment is found by walking the storage its function value
;; sits in — a frame slot, a global, a struct, an Option, a Vec's elements —
;; and a Map's storage is not walked. An (Fn ...) as a Map's value would hold
;; an environment the collector cannot see and would free. A Vec holds them,
;; and a (CFn ...) carries no environment and may go in a Map.
(defn main [] i32
(let [ops (map-new string (Fn [i32] i32))]
(put ops "id" (fn [x] x))
0))

89
test/test_acceptance.ml
View File

@ -3239,6 +3239,10 @@ let () =
local: kept 42\naggregate: kept 42\nnested: kept 42\n\
fn value: kept 42\nindex: kept 42\nfield index: kept 42\n"
in
(* And [programs/fn-escape.flan]'s, for the same reason. *)
let fn_escape_out =
"15\n15\n21 8\n1007\n3\n3\n2\n1007\n53\n35 4\n5\n100000 true\n"
in
(* ── wasm32 ────────────────────────────────────────────────────────
TODO.org, "The web target does not reach four things".
@ -3358,7 +3362,15 @@ let () =
value held beside a sibling that collects is rooted through the
same explicit slots there as natively. *)
wasm_case "dyn: an operand held while a sibling collects, wasm32"
"programs/dyn-held-operand.flan" dyn_held_out));
"programs/dyn-held-operand.flan" dyn_held_out;
(* Closures under collection, where a pointer is four bytes: an
Fn's environment word is at offset 4, and a descriptor written
with x86-64's numbers marks the wrong word — the counter line
then reads a freed map. *)
wasm_case "an fn that outlives its frame, wasm32"
"programs/fn-escape.flan" fn_escape_out;
wasm_case "an fn that outlives its frame, wasm32, -O0" ~opt:"-O0"
"programs/fn-escape.flan" fn_escape_out));
(* The EDN tokenizer, and the struct reader written by hand against it
(vendor/edn, test/programs/edn.flan). The expected output is a raw
@ -4125,32 +4137,32 @@ level "1"
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 "an index read is a read like any other"
"programs/fn-escape-at.flan" "may carry an environment";
refuses "a match arm's binding is a binding"
"programs/fn-escape-match.flan" "may carry an environment";
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";
(* Closures that outlive their frame: spec-memory.md's case 3. The
environment is allocated by the collector, so a capturing fn is
returned, passed through a function that hands it back, read back out
of another fn's environment, stored through a pointer, pushed into a
Vec beside a widened name, kept in an Option field and an Option
global, and called after a forced collection every time. The counter
shares state through a captured dyn map; a handler clause captures a
dyn and a closure; and a hundred thousand dropped environments leave
the heap small, which is the line that fails if they are never freed.
With the collector not marking environments, valgrind reports reads of
freed blocks on this program and the counter line traps. *)
outputs "an fn that outlives its frame" "programs/fn-escape.flan"
fn_escape_out;
outputs ~opt:"-O0" "an fn that outlives its frame, -O0"
"programs/fn-escape.flan" fn_escape_out;
outputs ~x86:true "an fn that outlives its frame, --x86"
"programs/fn-escape.flan" fn_escape_out;
outputs ~dev:true "an fn that outlives its frame, dev"
"programs/fn-escape.flan" fn_escape_out;
outputs "an fn captures a dyn" "programs/fn-capture-dyn.flan" "7\n";
outputs ~x86:true "an fn captures a dyn, --x86"
"programs/fn-capture-dyn.flan" "7\n";
refuses "a Map cannot hold function values" "programs/fn-in-map.flan"
"a Map's storage is not walked";
(* Capture is by value, and a store into a copy is refused rather than
left to change the copy and not the local. *)
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
@ -4160,8 +4172,6 @@ level "1"
"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"
@ -4974,7 +4984,7 @@ level "1"
(List.filter
(fun line ->
contains line prefix
&& contains line "constant { i64, i64, ptr }")
&& contains line "constant { i64, i64, ptr, i64, ptr, i64, ptr }")
(String.split_on_char '\n' ir))
in
if n <> want then begin
@ -5073,6 +5083,25 @@ level "1"
[the global ...] sites and two [the return type of ...] ones, which a
walk over function bodies alone would never have found. *)
no_gc_sites "programs/dyn-global.flan" 6;
(* A capturing fn allocates its environment from the collector, so it is
a site too, with its own sentence. The file has more than one. *)
no_gc_sites "programs/fn-escape.flan" 2;
(* And the price closures do not charge: a program whose function values
capture nothing roots none of them and sets up no heap, so its IR has
no root push and no collector start-up in it. *)
List.iter
(fun path ->
let l = Load.program ~file:path (Reader.read_file path) in
let ir = Emit.program (Check.program_all l.Load.decls) in
if contains ir "call void @flan_dyn_root_push"
|| contains ir "call void @flan_gc_init" then begin
incr failures;
Printf.printf
"FAIL %s roots or starts the collector with no capture in it\n"
path
end)
[ "programs/fn-values.flan"; "programs/higher-order.flan" ];
(* The other half, and the reason the flag is a pass and not a parameter of
[Emit]: a program with nothing to refuse compiles to the same bytes with

12
test/test_flan.ml
View File

@ -6276,6 +6276,18 @@ let () =
"may allocate: a push past the Vec's capacity grows it through its \
allocator") ];
(* A capturing fn allocates its environment on the collected heap; one that
captures nothing is a code address and allocates nothing. *)
memory "a capturing fn, and one that captures nothing"
"(defn apply1 [f (Fn [i32] i32) x i32] i32 (f x))\n\
(defn main [] ()\n\
\ (let [n 3]\n\
\ (print (apply1 (fn [x] (+ x n)) 1))\n\
\ (print (apply1 (fn [x] x) 1))))"
[ (4, 20, gc,
"allocates: an fn that captures keeps its copies in an environment on \
the collector's heap") ];
(* The allocator side, and the two shapes of [flan_vec_init]: [slurp] sizes
the Vec to the file and takes a block here, [(vec-new i32 a)] passes a
capacity of zero and takes none. Same runtime entry point, two answers,