diff --git a/BUILT.md b/BUILT.md index 5fd2266..98d63c6 100644 --- a/BUILT.md +++ b/BUILT.md @@ -1274,6 +1274,221 @@ that listing anyway. memory of the process it is talking to, which is only guaranteed if it is the session that compiled the running binary. Attaching to a process someone else built is not a thing to support by default. +## Allocators, `(Vec T)` and `StorageExhausted` + +`spec-memory.md`'s Allocators section is frozen and settles what to build. This is why the built thing is the shape it +is, and — separately and loudly — the three places it **amends** that section plus the one thing it adds to it. + +### `Allocator` is a builtin opaque type, so none of milestone 5 was needed + +The spec defines an allocator as "a procedure plus an opaque data pointer", which reads as a function value, and +`check.ml` refuses function values four ways — a written `(Fn ...)` annotation, a written `fn` literal, a `defn`'s name +in value position, and calling anything other than a named function. Read straight off those lines, containers need +function values and the work doubles. + +None of the four is anywhere near this. All four are about *surface syntax*, and a value the compiler builds that no +surface form names trips none of them: + +- `Allocator` is a `Types.t` case with no user-writable constructor, the way `string` is a builtin ptr+len. No Flan + type names its procedure. +- The procedure is a C symbol the emitter names. +- `vec-new`, `push`, `free`, `free-all` and the rest are ordinary named calls, which `check_call` already routes + through `named_call`. + +The precedent was already in the repo twice: a `handler-bind` clause is lowered to a function called back through +`h->fn(condition, xfer)` and built as its own `Tast.fn`, never an `Ast.Fn`; and a dev build's `call` loads a pointer +out of a cell and calls through it, which is the indirect call the surface language refuses. + +What *does* need milestone 5 is a **user-written** allocator: "here is my proc, make an `Allocator` from it" wants a +`defn`'s name in value position. `make-allocator`, `allocator-from` and `allocator` are refused by name with that +reason, rather than coming back as unknown functions. + +**An `Allocator` value is a pointer to the runtime's struct, never a copy of one.** That is forced, not chosen. The +capability set has to be readable from wherever a container landed, and `free-all` bumps an epoch every container made +from the allocator has to observe. A copied-by-value allocator gives each copy its own epoch and the dev trap never +fires. + +### The surface + +| Name | What | +|---|---| +| `(heap-allocator)` | the general-purpose tier: malloc, aligned, with free | +| `(arena-new bytes)` | a bump arena over one fixed backing buffer | +| `(arena-destroy a)` | hands the pages back — see the amendment below | +| `(free-all a)` | releases everything the allocator holds, retain-capacity | +| `(can-free? a)` / `(can-free-all? a)` | the capability set, read at run time | +| `(alloc-epoch a)` / `(alloc-id a)` | the counter `free-all` bumps; the allocator's identity | +| `(alloc-budget a)` / `(set-alloc-budget a n)` | a ceiling on live bytes — an addition, see below | +| `(alloc-live-blocks a)` | "did you forget to free", answered at the tier that can answer it | +| `context/allocator` / `context/temp` | the current implicit allocator, and the per-frame arena | +| `(with-allocator a body...)` | rebinds for a dynamic extent and releases nothing | +| `(vec-new T)` / `(vec-new T a)` / `(vec-new)` | a Vec, against the context or a named allocator | +| `(push v x)` / `(reserve v n)` | `Unit`, both | +| `(at v i)` / `(len v)` | the array names, extended — not a parallel pair | +| `(as-slice v)` / `(as-slice v lo hi)` | a non-owning `[T]` view | +| `(clone v)` / `(clone v a)` | the only copy; assignment moves | +| `(free v)` | consumes its argument | + +### Three amendments to a frozen spec, and one addition + +**1. `free-all` is retain-capacity, and `arena-destroy` is the operation that hands pages back.** The spec's table has +`free-all` and nothing else. Zig's `ArenaAllocator.reset` takes a `ResetMode` of `free_all` / `retain_capacity` / +`retain_with_limit`; Odin's `arena_free_all` is retain-capacity in effect, because its arena is one fixed backing +buffer and the call only sets `offset = 0`. For a frame arena reset every frame, retain-capacity is the normal case and +handing the pages back only to ask for them again is the unusual one. Taking the mode as a parameter would have grown +the table the spec froze at four names; a second operation does not. The epoch is bumped either way — the pages being +the same does not make a container built before the reset valid, which is the whole point of the trap. + +**2. `context/allocator` and `context/temp` are dynamic variables with save and restore, not extra parameters.** The +spec says the allocator is "part of the calling convention". The literal reading touches every function signature, the +FFI shim, the dev trampolines and the reload ABI, for the same observable behaviour, and it collides with every other +lane working in `emit.ml`. The dynamic variable is the implementation; the literal reading is deferred and is a +performance question (a parameter avoids a global load), not a semantic one. + +**3. The `Vec` header is six words in every build, not four in release.** The spec fixes the release layout at +`ptr + len + cap + allocator` with the generation word and the epoch dev-only. A layout that changes with a build flag +is a layout that can disagree *silently* across the reload boundary: a redefinition module is built by `llc` and `ld` +against a host built separately, and nothing makes the two agree on a struct size. So the words are unconditional and +so is the epoch check. The 32-byte release layout is deferred on that, and it needs the reload path to carry the flag +before it can land. + +**The addition: a budget.** `flan_allocator` grew a ceiling on live bytes, 0 for none. The spec's `retry` restart is +answerable only by a handler that can make the *same* request succeed, and for a fixed backing store the handler that +works is the one that raises the ceiling — releasing the region the container lives in invalidates the container, which +is exactly what the epoch check catches. The spec names "grows the arena and then invokes `retry`" as the handler that +works; something has to be growable for that sentence to be true. It doubles as how a test exhausts an allocator on +purpose. + +### `with-allocator` is its own IR node because of the transfer path + +Save, run, restore — and *restore again at the pad*. That second restore is the whole reason it is a node rather than a +`let` and two calls. A body that errors, or one a handler transfers out of, leaves through `current_pad`, and a context +allocator left pointing into a region nobody outside the body has heard of would be wrong in the break loop, which is +precisely where something is about to allocate in order to render a condition. `test/programs/allocators.flan` asserts +that path by taking a restart out of a `with-allocator` body. + +It releases nothing, per the spec: not at the end of a `let`, not at the end of a function, not at the end of the body. +The program proves it by reading the epoch either side. + +### `(Vec T)`: one type-erased runtime, and the backend learned almost nothing + +The element type appears nowhere below the call site. `size_of` and `align_of` are produced where the concrete type is +known — which without generics is simply the concrete call site — and passed in, which is Odin's arrangement +(`base/runtime/dynamic_array_internal.odin`). The backend grew four prims in total: + +- `Rt of string` — a call into the runtime's C named by symbol, with argument and result LLVM types read off the + expression nodes. The container runtime is type-erased and therefore *is* a list of C entry points, so one arm covers + all of them. A `Vec` argument crosses as its address, which is also what lets an operation mutate the caller's Vec. +- `SizeOf` / `AlignOf` of a type, filled in from the same layout calculator DWARF uses — the one the acceptance test + already checks against LLVM's own `getelementptr` answers. +- `AddrOf` of any expression, place or not, because the element a `push` copies may be computed. The backend already + spilled a non-place to a temporary for exactly this. + +`at` and `len` were already the names for a fixed array and a slice, so a Vec extends them rather than adding a +parallel pair — the asymmetry `nth` was removed for. The value form `(at v i)` and the place form `(set (at v i) x)` go +through one helper, so they cannot drift apart the way `nth` did. + +A Vec's length and index are `i32`, like every other length here. Widening indices is one change across every +container and not a Vec question. + +`let` has no type annotation — `parse.ml` settles that a triple binding is ambiguous and that types are inferred — so a +local Vec has nowhere to say what it holds and the element type is written at the call: `(vec-new i32)`. This is *not* +the explicit instantiation syntax the generics section rules out: nothing here is generic, and the name resolves as an +ordinary type rather than binding a type variable. Where the context does say — a `defvar`'s type, a return type, an +argument — it may be left out. + +A zeroed Vec has a null allocator, and the first operation that needs storage adopts the context allocator, which is +Odin's behaviour. The alternative was refusing a Vec-typed struct field outright; that is refused anyway, for a +different reason (below), but the adopt rule is what makes `Zero` of a Vec a usable value rather than a null deref. + +### Move-only is a dead set, and it is flow-sensitive at a join + +Reading a move-only local is a move unless the site said it was a borrow. That is the conservative direction: passing +one to a function, binding it, returning it and `free`ing it are all moves and all reach one place, and the handful of +operations that only look at a container (`at`, `len`, `as-slice`, `push`, `reserve`, `clone`) say so. Only a +*syntactically simple* target counts as a borrow — in `(len (f v))` the call still moves `v`. + +At an `if` and at a `match`, every arm is checked from the state before the form and the **union** of what they moved +survives the join. A flat set is wrong in both directions: it refuses `(if c (free v) (free v))`, which is legal, and it +accepts a use after a one-armed move, which is a use-after-free. The arms are alternatives, and that is what a union +says. + +The one case a dead set cannot answer is a move inside a loop: merged once at the end of the body it counts one move, +not two, while the second iteration would use what the first gave away. So it is a rule rather than an inference — a +move of a binding declared outside the loop is refused, with that as the reason. + +### What ownership is not transitive through yet, and why each is refused + +The spec says ownership is structural — a struct containing a Vec is itself move-only, `free` recurses into owning +fields, and a field cannot be freed on its own. That machinery is the recursive teardown `drop` brings. Until it lands, +three shapes are refused where they are declared, each naming `drop`: + +- **a struct field of `Vec` type**, because the struct copies its header on assignment and nothing records a move; +- **a global of `Vec` type**, because the dead set is per function — two functions each freeing it is a double free + nothing could see, and a global read does not go through the move path at all, so even the one-function case would be + accepted. Half a rule is worse than none. A global **`Allocator`** is a different thing and stays legal: an allocator + is a copyable opaque handle, and it is what makes a handler that owns the arena expressible, since a handler cannot + see the locals of the function that established it; +- **a `Vec` of a `Vec`**, because the type-erased runtime copies and releases elements bytewise: `clone` would + duplicate inner headers instead of copying what they own and `free` would drop their buffers. + +And a `Vec` does not cross to C: handing a header that owns storage to C hands out an owner. `(as-slice v)` as +`(Ptr T)` plus `(len v)` is the shape that does cross, and the refusal says so. + +### `StorageExhausted` went in *with* `Vec`, not after it + +No allocating operation returns an error and none can fail silently. When the allocator cannot satisfy a request the +operation signals `(StorageExhausted {:bytes n :align a :allocator id})` with `error` — whose type is `Never` — inside a +`restart-case` offering `retry`. One rule over every allocating operation, which is what keeps `push` and `reserve` at +`Unit`, `clone` at the container, and no signature anywhere growing a `Result`. + +It had to land with step 2 rather than after it: retrofitting adds a transfer check to every call site of every +allocating operation, which is the point of having decided it first. Odin's `append` returns an ignorable +`Allocator_Error`, and its type-erased path returns the old length on a failed reserve; an append that appends nothing +and says nothing is the outcome this rule exists to make impossible. + +The lowering is built out of nodes that already existed, so the backend learned nothing about allocation: + +``` +(let [ok false] + (while (not ok) + (restart-case + (do (set ok ATTEMPT) + (if (not ok) (error (StorageExhausted {...})))) + (retry [])))) +``` + +A handler that frees something, releases a scratch region or raises the ceiling and then invokes `retry` lands in the +clause, the clause falls through, and the `while` re-attempts the **same** request. Every argument to the attempt is +bound to a slot before the loop, so a retry re-attempts the allocation and not the expression that produced the value a +`push` was given. With nothing handling it, `error` stops the program on the frame that erred. + +This is the named exception to plan.org's "restarts go at the resync point, once" — the restart is established at the +failing allocation, because a restart at some outer loop cannot re-attempt an allocation and only the allocation site +can. The condition is a value struct with fixed numeric fields and **no rendered message**, because formatting would +allocate and this is the one path that must not; the numbers of the failed request are read back out of the runtime. + +### The epoch trap, which is the shipping answer to an open question + +`spec-memory.md` leaves "catching a use-after-release statically" open on purpose: the static rule needs to know which +allocator a construction used, and `with-allocator` plus `context/allocator` are exactly the mechanisms that deny that +knowledge. The shipping answer is detection. A Vec records the epoch of the allocator it was made with, `free-all` bumps +that counter, and any operation on a container whose recorded epoch has moved traps naming the site. +`test/programs/stale-region.flan` is the case, and the point of it is that `v` is still in scope, still looks fine, and +nothing marked it — which is precisely what a static rule cannot see. + +**The generation word has no reader.** It is bumped on every reallocation, as specified, and the stale-slice trap it +exists for is not implemented: a slice is ptr+len and has nowhere to carry the Vec's identity or its generation. Said +plainly here rather than implied by the word's presence in the header. + +### What this leaves for steps 4 to 7 + +`(Map K V)`; `drop` and with it the transitive move-only rule, recursive teardown, and the refusal to construct a +drop-carrying container against an allocator without `can-free`; `(Result T E)` and `try`; generics; the macro expander. +And the **accumulation pattern** — `(fn [c] (push errors c) ...)` over an enclosing Vec — which `Vec` does not buy: +capture does not exist at all, and the spec's captured-`Vec`-by-pointer rule has never had to exist because every +capturable type today is a value type. It is its own item and should be planned as one. + ## Where build time goes `flan build calc-me.flan` was ~160ms, and ~95% of it was clang. **The object cache is in**, and it is now ~110ms: diff --git a/NEXT.md b/NEXT.md index 249f06c..d9f4901 100644 --- a/NEXT.md +++ b/NEXT.md @@ -69,6 +69,16 @@ the commit that made it. `-2851001042534928384` — the same 64 bits, printed unsigned now that `hash-grid`'s `u64` no longer goes through an `(i64 …)` cast — and a trap column shifted because the call it names got shorter. +### Landed — the allocator, the arena, `(Vec T)`, `StorageExhausted` + +The critical path, and the thing NEXT.md said was the only one standing between this and writing a game. Steps 1, 2 and +3 of the build order below are struck; `Map` is step 4 and is untouched. `Allocator` is a builtin opaque type and +needed nothing from milestone 5, which was the whole bet. Three amendments to a **frozen** `spec-memory.md`, made +deliberately and stated as amendments in [`BUILT.md`](BUILT.md): `free-all` is retain-capacity with `arena-destroy` +beside it; `context/allocator` is a dynamic variable rather than a literal calling-convention parameter; and the `Vec` +header is six words in every build rather than four in release. One addition the spec does not have: a budget on the +allocator, because `retry` needs a handler that can make the *same* request succeed. + ### Landed — the runtime under a sanitizer `--sanitize` is a build flag beside `--debug`; `dune build --root . @sanitize` builds twenty-eight programs twice, plain @@ -413,8 +423,10 @@ What stopped it, and neither is small: plan.org's single line on it (831) names a `for` the language does not have and gives no mechanism. -1. **Allocators, then `Vec` and `Map`.** The critical path, and the only thing standing between this and writing a - game. **`Vec` does not need generics** — that was wrong and is worth un-learning: Odin's containers are compiler +1. ~~**Allocators, then `Vec` and `Map`.**~~ **Steps 1, 2 and 3 are done** — the allocator, the arena, `(Vec T)`, + `StorageExhausted` and `retry`. `Map` is step 4 and is what is left of this item. See *Allocators, `(Vec T)` and + `StorageExhausted`* in [`BUILT.md`](BUILT.md) for the shape, the three amendments to a frozen `spec-memory.md` and + the one addition. The claim below held: **`Vec` does not need generics** — that was wrong and is worth un-learning: Odin's containers are compiler builtins over a *type-erased* runtime (`base/runtime/dynamic_array_internal.odin`), where `$T` appears only in thin wrappers producing `size_of`/`align_of` at the call site, and per-key hash and equality are compiler-emitted procedures passed as a runtime argument (`Map_Info`, `base/runtime/core.odin:369`). That runtime is what @@ -451,14 +463,18 @@ plan.org's single line on it (831) names a `for` the language does not have and ### `Vec` and `Map` — the order to build them in +**Steps 1, 2 and 3 are built; 4 to 8 are what is left.** The reasoning is kept because it is what the remaining steps +rest on, and because the escape it describes was tested rather than assumed — see *Allocators, `(Vec T)` and +`StorageExhausted`* in [`BUILT.md`](BUILT.md). + The dependency nobody had written down, and the reason it looked worse than it is. `spec-memory.md` defines an allocator as "a procedure plus an opaque data pointer" — a function value. `check.ml` refuses function values four -ways, and all four say milestone 5: a written `(Fn ...)` annotation (`Ast.Tfn`, line 209), a written `fn` literal -(`Ast.Fn`, 458), a `defn`'s name used as a value (571), and calling anything other than a named function (1023). -`(Vec T)`, `(Map K V)`, `(Result T E)` and `(Handle T)` are refused at 215–218 as milestone 6. Read straight off those -lines, milestone 6's allocators need milestone 5's function values and the work doubles. +ways, and all four say milestone 5: a written `(Fn ...)` annotation (`Ast.Tfn`), a written `fn` literal (`Ast.Fn`), a +`defn`'s name used as a value, and calling anything other than a named function. `(Map K V)`, `(Result T E)` and +`(Handle T)` are still refused beside those as milestone 6; `(Vec T)` is not, any more. Read straight off those lines, +milestone 6's allocators need milestone 5's function values and the work doubles. -**The escape is real and the work does not double.** All four refusals are about *surface syntax*, and a value the +**The escape is real and the work did not double** — this is the claim the built thing confirms. All four refusals are about *surface syntax*, and a value the compiler builds that no surface form names trips none of them. The compiler already does exactly this, twice: - A `handler-bind` clause is lowered to a function whose address goes into a `flan_handler` and is called back through @@ -488,28 +504,27 @@ and that order cannot hold: the macro expander is blocked on `Form` being a Flan numbers are a topological hint, not a sequence. Take 6's container half first, 5's generics half second, and 5's expander last, on 6's unions. -1. **`Allocator` and the arena.** The builtin type, the four operations (`alloc`, `resize`, `free`, `free-all`) with - `size` and `align` as parameters, the capability set with `can-free` in it, `with-allocator`, and the dev-build - epoch counter. No container yet. Odin reads its capability set back through the same procedure — `Query_Features` - returning an `Allocator_Mode_Set` (`core/mem/allocators.odin:315`) — and a field on the allocator value is the same - information without the round trip. -2. **`(Vec T)`**, over the type-erased runtime: `ptr + len + cap + allocator` in release, plus the generation word and - the epoch in dev. `push`, `reserve`, `at`, `len`, `as-slice`, `free`, `clone`. `size_of`/`align_of` are produced at - the call site, which here is simply the concrete call site, there being no generics yet. +~~1. **`Allocator` and the arena.**~~ **Done.** The builtin opaque type, the four operations with `size` and `align`, + the capability set read off the allocator value, `with-allocator`, `context/allocator`, `context/temp` and the epoch + counter. `free-all` was decided as retain-capacity with `arena-destroy` beside it; the context is a dynamic variable + rather than a literal calling-convention parameter; both are stated as amendments in `BUILT.md`. A user-written + allocator is refused by name with milestone 5 as the reason. + +~~2. **`(Vec T)`**~~ **Done**, over the type-erased runtime, with `push`, `reserve`, `at`, `len`, `as-slice`, `free` and + `clone`, and with move-only enforced by a dead set that unions at an `if` or a `match` join. `at` and `len` were + extended rather than duplicated. The header is six words in *every* build, not four in release — a layout that + changes with a build flag can disagree silently across the reload boundary — and that is the third amendment. + Ownership is not transitive yet, so a struct field of `Vec` type, a global `Vec` and a `(Vec (Vec T))` are each + refused where they are declared, naming `drop` as what they wait on. + + The note below still stands and is now the only thing between `Vec` and the accumulation pattern: **capture does not + exist at all.** Nothing about it changed. + +~~3. **`StorageExhausted` and `retry`**~~ **Done, with step 2 and not after**, exactly for the reason given. It is a + `while` around a `restart-case` around the attempt, built in the checker out of nodes that already existed, so the + backend learned nothing about allocation. `test/programs/exhausted.flan` exhausts an allocator for real and takes the + restart; `exhausted-unhandled.flan` is the same failure with nothing handling it. - **`Vec` alone does not buy the accumulation pattern, and it is worth knowing that before step 2 is scoped.** - `(fn [c] (push errors c) ...)` over an enclosing `(Vec ParseError)` is the pattern `handler-bind` exists for, and it - needs two further things. Capture does not exist at all: `check.ml`'s `captured` (`:176`) consults `ctx.outer` only - to raise a better refusal — "a handler cannot see %s ... Use a global, or pass it on the condition" — and `lookup` - (`:167`) never reads `outer`. That is `spec-memory.md`'s case 2, a non-escaping `fn` capturing by value into a stack - environment, and it is unbuilt. On top of it, the same spec says a captured `Vec` or `Map` is captured **by pointer, - not moved**, and every capturable type today is a value type, so the by-value/by-pointer split has never had to - exist in a capture path. Both are their own work and neither falls out of `Vec`. Step 2 delivers a container; - accumulating into one from a handler is a separate item and should be planned as one. -3. **`StorageExhausted` and `retry`, with step 2 and not after.** `restart-case` and the transfer channel exist, so - this is a compiler-emitted restart at each allocating site and little else. It goes in at the same time because the - signatures depend on it: retrofitting it later adds a transfer check to every call site of every allocating - operation, which is the whole point of having decided it now. 4. **`(Map K V)`** — flat open-addressed key and value arrays, with a compiler-emitted hash and equality pair per key type passed as arguments. `spec-memory.md`'s structural-key restriction holds this to the built-in key set, so there is no dispatch to design. @@ -523,21 +538,26 @@ expander last, on 6's unions. of the second. 8. **The macro expander**, last, on 6's unions. -**What is genuinely unsettled, and none of it blocks step 1.** +**What is genuinely unsettled.** -- `spec-memory.md`'s "Open: catching a use-after-release statically" is open by decision, not by omission. It says the - static rule needs to know which allocator a construction used and that `with-allocator` plus `context/allocator` are - exactly what deny that knowledge; the shipping answer is the dev-build epoch trap, which is specified and buildable. - It also says what would settle it — real Flan programs using arenas, to show whether the escapes that occur are - lexical — and that is evidence this repo cannot produce until after step 2. **Build against the epoch trap.** -- **The operation table may be one operation short.** It has `free-all` and nothing else. Zig's `ArenaAllocator.reset` - takes a `ResetMode` of `free_all`, `retain_capacity` or `retain_with_limit` - (`lib/std/heap/arena_allocator.zig:57`–`69`), and for a frame arena reset every frame, retain-capacity is the normal - case and free-all is the unusual one — handing the pages back to the backing allocator only to ask for them again. - Odin's `arena_free_all` is retain-capacity in effect, because its arena is one fixed backing buffer and the call only - sets `offset = 0` (`core/mem/allocators.odin:287`). Flan should decide whether `free-all` means either of these or - takes the mode. It is an amendment to `spec-memory.md`, it is small, and it is better made before the arena is - written than after. +- `spec-memory.md`'s "Open: catching a use-after-release statically" is still open, and it is now open with evidence + available for the first time: the epoch trap is built and `test/programs/stale-region.flan` is the case it catches. + What the spec says would settle it — real Flan programs using arenas, to show whether the escapes that actually occur + are lexical — is now *producible*, because there is a `Vec` to write them with. That is the next thing to look at, + not the next thing to build. +- ~~**The operation table may be one operation short.**~~ **Decided.** `free-all` is retain-capacity and + `arena-destroy` hands the pages back — two names rather than the mode parameter, so the table the spec froze at four + operations did not grow. `BUILT.md` states it as the amendment it is. +- **The `Vec` header is six words in release too, and should not stay that way.** The 32-byte layout the spec fixes is + blocked on one thing: a redefinition module is built by `llc` and `ld` against a host built separately, and nothing + makes the two agree on a struct size. Give the reload path a way to carry the build flags and this falls out. +- **The generation word has no reader.** It is bumped on every reallocation as specified, and the stale-slice trap it + exists for needs a slice that can carry the Vec's identity — a slice is ptr+len. Either slices grow a word in a dev + build or the trap does not exist; today it does not. +- **The allocator grew a budget** (`alloc-budget` / `set-alloc-budget`), which `spec-memory.md` does not have. It is + there because `retry` is only answerable by a handler that can make the *same* request succeed, and for a fixed + backing store that handler is the one that raises the ceiling — releasing the region the container lives in + invalidates the container. Worth folding into the spec or replacing with a growable arena. - Escaping closures are still deferred (`spec-memory.md`, "Function values", case 3), and a user-written allocator is not one — its procedure is a top-level `defn` with no captured environment. The two should not be conflated when function values arrive. diff --git a/lib/check.ml b/lib/check.ml index 931e09c..bf73624 100644 --- a/lib/check.ml +++ b/lib/check.ml @@ -109,6 +109,20 @@ type ctx = { function's defers are already half run and the first transfer's target is already in hand. Refused where it is written. *) mutable in_defer : bool; + (* Move tracking, spec-memory.md's "(Vec T) and (Map K V) are move-only". + [dead] is the slots whose value has been moved out, with where it went, so + that a second use names the first rather than reporting a type error about + nothing. It is flow-sensitive at an [if]: the two arms are checked from + the same starting set and the *union* survives the join, so moving in one + arm only is still a move afterwards — and moving in both arms, which is + legal, is not two errors. + + [borrow] is set only while checking the *target* of an operation that + reads a container without consuming it ([at], [len], [as-slice], [push], + [reserve], [clone]). Without it every one of those would look like a move + and no program could push twice. *) + mutable dead : (int * Loc.t) list; + mutable borrow : bool; (* The function being checked, so a clause lifted out of it can be named after it. The name has to be stable and has to say whose it is: a redefinition module emits the clauses belonging to the bodies it is @@ -212,7 +226,24 @@ let rec resolve env ?(seen = []) (t : Ast.texpr) : Types.t = | "Ptr", [ a ] -> Types.Ptr (resolve env ~seen a) | "Option", [ a ] -> Types.Option (resolve env ~seen a) | ("Ptr" | "Option"), _ -> fail loc "(%s T) takes exactly one type" name - | "Vec", _ -> unimplemented loc "(Vec T)" 6 + | "Vec", [ a ] -> + let e = resolve env ~seen a in + (* A Vec of a Vec is representable and would be wrong. spec-memory.md + makes [clone] a deep copy and makes [free] recurse structurally into + owning fields; the type-erased runtime does neither — it memcpys, so + a clone would duplicate inner headers and a free would drop their + buffers on the floor. Recursive teardown is what step 5's [drop] + brings, and this is refused until it does rather than shipping the + shallow answer under the deep name. *) + if Types.is_move_only e then + fail loc + "(Vec %s) holds a move-only element, and the type-erased runtime \ + copies and releases elements bytewise — so clone would duplicate \ + headers instead of copying, and free would leak what they own. \ + Recursive teardown arrives with drop (step 5 in NEXT.md)" + (Types.to_string e); + Types.Vec e + | "Vec", _ -> fail loc "(Vec T) takes exactly one type" | "Map", _ -> unimplemented loc "(Map K V)" 6 | "Result", _ -> unimplemented loc "(Result T E)" 6 | "Handle", _ -> unimplemented loc "(Handle T)" 6 @@ -264,6 +295,10 @@ and resolve_name env ~seen loc n = | "string" -> Types.String | "Unit" -> Types.Unit | "Never" -> Types.Never + (* A builtin opaque type, the way [string] is a builtin ptr+len. There is + no user-writable constructor and no way to name its procedure: see + Types, and NEXT.md's "the escape is real". *) + | "Allocator" -> Types.Alloc | _ when Hashtbl.mem env.aliases n -> if List.mem n seen then fail loc "the type alias %s is defined in terms of itself" n @@ -321,6 +356,28 @@ let mk loc ty e : Tast.expr = { Tast.e; ty; loc } let unit_at loc = mk loc Types.Unit Tast.Unit +(* A source location as a value, for a runtime trap that has to name the site + rather than the runtime. The bounds and slice traps get theirs from [Emit], + which renders the [Loc.t] it is already carrying; a trap reached through a + plain runtime call has no such carrier, so the string is built here and + crosses as ptr+len like any other. *) +let here loc = mk loc Types.String (Tast.Str (Loc.to_string loc)) + +(* A runtime call, with the result type spelled at the site. *) +let rt loc ty sym args = mk loc ty (Tast.Prim (Tast.Rt sym, args)) + +let i64_at loc n = mk loc (Types.Int Types.I64) (Tast.Int (n, Types.I64)) + +(* spec-memory.md, "Alignment": the number is produced where the concrete + element type is known, which without generics is simply the call site. *) +let size_of loc t = mk loc (Types.Int Types.I64) (Tast.Prim (Tast.SizeOf t, [])) +let align_of loc t = mk loc (Types.Int Types.I64) (Tast.Prim (Tast.AlignOf t, [])) + +(* The address of an expression, place or not: the type-erased runtime takes + the element [push] copies by pointer. *) +let addr_of loc (e : Tast.expr) = + mk loc (Types.Ptr e.Tast.ty) (Tast.Prim (Tast.AddrOf, [ e ])) + (* Every integer index into an array or slice is i32 at milestone 2. *) let index_ty = Types.Int Types.I32 @@ -409,7 +466,9 @@ let rec check ctx ?want (e : Ast.expr) : Tast.expr = | Ast.If (c, t, e') -> check_if ctx ?want loc c t e' | Ast.While (c, body) -> let c = check ctx ~want:Types.Bool c in - let body = scoped ctx (fun () -> map_lr (fun b -> check ctx b) body) in + let body = in_loop ctx (fun () -> + scoped ctx (fun () -> map_lr (fun b -> check ctx b) body)) + in expect loc ~want (mk loc Types.Unit (Tast.While (c, body))) | Ast.Return v when ctx.in_frames <> None -> ignore v; @@ -606,9 +665,22 @@ and var ctx loc ~want name = fail loc "nothing here says what None is an Option of — annotate the \ function's return type or the binding") + (* spec-memory.md puts the allocator in the calling convention as + [context/allocator] and [context/temp]. They read as names rather than + calls because that is how the spec writes them, and they are dynamic + variables at run time rather than extra parameters — see BUILT.md for why + the literal reading of "calling convention" is deferred. *) + | "context/allocator" -> + expect loc ~want + (mk loc Types.Alloc (Tast.Prim (Tast.Rt "flan_context_allocator", []))) + | "context/temp" -> + expect loc ~want + (mk loc Types.Alloc (Tast.Prim (Tast.Rt "flan_context_temp", []))) | _ -> match lookup ctx name with - | Some b -> expect loc ~want (mk loc b.bty (Tast.Local b.slot)) + | Some b -> + if Types.is_move_only b.bty then moved ctx loc name b.slot; + expect loc ~want (mk loc b.bty (Tast.Local b.slot)) | None -> match Hashtbl.find_opt ctx.env.globals name with | Some (ty, _) -> expect loc ~want (mk loc ty (Tast.Global name)) @@ -618,6 +690,42 @@ and var ctx loc ~want name = (Printf.sprintf "the function value %s (a name used as a value)" name) 5 else begin captured ctx loc name; fail loc "unknown name %s" name end +(* Reading a move-only local. Every read is a move unless the site said it was + a borrow, which is the conservative direction: passing one to a function, + binding it, returning it and [free]ing it are all moves and all reach here, + and the handful of operations that only look at a container say so. *) +and moved ctx loc name slot = + (match List.assoc_opt slot ctx.dead with + | Some where -> + fail loc + "%s was moved at %s and cannot be used again — a Vec is move-only, so \ + binding, passing or returning one transfers ownership and the source \ + binding is dead afterwards (spec-memory.md). That rule is what makes a \ + double free unrepresentable; (clone %s) if you wanted a second one" + name (Loc.to_string where) name + | None -> ()); + if not ctx.borrow then ctx.dead <- (slot, loc) :: ctx.dead + +(* The target of an operation that reads a container without consuming it. Only + a syntactically simple target is treated as a borrow: in [(len (f v))] the + call still moves [v], and setting the flag over the whole subexpression + would have hidden that. *) +and borrowed ctx (a : Ast.expr) f = + let simple = + match a.Ast.e with + | Ast.Var _ | Ast.Field _ -> true + | Ast.Call ({ Ast.e = Ast.Var "at"; _ }, _) -> true + | _ -> false + in + if not simple then f () + else begin + let saved = ctx.borrow in + ctx.borrow <- true; + let r = f () in + ctx.borrow <- saved; + r + end + and block ctx ?want loc body = match body with | [] -> expect loc ~want (unit_at loc) @@ -661,7 +769,7 @@ and check_handler_bind ctx ?want loc clauses body = the enclosing one. *) let hctx = { env = ctx.env; ret = Types.Unit; slots = 0; slot_tys = []; slot_names = []; - scope = []; defers = []; outer = ctx.scope; in_handler = true; in_frames = None; in_defer = false; owner = "" } + scope = []; defers = []; outer = ctx.scope; in_handler = true; in_frames = None; in_defer = false; dead = []; borrow = false; owner = "" } in (* The condition crosses as a pointer, because the handler runs while the signalling frame is still alive and there is nothing to copy. @@ -807,12 +915,31 @@ and check_let ctx ?want loc bs body = and the bound to a hidden slot — [n] is evaluated once, before the loop, so a body that changes it cannot change the trip count — then step [i] at the end of the body. [i] is not assignable, so the step below is the only writer. *) +(* A loop body that moves a binding declared outside the loop is refused, and + this is the one place the dead set cannot answer on its own: the second + iteration would use what the first moved, and a set that is merged once at + the end of the body sees one move, not two. So it is a rule rather than an + inference, stated as one. *) +and in_loop ctx f = + let outer_slots = List.map (fun (_, b) -> b.slot) ctx.scope in + let before = ctx.dead in + let r = f () in + List.iter + (fun (slot, where) -> + if (not (List.mem_assoc slot before)) && List.mem slot outer_slots then + fail where + "this moves a value that was bound outside the loop, so the next \ + iteration would use what this one gave away. Move it out of the \ + loop, or bind a fresh value inside it") + ctx.dead; + r + and check_dotimes ctx ~want loc name count body = let count = check ctx ~want:index_ty count in scoped ctx (fun () -> let i = bind ctx name index_ty ~assignable:false in let limit = fresh_slot ctx index_ty in - let body = map_lr (fun b -> check ctx b) body in + let body = in_loop ctx (fun () -> map_lr (fun b -> check ctx b) body) in let iv = mk loc index_ty (Tast.Local i) in let one = mk loc index_ty (Tast.Int (1L, Types.I32)) in let cond = @@ -838,7 +965,15 @@ and check_if ctx ?want loc c t e = let t = scoped ctx (fun () -> check ctx t) in expect loc ~want (mk loc Types.Unit (Tast.If (c, t, unit_at loc))) | Some e -> + (* Both arms start from the same dead set and the union survives: moving in + one arm only still kills the binding afterwards, and moving in both — + which is legal and common — is not reported twice. A flat set would have + refused [(if c (free v) (free v))] and allowed the use after a one-armed + move, which are the two ways to be wrong here. *) + let before = ctx.dead in let t = scoped ctx (fun () -> check ctx ?want t) in + let after_then = ctx.dead in + ctx.dead <- before; (* With no expectation the then-branch supplies one for the else-branch, unless it diverges, in which case the else-branch decides. *) let ewant = @@ -847,6 +982,9 @@ and check_if ctx ?want loc c t e = | None -> if t.Tast.ty = Types.Never then None else Some t.Tast.ty in let e = scoped ctx (fun () -> check ctx ?want:ewant e) in + ctx.dead <- + after_then + @ List.filter (fun (k, _) -> not (List.mem_assoc k after_then)) ctx.dead; let ty = if t.Tast.ty = Types.Never then e.Tast.ty else if e.Tast.ty = Types.Never then t.Tast.ty @@ -940,6 +1078,13 @@ and check_match ctx ?want loc scrutinee arms = in let want = ref want in let saw_some = ref false and saw_none = ref false and saw_wild = ref false in + (* The same rule as [if], and for the same reason: the arms are alternatives, + so each is checked from the state before the match and the union of what + they moved survives the join. Checked in sequence against one mutating set + they would report the second arm's (free v) as a use after the first arm's + move, which is a legal program refused. *) + let before = ctx.dead in + let joined = ref [] in let arms = map_lr (fun (a : Ast.arm) -> @@ -955,14 +1100,24 @@ and check_match ctx ?want loc scrutinee arms = fail a.Ast.aloc "%s is not a case of Option — the cases are Some and None" c in - scoped ctx (fun () -> - let binds = List.map (fun n -> bind ctx n elem ~assignable:false) binds in - let body = block ctx ?want:!want a.Ast.aloc a.Ast.body in - if !want = None && body.Tast.ty <> Types.Never then - want := Some body.Tast.ty; - { Tast.acase = ctor; binds; abody = [ body ] })) + ctx.dead <- before; + let arm = + scoped ctx (fun () -> + let binds = + List.map (fun n -> bind ctx n elem ~assignable:false) binds + in + let body = block ctx ?want:!want a.Ast.aloc a.Ast.body in + if !want = None && body.Tast.ty <> Types.Never then + want := Some body.Tast.ty; + { Tast.acase = ctor; binds; abody = [ body ] }) + in + joined := + !joined + @ List.filter (fun (k, _) -> not (List.mem_assoc k !joined)) ctx.dead; + arm) arms in + ctx.dead <- !joined; if not (!saw_wild || (!saw_some && !saw_none)) then fail loc "this match is not exhaustive — Option needs both Some and None, or a \ @@ -1006,9 +1161,18 @@ and check_place ctx loc (p : Ast.place) : Tast.place * Types.t = | None -> fail loc "%s has no field %s" sname name | Some i -> Tast.Pfield (target, i), (List.nth s.Tast.fields i).Tast.fty) | Ast.Pindex (target, idx) -> - let target = check ctx target in - let idx, ty = indexed ctx target idx in - Tast.Pindex (target, idx), ty + let target = borrowed ctx target (fun () -> check ctx target) in + (match target.Tast.ty with + (* The same bounds and epoch check the value form gets, through the same + helper: an element of a Vec is a place because a Vec element is + assignable, and a set that skipped the checks would be the asymmetry + [nth] was removed for. *) + | Types.Vec _ -> + let p, ty = vec_at ctx loc target idx in + Tast.Pderef p, ty + | _ -> + let idx, ty = indexed ctx target idx in + Tast.Pindex (target, idx), ty) | Ast.Pderef target -> let target = check ctx target in (match target.Tast.ty with @@ -1143,6 +1307,144 @@ and fold_left_prim ctx ~want loc name p ok what args = in expect loc ~want acc +(* ── Allocation failure, spec-memory.md ──────────────────────────────── + No allocating operation returns an error and none can fail silently. When + the allocator cannot satisfy a request the operation signals + + (StorageExhausted {:bytes n :align a :allocator id}) + + with [error] — whose type is Never — inside a [restart-case] offering + [retry]. That is one rule over every allocating operation, which is what + keeps [push] and [reserve] at Unit, [clone] at the container, and no + signature anywhere growing a Result. Odin's [append] returns an ignorable + Allocator_Error and its type-erased path returns the old length on a failed + reserve; an append that appends nothing and says nothing is the outcome this + rule exists to make impossible. + + It is *compiler-emitted at the point of failure*, which spec-memory.md names + as the exception to plan.org's "restarts go at the resync point, once": a + restart established at a parser's top-level loop cannot re-attempt an + allocation, and only the allocation site can. + + The shape is built out of nodes that already exist — a while, a restart-case + and an error — so the backend learns nothing new about allocation: + + (let [ok false] + (while (not ok) + (restart-case + (do (set ok ATTEMPT) + (if (not ok) (error (StorageExhausted {...})))) + (retry [])))) + + A handler that frees something, releases a scratch region or grows the arena + and then invokes [retry] lands in the clause, the clause falls through, and + the while re-tests and re-attempts the *same* request. With nothing handling + it, [error] stops the program on the frame that erred, as §2 says. + + [attempt] must be a call that can be repeated: every argument to it is bound + to a slot before the loop, so a retry does not re-evaluate the element + expression a push was given. *) +and alloc_guard ctx loc (attempt : Tast.expr) = + let ok = fresh_slot ctx Types.Bool in + let okv = mk loc Types.Bool (Tast.Local ok) in + let notok () = mk loc Types.Bool (Tast.Prim (Tast.Not, [ okv ])) in + let i8 n = mk loc (Types.Int Types.I8) (Tast.Int (n, Types.I8)) in + (* The runtime answers 1 or 0 and never reports failure any other way. *) + let attempt = mk loc Types.Bool (Tast.Prim (Tast.Ne, [ attempt; i8 0L ])) in + (* A value struct on the signalling frame's stack, with fixed numeric fields + and no rendered message: formatting would allocate, and this is the one + path that must not. Rendering happens in the handler or the break loop, + where a working allocator is known. *) + let cond = + mk loc (Types.Named "StorageExhausted") + (Tast.Make + ("StorageExhausted", + [ rt loc (Types.Int Types.I64) "flan_alloc_fail_bytes" []; + rt loc (Types.Int Types.I64) "flan_alloc_fail_align" []; + rt loc (Types.Int Types.I64) "flan_alloc_fail_id" [] ])) + in + let signal = + mk loc Types.Never + (Tast.Signal (Tast.Serror, type_id "StorageExhausted", cond)) + in + let attempt_then_signal = + mk loc Types.Unit + (Tast.Do + [ mk loc Types.Unit (Tast.Set (Tast.Plocal ok, attempt)); + mk loc Types.Unit (Tast.If (notok (), signal, unit_at loc)) ]) + in + let clause = + (* Compiler-emitted, so it takes no parameters: nothing outside can hand + this one a value. [rsig] is therefore the empty signature, and its hash + the same one a written [(retry [] ...)] gets — the two must agree, since + an [invoke-restart] cannot tell them apart. *) + let sg = restart_sig [] in + { Tast.rname_id = type_id "retry"; rname = "retry"; rparams = []; + rsig = sg; rsig_id = type_id sg; rbody = [ unit_at loc ] } + in + let body = + mk loc Types.Unit (Tast.RestartCase ([ clause ], attempt_then_signal)) + in + mk loc Types.Unit + (Tast.Let ([ (ok, mk loc Types.Bool (Tast.Bool false)) ], + [ mk loc Types.Unit (Tast.While (notok (), [ body ])) ])) + +(* The element type for [vec-new]: a leading bare symbol naming a type, or the + expectation at the site. A bare symbol shadowed by a local or a global is + that binding — an allocator, in practice — and not a type. *) +and vec_new_elem ctx ~want loc args = + let named = + match args with + | { Ast.e = Ast.Var n; _ } :: rest + when lookup ctx n = None + && (not (Hashtbl.mem ctx.env.globals n)) + && (List.mem n Types.primitive_names + || Hashtbl.mem ctx.env.structs n + || Hashtbl.mem ctx.env.enums n + || Hashtbl.mem ctx.env.aliases n) -> + Some (resolve_name ctx.env ~seen:[] loc n, rest) + | _ -> None + in + match named with + | Some (t, rest) -> t, rest + | None -> + (match want with + | Some (Types.Vec t) -> t, args + | _ -> + fail loc + "nothing here says what (vec-new) is a Vec of — write the element \ + type, as (vec-new i32), or give the binding a type") + +(* The element type, or the reason this is not a Vec. *) +and vec_elem loc what (t : Types.t) = + match t with + | Types.Vec e -> e + | other -> fail loc "%s takes a (Vec T), found %s" what (Types.to_string other) + +(* The allocator an operation uses: the one named at the site, or the current + implicit one. spec-memory.md: an operation never falls back to a hidden + global allocator, and an explicit allocator can override the context. *) +and allocator_arg ctx loc = function + | [] -> rt loc Types.Alloc "flan_context_allocator" [] + | [ a ] -> check ctx ~want:Types.Alloc a + | _ -> fail loc "at most one allocator may be named here" + +(* The address of an element, bounds-checked, with the allocator's epoch + checked first. Both the value form [(at v i)] and the place form + [(set (at v i) x)] come through here, so they cannot drift apart — which is + the asymmetry [nth] was removed for. *) +and vec_at ctx loc (target : Tast.expr) (idx : Ast.expr list) = + let elem = vec_elem loc "at" target.Tast.ty in + match idx with + | [ i ] -> + let i = index_expr ctx i in + rt loc (Types.Ptr elem) "flan_vec_at" + [ target; i; size_of loc elem; here loc ], elem + | _ -> + fail loc + "a Vec takes exactly one index — (at v i) — and its element is indexed \ + separately" + and named_call ctx ~want loc name args = let prim p ty args = expect loc ~want (mk loc ty (Tast.Prim (p, args))) in match name with @@ -1305,21 +1607,311 @@ and named_call ctx ~want loc name args = fail loc "destructure~nth is written by the compiler and cannot be called") + (* ── allocators, spec-memory.md ────────────────────────────────── *) + (* Every one of these is an ordinary named call, which is the whole of the + escape NEXT.md describes: [check_call] already routes a named call through + here, so none of the four function-value refusals is anywhere near it. *) + (* A *user-written* allocator is the one thing in this tier that does need + milestone 5, and it is refused by name rather than left as an unknown + one. "Here is my proc, make an Allocator from it" needs a defn's name in + value position, which is the refusal a few hundred lines below this. The + built-in set needs nothing from milestone 5 because its procedures are C + symbols the emitter names and no Flan type mentions them. *) + | "make-allocator" | "allocator-from" | "allocator" -> + fail loc + "a user-written allocator is not implemented yet — milestone 5. It needs \ + a defn's name in value position, which is a function value; the \ + built-in allocators (heap-allocator, arena-new) need none of that \ + because their procedures are runtime symbols and no Flan type names \ + them" + | "heap-allocator" -> + arity loc name 0 args; + expect loc ~want + (mk loc Types.Alloc (Tast.Prim (Tast.Rt "flan_heap_allocator", []))) + (* The capacity is explicit and there is no growing backing store: an arena + whose size is decided by the program is one a program can reason about, + and it is the only shape under which "exhausted" is a state a test can + reach on purpose. *) + | "arena-new" -> + arity loc name 1 args; + let cap = check ctx ~want:(Types.Int Types.I64) (List.hd args) in + expect loc ~want + (mk loc Types.Alloc (Tast.Prim (Tast.Rt "flan_arena_new", [ cap ]))) + (* Hands the pages back, which [free-all] deliberately does not — see + BUILT.md, "free-all is retain-capacity". *) + | "arena-destroy" -> + arity loc name 1 args; + let a = check ctx ~want:Types.Alloc (List.hd args) in + expect loc ~want + (mk loc Types.Unit (Tast.Prim (Tast.Rt "flan_arena_destroy", [ a ]))) + (* One of spec-memory.md's two release points. It takes the source location + as a string so that an allocator with no region to release names the site + rather than the runtime. *) + | "free-all" -> + arity loc name 1 args; + let a = check ctx ~want:Types.Alloc (List.hd args) in + expect loc ~want + (mk loc Types.Unit + (Tast.Prim (Tast.Rt "flan_alloc_free_all", [ a; here loc ]))) + (* The capability set, read off the allocator value. Odin asks its procedure + (Query_Features returning an Allocator_Mode_Set); a field is the same + answer without the round trip, which is NEXT.md's call. *) + | "can-free?" -> + arity loc name 1 args; + let a = check ctx ~want:Types.Alloc (List.hd args) in + expect loc ~want + (mk loc Types.Bool + (Tast.Prim (Tast.Ne, + [ mk loc (Types.Int Types.I8) + (Tast.Prim (Tast.Rt "flan_alloc_can_free", [ a ])); + mk loc (Types.Int Types.I8) (Tast.Int (0L, Types.I8)) ]))) + | "can-free-all?" -> + arity loc name 1 args; + let a = check ctx ~want:Types.Alloc (List.hd args) in + expect loc ~want + (mk loc Types.Bool + (Tast.Prim (Tast.Ne, + [ mk loc (Types.Int Types.I8) + (Tast.Prim (Tast.Rt "flan_alloc_can_free_all", [ a ])); + mk loc (Types.Int Types.I8) (Tast.Int (0L, Types.I8)) ]))) + (* The counter [free-all] bumps. A container records it and traps if it + moved; this is the same number, readable, so a program can say what it + saw. *) + | "alloc-epoch" -> + arity loc name 1 args; + let a = check ctx ~want:Types.Alloc (List.hd args) in + expect loc ~want + (mk loc (Types.Int Types.I64) + (Tast.Prim (Tast.Rt "flan_alloc_epoch", [ a ]))) + (* The allocator's identity — its address — which is what the condition's + :allocator field carries, so a handler holding several regions can tell + which one ran out. *) + | "alloc-id" -> + arity loc name 1 args; + let a = check ctx ~want:Types.Alloc (List.hd args) in + expect loc ~want + (mk loc (Types.Int Types.I64) (Tast.Prim (Tast.Rt "flan_alloc_id", [ a ]))) + (* A ceiling on live bytes, 0 for none. spec-memory.md's retry restart is + answerable only by a handler that can make the *same* request succeed, and + for a fixed backing store the handler that works is the one that grows it: + releasing the region a container lives in invalidates the container, which + is what the epoch check catches. So the spec's "grows the arena and then + invokes retry" needs a ceiling to raise, and this is it. It is also how a + program exhausts an allocator on purpose. *) + | "alloc-budget" -> + arity loc name 1 args; + let a = check ctx ~want:Types.Alloc (List.hd args) in + expect loc ~want + (mk loc (Types.Int Types.I64) + (Tast.Prim (Tast.Rt "flan_alloc_budget", [ a ]))) + | "set-alloc-budget" -> + arity loc name 2 args; + (match args with + | [ a; n ] -> + let a = check ctx ~want:Types.Alloc a in + let n = check ctx ~want:(Types.Int Types.I64) n in + expect loc ~want + (mk loc Types.Unit (Tast.Prim (Tast.Rt "flan_alloc_set_budget", [ a; n ]))) + | _ -> assert false) + (* "Did you forget to free" is an allocator-tier question and this is the + tier answering it — spec-memory.md, "Leaking is defined behaviour". *) + | "alloc-live-blocks" -> + arity loc name 1 args; + let a = check ctx ~want:Types.Alloc (List.hd args) in + expect loc ~want + (mk loc (Types.Int Types.I64) + (Tast.Prim (Tast.Rt "flan_alloc_live_blocks", [ a ]))) + (* (with-allocator A BODY...). It rebinds and releases nothing: not at the + end of the body, not anywhere. spec-memory.md is explicit that this is not + a scope-end release point and that it is the point on which Odin's + [defer delete] and Carp's scope-end frees were both rejected. *) + | "with-allocator" -> + (match args with + | [] -> fail loc "with-allocator is (with-allocator allocator body ...)" + | a :: body -> + let a = check ctx ~want:Types.Alloc a in + let body, ty = + scoped ctx (fun () -> + match body with + | [] -> [ unit_at loc ], Types.Unit + | _ -> + let rec go = function + | [ last ] -> let l = check ctx ?want last in [ l ], l.Tast.ty + | e :: rest -> + let e = check ctx e in + let rest, ty = go rest in + e :: rest, ty + | [] -> assert false + in + go body) + in + expect loc ~want (mk loc ty (Tast.WithAlloc (a, body)))) + + (* ── (Vec T), spec-memory.md ───────────────────────────────────── *) + (* Every one of these is a named call over a type-erased runtime, with + size_of and align_of produced here because here is where the concrete + element type is known. No generics are involved and none are needed. *) + (* (vec-new), (vec-new T), (vec-new a), (vec-new T a). + [let] has no type annotation — parse.ml settles that a triple binding is + ambiguous and types are inferred — so a local Vec has nowhere to say what + it holds, and the element type is written at the call instead. This is not + the explicit instantiation syntax the generics section rules out: nothing + here is generic, and the name is resolved as an ordinary type, not bound + to a type variable. Where the context does say — a defvar's type, a + function's return type, an argument — it is not needed and may be left + out. *) + | "vec-new" -> + let elem, args = vec_new_elem ctx ~want loc args in + let a = allocator_arg ctx loc args in + let v = fresh_slot ctx (Types.Vec elem) in + let attempt = + rt loc (Types.Int Types.I8) "flan_vec_init" + [ mk loc (Types.Vec elem) (Tast.Local v); a; i64_at loc 0L; + size_of loc elem; align_of loc elem; here loc ] + in + expect loc ~want + (mk loc (Types.Vec elem) + (Tast.Let ([ (v, mk loc (Types.Vec elem) (Tast.Zero (Types.Vec elem))) ], + [ alloc_guard ctx loc attempt; + mk loc (Types.Vec elem) (Tast.Local v) ]))) + (* Unit, not a Result and not an ignorable error code: see [alloc_guard]. *) + | "push" -> + arity loc name 2 args; + (match args with + | [ target; x ] -> + let target = borrowed ctx target (fun () -> check ctx target) in + let elem = vec_elem loc "push" target.Tast.ty in + let x = check ctx ~want:elem x in + (* The element is bound before the loop so that a [retry] re-attempts + the allocation and not the expression that produced the value. *) + let e = fresh_slot ctx elem in + let attempt = + rt loc (Types.Int Types.I8) "flan_vec_push" + [ target; addr_of loc (mk loc elem (Tast.Local e)); + size_of loc elem; align_of loc elem; here loc ] + in + expect loc ~want + (mk loc Types.Unit + (Tast.Let ([ (e, x) ], [ alloc_guard ctx loc attempt ]))) + | _ -> assert false) + | "reserve" -> + arity loc name 2 args; + (match args with + | [ target; n ] -> + let target = borrowed ctx target (fun () -> check ctx target) in + let elem = vec_elem loc "reserve" target.Tast.ty in + let n = check ctx ~want:index_ty n in + let n64 = + mk loc (Types.Int Types.I64) (Tast.Prim (Tast.Cast (Types.Int Types.I64), [ n ])) + in + let attempt = + rt loc (Types.Int Types.I8) "flan_vec_reserve" + [ target; n64; size_of loc elem; align_of loc elem; here loc ] + in + expect loc ~want (alloc_guard ctx loc attempt) + | _ -> assert false) + (* (as-slice v) and (as-slice v lo hi) — spec-memory.md, "Borrowing". The + result is a non-owning view: copying it copies ptr+len and never the + elements, and it carries no allocator, so freeing through one is not + expressible. A push, a put or a reserve may invalidate it; that is the + explicit Zig/Odin contract the spec chose over a borrow checker. *) + | "as-slice" -> + (match args with + | target :: rest when List.length rest = 0 || List.length rest = 2 -> + let target = borrowed ctx target (fun () -> check ctx target) in + let elem = vec_elem loc "as-slice" target.Tast.ty in + let lo, hi = + match rest with + | [] -> + mk loc index_ty (Tast.Int (0L, Types.I32)), + (* -1 is "to the end": (as-slice v) has no static length to pass. *) + mk loc index_ty (Tast.Int (-1L, Types.I32)) + | [ lo; hi ] -> index_expr ctx lo, index_expr ctx hi + | _ -> assert false + in + let out = fresh_slot ctx (Types.Slice elem) in + let fill = + rt loc Types.Unit "flan_vec_as_slice" + [ target; addr_of loc (mk loc (Types.Slice elem) (Tast.Local out)); + lo; hi; size_of loc elem; here loc ] + in + expect loc ~want + (mk loc (Types.Slice elem) + (Tast.Let ([ (out, mk loc (Types.Slice elem) + (Tast.Zero (Types.Slice elem))) ], + [ fill; mk loc (Types.Slice elem) (Tast.Local out) ]))) + | _ -> fail loc "as-slice is (as-slice v) or (as-slice v lo hi)") + (* spec-memory.md's first release point. It consumes its argument exactly as + any other move does — the source binding is dead afterwards and using it + is a compile error — which is the rule that already makes a double free + unrepresentable, so [free] needs no analysis of its own. *) + | "free" -> + arity loc name 1 args; + let target = check ctx (List.hd args) in + (match target.Tast.ty with + | Types.Vec elem -> + expect loc ~want + (rt loc Types.Unit "flan_vec_free" + [ target; size_of loc elem; align_of loc elem; here loc ]) + | other -> + (* A field is never freed on its own: it would leave its owner partly + dead with no way to say so. *) + fail loc + "free takes a move-only value — a Vec, or a struct that owns one — \ + found %s. A resource type with a drop hook is step 5 and does not \ + exist yet" + (Types.to_string other)) + (* (clone v) uses the current allocator, (clone v a) names one. A deep, + independent copy: spec-memory.md's "copying is always explicit". *) + | "clone" -> + (match args with + | target :: rest when List.length rest <= 1 -> + let target = borrowed ctx target (fun () -> check ctx target) in + let elem = vec_elem loc "clone" target.Tast.ty in + let a = allocator_arg ctx loc rest in + let d = fresh_slot ctx (Types.Vec elem) in + let attempt = + rt loc (Types.Int Types.I8) "flan_vec_clone" + [ mk loc (Types.Vec elem) (Tast.Local d); target; a; + size_of loc elem; align_of loc elem; here loc ] + in + expect loc ~want + (mk loc (Types.Vec elem) + (Tast.Let ([ (d, mk loc (Types.Vec elem) (Tast.Zero (Types.Vec elem))) ], + [ alloc_guard ctx loc attempt; + mk loc (Types.Vec elem) (Tast.Local d) ]))) + | _ -> fail loc "clone is (clone v) or (clone v allocator)") + (* ── containers ────────────────────────────────────────────────── *) + (* [at] and [len] were already the names for a fixed array and a slice, so a + Vec extends them rather than adding a parallel pair — which is the + asymmetry [nth] was removed for. A Vec's length is i32 like every other + length here (index_ty): widening indices is one change across all of them + and not a Vec question. *) | "len" -> arity loc name 1 args; - let a = check ctx (List.hd args) in + let target = List.hd args in + let a = borrowed ctx target (fun () -> check ctx target) in (match a.Tast.ty with - | Types.Array _ | Types.Slice _ | Types.String -> () - | other -> fail loc "len takes an array, a slice or a string, found %s" - (Types.to_string other)); - prim Tast.Len index_ty [ a ] + | Types.Array _ | Types.Slice _ | Types.String -> + prim Tast.Len index_ty [ a ] + | Types.Vec _ -> + let n = rt loc (Types.Int Types.I64) "flan_vec_len" [ a; here loc ] in + expect loc ~want (mk loc index_ty (Tast.Prim (Tast.Cast index_ty, [ n ]))) + | other -> + fail loc "len takes an array, a slice, a string or a Vec, found %s" + (Types.to_string other)) | "at" -> (match args with | target :: idx when idx <> [] -> - let target = check ctx target in - let idx, ty = indexed ctx target idx in - prim Tast.At ty (target :: idx) + let target = borrowed ctx target (fun () -> check ctx target) in + (match target.Tast.ty with + | Types.Vec _ -> + let p, elem = vec_at ctx loc target idx in + expect loc ~want (mk loc elem (Tast.Deref p)) + | _ -> + let idx, ty = indexed ctx target idx in + prim Tast.At ty (target :: idx)) | _ -> fail loc "%s is (%s collection index ...)" name name) | "slice" -> arity loc name 3 args; @@ -1462,7 +2054,11 @@ and named_call ctx ~want loc name args = nested, which is why it lives here and not in the walk. *) | "print" | "println" -> arity loc name 1 args; - let a = check ctx (List.hd args) in + (* Printing is a read, not a move: the walk goes over the value and keeps + nothing. Without this, (println v) would consume a Vec and every + printing of one would be its last. *) + let target = List.hd args in + let a = borrowed ctx target (fun () -> check ctx target) in let bslice = Types.Slice (Types.Int Types.U8) in let write x = mk loc Types.Unit (Tast.Prim (Tast.WriteStdout, [ x ])) in let conv pr x = mk loc bslice (Tast.Prim (pr, [ x ])) in @@ -1762,8 +2358,29 @@ let collect env (decls : Ast.decl list) = let names = List.map (fun (f : Ast.field) -> f.Ast.fname) fs in if List.length (List.sort_uniq compare names) <> List.length names then fail loc "%s declares the same field twice" n; - Hashtbl.replace env.structs n - { Tast.sname = n; fields = List.map field fs } + let fields = List.map field fs in + (* spec-memory.md: "Ownership is structural, not declared" — a struct + containing a Vec is itself move-only, and freeing one recurses into + its owning fields while (free (.items b)) is refused because it + would leave the owner partly dead. None of that transitive + machinery exists yet: it is the same recursive teardown [drop] + brings, and it lands with it. Until then the field is refused at + the declaration, where the message can say so, rather than + accepted into a struct that copies its header on assignment and + gives two owners one buffer. *) + List.iter + (fun (f : Tast.field) -> + if Types.is_move_only f.Tast.fty then + fail loc + "%s's field %s is %s, which is move-only, and a struct that \ + owns one is move-only too — transitively, with recursive \ + teardown and with a field that cannot be freed on its own. \ + That rule arrives with drop (step 5 in NEXT.md); until then \ + hold the %s in a local and pass it" + n f.Tast.fname (Types.to_string f.Tast.fty) + (Types.to_string f.Tast.fty)) + fields; + Hashtbl.replace env.structs n { Tast.sname = n; fields } | Ast.Defunion (n, vs) -> Hashtbl.replace env.unions n { Tast.uname = n; @@ -1794,7 +2411,7 @@ let collect env (decls : Ast.decl list) = run without swallowing it. *) let infer (_, v) = (check { env; ret = Types.Unit; slots = 0; slot_tys = []; slot_names = []; scope = []; defers = []; - outer = []; in_handler = false; in_frames = None; in_defer = false; owner = "" } v).Tast.ty + outer = []; in_handler = false; in_frames = None; in_defer = false; dead = []; borrow = false; owner = "" } v).Tast.ty in let pending = ref (List.rev !untyped) in let rec settle () = @@ -1847,7 +2464,7 @@ let check_finite env = let check_fn env (fn : Ast.fn) : Tast.fn = let params, ret = Hashtbl.find env.fns fn.Ast.name in let ctx = { env; ret; slots = 0; slot_tys = []; slot_names = []; scope = []; defers = []; - outer = []; in_handler = false; in_frames = None; in_defer = false; + outer = []; in_handler = false; in_frames = None; in_defer = false; dead = []; borrow = false; owner = fn.Ast.name } in List.iter2 (fun (p : Ast.field) ty -> @@ -1921,12 +2538,29 @@ let check_fn env (fn : Ast.fn) : Tast.fn = normal path has them spliced into [body] above. *) ret; body; fdefers = ctx.defers; fparent = None; floc = fn.Ast.nloc } +(* A global of move-only type is refused. The dead set is per function, so two + functions each freeing the same global is a double free nothing here could + see; and within one function a global read does not go through [var]'s move + path at all, so even the local case would be accepted. Rather than half a + rule, the type is refused where it is declared. A global *Allocator* is not + this — an allocator is a copyable opaque handle — which is what makes the + handler-owns-the-arena shape in exhausted.flan expressible. *) +let no_move_only_global loc n (ty : Types.t) = + if Types.is_move_only ty then + fail loc + "the global %s is %s, which is move-only, and ownership of a global \ + cannot be tracked: the dead set is per function, so two functions each \ + freeing it is a double free nothing would catch. Hold it in a local and \ + pass it, or hold the allocator globally instead" + n (Types.to_string ty) + let check_global env (d : Ast.decl) : Tast.global option = let ctx () = { env; ret = Types.Unit; slots = 0; slot_tys = []; slot_names = []; scope = []; defers = []; - outer = []; in_handler = false; in_frames = None; in_defer = false; owner = "" } in + outer = []; in_handler = false; in_frames = None; in_defer = false; dead = []; borrow = false; owner = "" } in match d.Ast.d with | Ast.Defvar (n, _, init) -> let ty, _ = Hashtbl.find env.globals n in + no_move_only_global d.Ast.dloc n ty; let ginit = match init with | Ast.Zeroed -> { Tast.e = Tast.Zero ty; ty; loc = d.Ast.dloc } @@ -1936,6 +2570,7 @@ let check_global env (d : Ast.decl) : Tast.global option = Some { Tast.gname = n; gty = ty; ginit; gconst = false; gfolded = false } | Ast.Defconst (n, _, v) -> let ty, _ = Hashtbl.find env.globals n in + no_move_only_global d.Ast.dloc n ty; (* [collect] already folded the integer constants, because an array length has to be known before any type resolves. Use that value here rather than the expression it came from: a global's initialiser has to be a @@ -2033,7 +2668,7 @@ let expression env (e : Ast.expr) : Tast.expr * Types.t array * string option array = let ctx = { env; ret = Types.Unit; slots = 0; slot_tys = []; slot_names = []; scope = []; defers = []; - outer = []; in_handler = false; in_frames = None; in_defer = false; owner = "" } + outer = []; in_handler = false; in_frames = None; in_defer = false; dead = []; borrow = false; owner = "" } in let t = check ctx e in (t, Array.of_list (List.rev ctx.slot_tys), diff --git a/lib/emit.ml b/lib/emit.ml index d13093a..f5194cf 100644 --- a/lib/emit.ml +++ b/lib/emit.ml @@ -93,6 +93,15 @@ let rec ll (t : Types.t) = | Types.Enum _ -> "i32" | Types.Array (n, e) -> Printf.sprintf "[%Ld x %s]" n (ll e) | Types.Ptr _ -> "ptr" + (* An [Allocator] is a pointer to the runtime's [flan_allocator] and never a + copy of one: see Types. Opaque here in the same sense [ptr] is. *) + | Types.Alloc -> "ptr" + (* ptr + len + cap + allocator, and two more words the runtime owns: see + flan_rt.c's (Vec T) header for why they are in every build. Nothing in + this file reads a field of one — every operation is a runtime call taking + the Vec's address — so the shape is here only so that a slot, a struct + field and a copy in the IR are the right number of bytes. *) + | Types.Vec _ -> "%vec" | Types.Option e -> Printf.sprintf "{ i8, %s }" (ll e) | Types.Map _ | Types.Fn _ | Types.Var _ -> (* The checker rejects each of these by name — nothing reaches here. *) @@ -229,6 +238,8 @@ let rec lay m (t : Types.t) : int * int = | Types.Unit | Types.Never -> 0, 1 | Types.Enum _ -> 4, 4 | Types.Ptr _ -> 8, 8 + | Types.Alloc -> 8, 8 + | Types.Vec _ -> 48, 8 (* [n x T] adds no padding of its own: T's size already carries its tail. *) | Types.Array (n, e) -> let s, a = lay m e in Int64.to_int n * s, a | Types.Option e -> let s, a, _ = lay_fields m [ Types.Int Types.I8; e ] in s, a @@ -344,6 +355,20 @@ let rec dty m d (t : Types.t) : int = (List.map (fun (fl : Tast.field) -> (fl.Tast.fname, fl.Tast.fty)) st.Tast.fields) | None -> failwith ("no debug type for struct " ^ sn)) + (* An opaque pointer under lldb, which is the truth: the allocator's + fields are the runtime's C and lldb already has that type from + flan_rt.c's own debug info. *) + | Types.Alloc -> + dnode d + "!DIDerivedType(tag: DW_TAG_pointer_type, name: \"Allocator\", baseType: null, size: 64)" + (* Shown as what it is. The two dev words are in the layout and so they + are here too: a debugger that showed four fields of a six-field struct + would put the reader's offsets out by two. *) + | Types.Vec e -> + composite (Types.to_string t) + [ ("ptr", Types.Ptr e); ("len", Types.Int Types.I64); + ("cap", Types.Int Types.I64); ("allocator", Types.Alloc); + ("gen", Types.Int Types.I64); ("epoch", Types.Int Types.I64) ] | Types.Map _ | Types.Fn _ | Types.Var _ -> failwith ("no debug type for " ^ Types.to_string t) in @@ -635,6 +660,7 @@ and value_at f (e : Tast.expr) : string = "zeroinitializer" | Tast.Handled (frames, body) -> emit_handled f frames body | Tast.RestartCase (clauses, body) -> emit_restart_case f e.Tast.ty clauses body + | Tast.WithAlloc (a, body) -> emit_with_alloc f e.Tast.ty a body (* §4's lookup, then the transfer itself: the frame that was found goes into the channel and this function leaves through its landing block. Type Never, so nothing follows. *) @@ -960,6 +986,45 @@ and restart_field f slot i = ins f "%s = getelementptr inbounds %%restart, ptr %s, i32 0, i32 %d" p slot i; p +(* (with-allocator A BODY...) — spec-memory.md's "Allocators". + + Save, run, restore, and *restore again at the pad*. The second restore is + the whole reason this is a node rather than a let and two calls: a body that + errors, or one a handler transfers out of, leaves through [current_pad], and + a context allocator left pointing into a region nobody outside the body has + heard of would be wrong in the break loop, which is exactly where someone is + about to allocate to render a condition. + + It releases nothing, per the spec: the region this names is released, if + ever, by an explicit [free-all] somewhere else. *) +and emit_with_alloc f ty (a : Tast.expr) body = + let av = value f a in + let prev = fresh f in + ins f "%s = call ptr @flan_context_set(ptr %s)" prev av; + let result = if is_void ty then None else Some (alloca f ty) in + let ld = fresh_label f "endwith" in + let pad = fresh_label f "wxfer" and used = ref false in + let reached = ref false in + f.pads <- (pad, used) :: f.pads; + let v = block f body in + f.pads <- List.tl f.pads; + if f.live then begin + ins f "call void @flan_context_restore(ptr %s)" prev; + (match result with + | Some r -> ins f "store %s %s, ptr %s" (ll ty) v r + | None -> ()); + reached := true; + term f "br label %%%s" ld + end; + label f pad; + ins f "call void @flan_context_restore(ptr %s)" prev; + term f "br label %%%s" (current_pad f); + if not !reached then begin f.live <- false; "zeroinitializer" end + else begin + label f ld; + match result with Some r -> load f r ty | None -> "zeroinitializer" + end + (* (restart-case BODY (name [p T] BODY-1) ...) — §3, §4 and §6 together. One frame per clause, so that the frame a transfer names says which clause @@ -1363,6 +1428,38 @@ and prim f (e : Tast.expr) (p : Tast.prim) (args : Tast.expr list) = let tmp = alloca f (Types.Slice Types.String) in ins f "call void @flan_argv(ptr %s)" tmp; load f tmp (Types.Slice Types.String) + (* One arm for every runtime entry point the allocator and container runtime + has. The result type is the node's own and the argument types are the + arguments' own, so nothing here has to know which symbol it is calling. *) + | Tast.Rt sym, args -> + let vs = + List.concat + (map_lr + (fun (a : Tast.expr) -> + match a.Tast.ty with + | Types.String | Types.Slice _ -> + let p, n = explode f a in + [ "ptr " ^ p; "i64 " ^ n ] + | Types.Unit | Types.Never -> [] + (* A Vec is move-only and never copied, so it crosses to the + runtime as its address — which is also what lets an operation + mutate the caller's Vec in place. *) + | Types.Vec _ -> [ "ptr " ^ addr f a ] + | t -> [ ll t ^ " " ^ value f a ]) + args) + in + let args' = String.concat ", " vs in + if is_void e.Tast.ty then begin + ins f "call void @%s(%s)" sym args'; + "zeroinitializer" + end else begin + let t = fresh f in + ins f "%s = call %s @%s(%s)" t (ll e.Tast.ty) sym args'; + t + end + | Tast.SizeOf t, [] -> Printf.sprintf "%d" (fst (lay f.md t)) + | Tast.AlignOf t, [] -> Printf.sprintf "%d" (snd (lay f.md t)) + | Tast.AddrOf, [ x ] -> addr f x | Tast.Cast target, [ x ] -> cast f x target | _ -> failwith "malformed primitive" @@ -1654,6 +1751,9 @@ let header = {|; Generated by flan. The layout is C's: no object headers anywher ; so a Flan struct is exactly its C struct and nothing marshals. %slice = type { ptr, i64 } +; (Vec T), spec-memory.md. The element type is nowhere in it: the runtime is +; type-erased and every operation is handed size and align at its call site. +%vec = type { ptr, i64, i64, ptr, i64, i64 } ; A handler frame: the one it displaced, the condition type it matches, and ; the lifted function that runs. Allocated on the establishing frame's stack. %handler = type { ptr, i32, ptr } @@ -1693,6 +1793,32 @@ declare void @flan_restart_unarmed(ptr, i64, ptr, i64, ptr, i64) noreturn cold declare void @flan_transfer_fail(ptr, i64) noreturn cold declare void @flan_bounds_fail(ptr, i64, i64, i64) noreturn cold declare void @flan_slice_fail(ptr, i64, i64, i64, i64) noreturn cold +declare ptr @flan_context_allocator() +declare ptr @flan_context_temp() +declare ptr @flan_heap_allocator() +declare ptr @flan_context_set(ptr) +declare void @flan_context_restore(ptr) +declare ptr @flan_arena_new(i64) +declare void @flan_arena_destroy(ptr) +declare void @flan_alloc_free_all(ptr, ptr, i64) +declare i8 @flan_alloc_can_free(ptr) +declare i8 @flan_alloc_can_free_all(ptr) +declare i64 @flan_alloc_epoch(ptr) +declare i64 @flan_alloc_live_blocks(ptr) +declare i64 @flan_alloc_id(ptr) +declare i64 @flan_alloc_fail_bytes() +declare i64 @flan_alloc_fail_align() +declare i64 @flan_alloc_fail_id() +declare i64 @flan_alloc_budget(ptr) +declare void @flan_alloc_set_budget(ptr, i64) +declare i8 @flan_vec_init(ptr, ptr, i64, i64, i64, ptr, i64) +declare i8 @flan_vec_reserve(ptr, i64, i64, i64, ptr, i64) +declare i8 @flan_vec_push(ptr, ptr, i64, i64, ptr, i64) +declare i8 @flan_vec_clone(ptr, ptr, ptr, i64, i64, ptr, i64) +declare i64 @flan_vec_len(ptr, ptr, i64) +declare ptr @flan_vec_at(ptr, i32, i64, ptr, i64) +declare void @flan_vec_as_slice(ptr, ptr, i32, i32, i64, ptr, i64) +declare void @flan_vec_free(ptr, i64, i64, ptr, i64) |} (* C's main, adapting to whichever of the four shapes Flan's main has: argv and diff --git a/lib/parse.ml b/lib/parse.ml index 8b708e3..229dd93 100644 --- a/lib/parse.ml +++ b/lib/parse.ml @@ -326,7 +326,7 @@ and form f mk (head : Form.t) (args : Form.t list) : Ast.expr = [find-restart] and [compute-restarts] are §4's two ways to look at the restart stack without committing to one. *) | "find-restart" | "compute-restarts" - | "errdefer" | "with-allocator" | "loop" | "recur" + | "errdefer" | "loop" | "recur" (* plan.org's loop story is settled as imperative while/for with these two and [return]. Neither exists, and both *alter control flow* — the first thing the house rule says must be recognised explicitly. diff --git a/lib/prelude.ml b/lib/prelude.ml index fe39163..6aed562 100644 --- a/lib/prelude.ml +++ b/lib/prelude.ml @@ -31,6 +31,19 @@ it actually holds. *) let source = {flan| +;; The condition every allocating operation signals when the allocator cannot +;; satisfy a request — spec-memory.md, "Allocation failure". It is here rather +;; than built by the checker because it is an ordinary value struct and the +;; checker already knows how to build one of those; nothing about it is +;; special except who signals it. +;; +;; Fixed numeric fields and no rendered message, because formatting would +;; allocate and this is the one path that must not. :allocator is the +;; allocator's address, which is its identity — the same thing the epoch hangs +;; off — so a handler can tell which region ran out. Rendering happens in the +;; handler or the break loop, where a working allocator is known. +(defstruct StorageExhausted [bytes i64 align i64 allocator i64]) + ;; A seeded PRNG in Flan rather than libc's, because a grid hash is only a ;; regression test if the sequence is byte-identical on native and wasm32 ;; (plan.org, RNG is ours). PCG-XSH-RR 32: one u64 LCG step per draw, folded diff --git a/lib/reach.ml b/lib/reach.ml index 8520616..03f9969 100644 --- a/lib/reach.ml +++ b/lib/reach.ml @@ -64,6 +64,7 @@ let rec expr_refs f (e : Tast.expr) = | Tast.RestartCase (cs, body) -> List.iter (fun (c : Tast.rclause) -> gos c.Tast.rbody) cs; go body + | Tast.WithAlloc (a, body) -> go a; gos body and place_refs f (p : Tast.place) = match p with diff --git a/lib/render.ml b/lib/render.ml index 034a64b..ec3fe2a 100644 --- a/lib/render.ml +++ b/lib/render.ml @@ -110,6 +110,14 @@ let rec render c depth (e : Tast.expr) : Tast.expr list = thing that could make this walk cycle, and dereferencing one a REPL was handed is not a safe thing to do on someone's behalf. *) | Types.Ptr _ -> [ lit "" ] + (* Opaque on purpose, and for the same reason: its contents are the + runtime's, its address is not stable across runs, and printing either + would make an acceptance test's output depend on the heap. *) + | Types.Alloc -> [ lit "" ] + (* Printing a Vec structurally would be a walk over storage this function + does not own, and the walk is what [as-slice] is for: (print (as-slice + v)) prints the elements and says at the call site that it borrowed. *) + | Types.Vec _ -> [ lit "" ] | Types.Option t -> let tag = { Tast.e = Tast.Field (e, 0); ty = Types.Int Types.I8; loc } in let some = { Tast.e = Tast.Field (e, 1); ty = t; loc } in diff --git a/lib/shim.ml b/lib/shim.ml index 7367938..b9bfbee 100644 --- a/lib/shim.ml +++ b/lib/shim.ml @@ -217,6 +217,15 @@ let rec cty env ~needed ~loc ~what (t : Ast.texpr) : string = declare (Ptr T) and say which" what | Ast.Tmap _ -> fail loc "%s is a map, which has no C representation" what + (* A Vec owns its storage, so handing its header to C hands out an owner and + there is no rule for what C would then be allowed to do with it. The + elements cross the way any other run of elements does. *) + | Ast.Tapp ("Vec", _) -> + fail loc + "%s is a Vec, which owns its storage — handing its header to C hands out \ + an owner. Pass (as-slice v) as (Ptr T) and (len v), the same shape a \ + slice crosses in" + what | Ast.Tfn _ -> fail loc "%s is a function type, and a C callback is not implemented" what | Ast.Tapp (n, _) -> diff --git a/lib/tast.ml b/lib/tast.ml index 5b99033..709d2e2 100644 --- a/lib/tast.ml +++ b/lib/tast.ml @@ -36,6 +36,27 @@ type prim = string nested inside a printed structure. *) | U64ToBytes | EscapeBytes | WriteStdout | Exit | Argv + (* A call into the runtime's C, named by symbol. The argument and result + LLVM types come off the expression nodes themselves, so one constructor + covers every entry point the allocator and container runtime has and the + backend grows one arm rather than one per operation — which matters + because spec-memory.md's runtime is type-erased and therefore *is* a list + of C entry points. A string or slice argument crosses as ptr+len, the + same rule as every other shim here. No transfer guard follows one: a + transfer cannot cross a C frame. *) + | Rt of string + (* spec-memory.md, "Alignment": a property of the type, computed at the call + site, passed as a parameter to the type-erased allocator — all three, and + they are not alternatives. The checker builds these at the site where the + concrete element type is known and the backend fills in the number from + the same layout calculator DWARF uses. *) + | SizeOf of Types.t + | AlignOf of Types.t + (* The address of any expression, not only of a place: the element a [push] + copies may be a computed value, and the runtime takes it by pointer + because it is type-erased. The backend already spills a non-place to a + temporary for exactly this. *) + | AddrOf | Cast of Types.t type expr = { e : expr_kind; ty : Types.t; loc : Loc.t } @@ -93,6 +114,12 @@ and expr_kind = their hash — §3's run-time check, since the name is resolved on a stack nothing static can see. *) | RestartCase of rclause list * expr + (* (with-allocator A BODY...) — spec-memory.md. It rebinds the current + allocator for its dynamic extent and releases nothing. Its own node + because the restore has to happen on the *transfer* path too: a body that + errors, or a restart taken from inside it, must not leave the context + allocator pointing at a region the handler knows nothing about. *) + | WithAlloc of expr * expr list (* name id, name, arguments, their spelling, its hash, where *) | InvokeRestart of int * string * expr list * string * int * Loc.t diff --git a/lib/types.ml b/lib/types.ml index ef1ef27..293c476 100644 --- a/lib/types.ml +++ b/lib/types.ml @@ -30,6 +30,20 @@ type t = | Array of int64 * t (* [n T] inline, a value, copies *) | Map of t * t (* {K V} *) | Ptr of t (* (Ptr T) *) + (* [Allocator]: a builtin opaque type, the way [string] is a builtin + ptr+len. It is a [Types.t] case with no user-writable constructor, which + is what lets spec-memory.md's "procedure plus an opaque data pointer" be + expressed with none of milestone 5's function values — the procedure is a + C symbol the emitter names and no Flan type ever mentions it. At run time + it is a pointer to the runtime's [flan_allocator], never a copy of one: + the capability set and the epoch have to be shared by every container + made from it, and a copy would give each its own. *) + | Alloc + (* [(Vec T)]: ptr + len + cap + allocator, owning and move-only. One + type-erased runtime over (size, align) stands behind every instantiation, + so this is a container without generics — the concrete type is known only + at the call site, which is exactly where the two numbers are produced. *) + | Vec of t | Option of t (* (Option T) *) | Fn of t list * t (* (Fn [T ...] R) *) | Var of string (* a type variable — milestone 5 *) @@ -55,7 +69,7 @@ let fkind_of_name = function near-miss can be reported as the typo it is. *) let primitive_names = [ "i8"; "i16"; "i32"; "i64"; "u8"; "u16"; "u32"; "u64"; - "f32"; "f64"; "bool"; "string"; "Unit"; "Never" ] + "f32"; "f64"; "bool"; "string"; "Unit"; "Never"; "Allocator" ] let ikind_name k = (if signed k then "i" else "u") ^ string_of_int (bits k) @@ -75,6 +89,8 @@ let rec equal a b = | Array (n, x), Array (m, y) -> Int64.equal n m && equal x y | Map (k, v), Map (k', v') -> equal k k' && equal v v' | Ptr x, Ptr y -> equal x y + | Alloc, Alloc -> true + | Vec x, Vec y -> equal x y | Option x, Option y -> equal x y | Fn (ps, r), Fn (ps', r') -> List.length ps = List.length ps' @@ -95,6 +111,8 @@ let rec to_string = function | Array (n, t) -> Printf.sprintf "[%Ld %s]" n (to_string t) | Map (k, v) -> Printf.sprintf "{%s %s}" (to_string k) (to_string v) | Ptr t -> "(Ptr " ^ to_string t ^ ")" + | Alloc -> "Allocator" + | Vec t -> "(Vec " ^ to_string t ^ ")" | Option t -> "(Option " ^ to_string t ^ ")" | Fn (ps, r) -> Printf.sprintf "(Fn [%s] %s)" @@ -103,6 +121,17 @@ let rec to_string = function let is_numeric = function Int _ | Float _ -> true | _ -> false +(* Move-only: binding, passing or returning one transfers ownership and the + source binding is dead afterwards (spec-memory.md, "The four container + types"). That rule is what makes a double free unrepresentable, which is why + [free] needs no analysis of its own. A struct that owns one is move-only + too; that arrives with [drop], which is the step after this one. *) +let rec is_move_only = function + | Vec _ -> true + | Option t -> is_move_only t + | Array (_, t) -> is_move_only t + | _ -> false + (* Ordering and equality are defined on machine types and on nothing else at milestone 2 — strings, structs and slices have no built-in [=], because an unconstrained type supports only what every type supports (plan.org, Types). *) diff --git a/runtime/flan_rt.c b/runtime/flan_rt.c index 3b8fb33..2f4f528 100644 --- a/runtime/flan_rt.c +++ b/runtime/flan_rt.c @@ -454,3 +454,544 @@ _Noreturn void flan_slice_fail(const uint8_t *loc, int64_t loclen, (long long)len); rt_die(); } + +/* ── Allocators, spec-memory.md ──────────────────────────────────────── + * + * One type-erased procedure plus an opaque data pointer, which is Odin's + * shape (base/runtime/core.odin, Allocator_Proc), and every operation takes + * size and align as parameters because the only place the concrete type is + * known is the call site. + * + * A Flan `Allocator` value is a *pointer* to one of these, not a copy of it. + * That is forced by two things in the spec and is not a convenience: the + * capability set has to be readable at run time from wherever a container + * landed, and `free-all` bumps an epoch that every container made from the + * allocator has to observe. A copied-by-value allocator would give each copy + * its own epoch and the dev trap would never fire. + * + * Nothing here returns a struct by value, per the file header. + */ + +enum { + FLAN_ALLOC_ALLOC = 0, + FLAN_ALLOC_RESIZE = 1, + FLAN_ALLOC_FREE = 2, + FLAN_ALLOC_FREE_ALL = 3 +}; + +/* The capability set. Odin reads its own back through the procedure + * (Query_Features returning an Allocator_Mode_Set); a field is the same + * information without the round trip, and `can-free` is the one that is + * load-bearing — spec-memory.md refuses a drop-carrying container against an + * allocator that lacks it. */ +enum { + FLAN_CAN_ALLOC = 1u << 0, + FLAN_CAN_RESIZE = 1u << 1, + FLAN_CAN_FREE = 1u << 2, + FLAN_CAN_FREE_ALL = 1u << 3 +}; + +typedef struct flan_allocator flan_allocator; + +/* Returns NULL on failure and never reports failure any other way. The + * condition, the restart and the message are all the compiler's job; this + * layer says yes or no. */ +typedef void *(*flan_alloc_proc)(flan_allocator *a, int32_t mode, void *p, + int64_t old_size, int64_t size, int64_t align); + +struct flan_allocator { + flan_alloc_proc proc; + void *data; + uint32_t caps; + /* Bumped on every free-all. A container records it and traps if it moved: + * spec-memory.md, "Dev builds detect a released region". Separate from the + * per-Vec generation word, which answers a different question. */ + uint64_t epoch; + /* Dev accounting for the general-purpose tier: "did you forget to free" is + * an allocator-tier question and this is the allocator's answer. */ + int64_t live_blocks; + int64_t live_bytes; + /* A cap on live bytes, or 0 for none. It is here because + * spec-memory.md's retry restart is only answerable by a handler that can + * make the *same* request succeed, and for a fixed backing buffer the only + * such handler is one that raises the ceiling: releasing the region a + * container lives in invalidates the container, which is what the epoch + * check exists to catch. So "grow the arena and then invoke retry", which + * the spec names as the handler that works, needs a ceiling to raise. It + * doubles as the knob a test exhausts an allocator with on purpose. */ + int64_t budget; +}; + +/* Would this request put the allocator over its budget? */ +static int flan_over_budget(flan_allocator *a, int64_t size) { + return a->budget > 0 && a->live_bytes + size > a->budget; +} + +/* -- The heap allocator: malloc, realloc, free. ---------------------- */ + +static void *flan_heap_proc(flan_allocator *a, int32_t mode, void *p, + int64_t old_size, int64_t size, int64_t align) { + switch (mode) { + case FLAN_ALLOC_ALLOC: { + void *q = NULL; + size_t al, sz; + if (size <= 0) return NULL; + if (flan_over_budget(a, size)) return NULL; + al = (size_t)(align < (int64_t)sizeof(void *) ? (int64_t)sizeof(void *) : align); + sz = (size_t)size; + /* aligned_alloc requires a size that is a multiple of the alignment. */ + if (sz % al) sz += al - (sz % al); + q = aligned_alloc(al, sz); + if (q) { a->live_blocks++; a->live_bytes += size; } + return q; + } + case FLAN_ALLOC_RESIZE: { + /* aligned_alloc has no realloc, so growth is a new block and a copy. The + * caller passes old_size for exactly this reason, and it is the one + * number a wrong answer here would read off the end of. */ + void *q; + if (flan_over_budget(a, size - old_size)) return NULL; + q = flan_heap_proc(a, FLAN_ALLOC_ALLOC, NULL, 0, size, align); + if (!q) return NULL; + if (p && old_size > 0) + memcpy(q, p, (size_t)(old_size < size ? old_size : size)); + if (p) { free(p); a->live_blocks--; a->live_bytes -= old_size; } + return q; + } + case FLAN_ALLOC_FREE: + if (p) { free(p); a->live_blocks--; a->live_bytes -= old_size; } + return NULL; + case FLAN_ALLOC_FREE_ALL: + default: + return NULL; + } +} + +static flan_allocator flan_heap = { + flan_heap_proc, NULL, + FLAN_CAN_ALLOC | FLAN_CAN_RESIZE | FLAN_CAN_FREE, + 0, 0, 0, 0 +}; + +/* -- The arena: one fixed backing buffer and a bump offset. ---------- + * + * `free-all` is retain-capacity: offset = 0, the pages stay. That is an + * announced amendment to spec-memory.md's operation table (see BUILT.md) and + * it is what Odin's arena_free_all already does in effect. Handing the pages + * back is `arena-destroy`, a separate operation, because a frame arena reset + * every frame must not return memory only to ask for it again. + * + * The epoch is bumped either way: the pages are the same but every container + * made before the reset is invalid, which is the whole point of the trap. */ + +typedef struct flan_arena { + uint8_t *base; + int64_t cap; + int64_t offset; + int64_t peak; +} flan_arena; + +static int64_t flan_align_up(int64_t x, int64_t a) { + if (a <= 1) return x; + return (x + a - 1) / a * a; +} + +static void *flan_arena_proc(flan_allocator *a, int32_t mode, void *p, + int64_t old_size, int64_t size, int64_t align) { + flan_arena *ar = (flan_arena *)a->data; + switch (mode) { + case FLAN_ALLOC_ALLOC: { + int64_t start, end; + if (size <= 0) return NULL; + if (flan_over_budget(a, size)) return NULL; + if (align < 1) align = 1; + start = flan_align_up(ar->offset, align); + end = start + size; + if (end > ar->cap || end < start) return NULL; /* exhausted, or overflow */ + ar->offset = end; + if (end > ar->peak) ar->peak = end; + a->live_blocks++; + a->live_bytes += size; + return ar->base + start; + } + case FLAN_ALLOC_RESIZE: { + void *q; + /* Growing the most recent block in place is the one case worth special + * casing: a Vec that is the only thing pushing into a frame arena grows + * without copying, which is the common shape. */ + if (p && (uint8_t *)p + old_size == ar->base + ar->offset) { + int64_t end = (int64_t)((uint8_t *)p - ar->base) + size; + if (end > ar->cap || end < 0) return NULL; + ar->offset = end; + if (end > ar->peak) ar->peak = end; + a->live_bytes += size - old_size; + return p; + } + q = flan_arena_proc(a, FLAN_ALLOC_ALLOC, NULL, 0, size, align); + if (!q) return NULL; + if (p && old_size > 0) + memcpy(q, p, (size_t)(old_size < size ? old_size : size)); + return q; /* the old block is not reclaimable */ + } + case FLAN_ALLOC_FREE: + return NULL; /* refused by the capability set above */ + case FLAN_ALLOC_FREE_ALL: + ar->offset = 0; + a->live_blocks = 0; + a->live_bytes = 0; + return NULL; + default: + return NULL; + } +} + +/* -- The context, spec-memory.md's context/allocator and context/temp ---- + * + * A dynamic variable with save and restore, not an extra parameter on every + * signature. The spec calls it part of the calling convention; taking that + * literally would touch every function signature, the FFI shim, the dev + * trampolines and the reload ABI, for the same observable behaviour. The + * literal reading is deferred and BUILT.md says so. + * + * There are no threads in Flan, so a plain global is the whole of it. */ + +static flan_allocator *flan_ctx_alloc = &flan_heap; +static flan_allocator *flan_ctx_tmp = NULL; + +flan_allocator *flan_arena_new(int64_t cap); + +flan_allocator *flan_context_allocator(void) { return flan_ctx_alloc; } + +/* The default temp arena, made on first use. 1 MiB: big enough that the + * per-frame tier does not fail on a toy program, small enough that a program + * which never touches it has not paid for a heap. */ +#define FLAN_TEMP_DEFAULT (1 << 20) + +flan_allocator *flan_context_temp(void) { + if (!flan_ctx_tmp) flan_ctx_tmp = flan_arena_new(FLAN_TEMP_DEFAULT); + return flan_ctx_tmp; +} + +/* Returns the previous one, which is what with-allocator restores — on the + * normal path and on the transfer path both. */ +flan_allocator *flan_context_set(flan_allocator *a) { + flan_allocator *prev = flan_ctx_alloc; + if (a) flan_ctx_alloc = a; + return prev; +} + +void flan_context_restore(flan_allocator *a) { + if (a) flan_ctx_alloc = a; +} + +flan_allocator *flan_arena_new(int64_t cap) { + flan_allocator *a; + flan_arena *ar; + if (cap <= 0) cap = FLAN_TEMP_DEFAULT; + a = (flan_allocator *)calloc(1, sizeof *a); + ar = (flan_arena *)calloc(1, sizeof *ar); + if (!a || !ar) { free(a); free(ar); return NULL; } + ar->base = (uint8_t *)malloc((size_t)cap); + if (!ar->base) { free(a); free(ar); return NULL; } + ar->cap = cap; + a->proc = flan_arena_proc; + a->data = ar; + /* No FLAN_CAN_FREE: an arena cannot release one block, which is Odin's + * answer too (allocators.odin returns Mode_Not_Implemented for .Free). */ + a->caps = FLAN_CAN_ALLOC | FLAN_CAN_RESIZE | FLAN_CAN_FREE_ALL; + return a; +} + +void flan_arena_destroy(flan_allocator *a) { + flan_arena *ar; + if (!a || a->proc != flan_arena_proc) return; + ar = (flan_arena *)a->data; + if (a == flan_ctx_alloc) flan_ctx_alloc = &flan_heap; + if (a == flan_ctx_tmp) flan_ctx_tmp = NULL; + a->epoch++; + free(ar->base); + free(ar); + free(a); +} + +flan_allocator *flan_heap_allocator(void) { return &flan_heap; } + +int8_t flan_alloc_can_free(flan_allocator *a) { + return (int8_t)(a && (a->caps & FLAN_CAN_FREE) ? 1 : 0); +} + +int8_t flan_alloc_can_free_all(flan_allocator *a) { + return (int8_t)(a && (a->caps & FLAN_CAN_FREE_ALL) ? 1 : 0); +} + +int64_t flan_alloc_epoch(flan_allocator *a) { + return a ? (int64_t)a->epoch : 0; +} + +int64_t flan_alloc_live_blocks(flan_allocator *a) { + return a ? a->live_blocks : 0; +} + +int64_t flan_alloc_budget(flan_allocator *a) { return a ? a->budget : 0; } + +void flan_alloc_set_budget(flan_allocator *a, int64_t n) { + if (a) a->budget = n < 0 ? 0 : n; +} + +_Noreturn void flan_free_all_fail(const uint8_t *loc, int64_t loclen); +_Noreturn void flan_null_alloc_fail(const uint8_t *loc, int64_t loclen); + +/* free-all on an allocator that does not offer it is a trap, not a silent + * no-op: "I released the region" and "I leaked the region" must not be the + * same program text. */ +void flan_alloc_free_all(flan_allocator *a, const uint8_t *loc, int64_t loclen) { + /* A null allocator is a zeroed [defvar] nobody assigned yet. Silently doing + * nothing would make "I released the region" and "I never made one" the same + * program text, which is the thing this trap exists to prevent. */ + if (!a) flan_null_alloc_fail(loc, loclen); + if (!(a->caps & FLAN_CAN_FREE_ALL)) flan_free_all_fail(loc, loclen); + a->proc(a, FLAN_ALLOC_FREE_ALL, NULL, 0, 0, 0); + a->epoch++; +} + +_Noreturn void flan_null_alloc_fail(const uint8_t *loc, int64_t loclen) { + fflush(stdout); + fprintf(stderr, + "%.*s: this allocator is null — a zeroed Allocator was never given " + "one\n", + (int)loclen, (const char *)loc); + rt_die(); +} + +_Noreturn void flan_free_all_fail(const uint8_t *loc, int64_t loclen) { + fflush(stdout); + fprintf(stderr, + "%.*s: this allocator does not offer free-all — it has no region to " + "release, and releasing nothing is not the same as releasing " + "everything\n", + (int)loclen, (const char *)loc); + rt_die(); +} + +/* ── (Vec T), spec-memory.md ──────────────────────────────────────────── + * + * One type-erased runtime over (size, align), which is Odin's arrangement + * (base/runtime/dynamic_array_internal.odin): the monomorphised wrapper is the + * only place the concrete type is known, so it is the only place that can + * produce the numbers, and it passes them in. There are no generics here and + * none are needed. + * + * Header, and it is six words rather than the spec's four: + * + * ptr len cap allocator the release layout spec-memory.md fixes + * gen bumped on every reallocation — the stale-slice + * word. It has no reader yet; see BUILT.md. + * epoch the allocator's epoch when this Vec last + * touched it. Any operation on a container whose + * recorded epoch has moved traps. + * + * The two dev words are present in every build, not only a dev one, and that + * is not laziness: a redefinition module is built by llc and ld against a host + * that was built separately, and nothing makes the two agree on a struct size. + * A layout that changes with a build flag is a layout that can disagree across + * that boundary silently. Dropping them in release is deferred and BUILT.md + * says what it is blocked on. + * + * Every entry point returns int8_t 1/0 for "did it fit", and never reports + * failure any other way: the condition, the restart and the message are the + * compiler's job (see Check's alloc_guard). */ + +typedef struct flan_vec { + void *ptr; + int64_t len; + int64_t cap; + flan_allocator *alloc; + int64_t gen; + int64_t epoch; +} flan_vec; + +/* The request that did not fit, for the condition the compiler builds at the + * failing site. A pair of globals rather than out-parameters because the + * condition is a value struct on the signalling frame's stack with fixed + * numeric fields and no rendered message — spec-memory.md is explicit that + * this is the one path that must not allocate, and reading two words is the + * cheapest way to carry the numbers out. */ +static int64_t flan_fail_bytes = 0; +static int64_t flan_fail_align = 0; +static int64_t flan_fail_id = 0; + +int64_t flan_alloc_fail_bytes(void) { return flan_fail_bytes; } +int64_t flan_alloc_fail_align(void) { return flan_fail_align; } +int64_t flan_alloc_fail_id(void) { return flan_fail_id; } + +/* The allocator's identity, for the condition's :allocator field. The pointer + * is the identity — the same thing the epoch hangs off. */ +int64_t flan_alloc_id(flan_allocator *a) { return (int64_t)(intptr_t)a; } + +_Noreturn void flan_vec_stale_fail(const uint8_t *loc, int64_t loclen, + int64_t was, int64_t now) { + fflush(stdout); + fprintf(stderr, + "%.*s: this container's allocator was released — it was made at " + "epoch %lld and the allocator is at %lld now\n", + (int)loclen, (const char *)loc, (long long)was, (long long)now); + rt_die(); +} + +_Noreturn void flan_vec_bounds_fail(const uint8_t *loc, int64_t loclen, + int64_t i, int64_t len) { + fflush(stdout); + fprintf(stderr, "%.*s: index %lld is out of bounds for length %lld\n", + (int)loclen, (const char *)loc, (long long)i, (long long)len); + rt_die(); +} + +/* spec-memory.md, "Dev builds detect a released region". This is the check + * that makes the epoch word worth carrying, and it runs on every operation, + * not only in a dev build — see the header on why the words are unconditional. + * A Vec that never allocated has no allocator and nothing to check. */ +static void flan_vec_check(flan_vec *v, const uint8_t *loc, int64_t loclen) { + if (v->alloc) { + int64_t now = (int64_t)v->alloc->epoch; + if (now != v->epoch) flan_vec_stale_fail(loc, loclen, v->epoch, now); + } +} + +/* A zeroed Vec — a struct field nobody assigned, or a (defvar xs (Vec i32)) — + * has a null allocator, and the first operation that needs storage adopts the + * context allocator. That is Odin's behaviour, and the alternative was to + * refuse a Vec-typed struct field outright until step 5. Shipping the null + * silently was not an option: it is a null deref on the first push. */ +static flan_allocator *flan_vec_adopt(flan_vec *v) { + if (!v->alloc) { + v->alloc = flan_context_allocator(); + v->epoch = (int64_t)v->alloc->epoch; + } + return v->alloc; +} + +static int8_t flan_vec_grow(flan_vec *v, int64_t want, int64_t size, + int64_t align) { + flan_allocator *a = flan_vec_adopt(v); + int64_t cap = v->cap; + void *p; + if (want <= cap) return 1; + /* Doubling, from four. Four rather than one because the three reallocations + * a growing-from-one Vec does before it holds anything are pure cost, and + * doubling because it is what makes n pushes amortised O(n). */ + if (cap < 4) cap = 4; + while (cap < want) { + if (cap > (int64_t)1 << 40) { cap = want; break; } + cap *= 2; + } + flan_fail_bytes = cap * size; + flan_fail_align = align; + flan_fail_id = (int64_t)(intptr_t)a; + if (v->ptr) + p = a->proc(a, FLAN_ALLOC_RESIZE, v->ptr, v->cap * size, cap * size, align); + else + p = a->proc(a, FLAN_ALLOC_ALLOC, NULL, 0, cap * size, align); + if (!p) return 0; + v->ptr = p; + v->cap = cap; + /* Any slice taken before this points at storage that may have moved. The + * word is bumped here and read nowhere yet; see BUILT.md. */ + v->gen++; + return 1; +} + +int8_t flan_vec_init(flan_vec *v, flan_allocator *a, int64_t cap, int64_t size, + int64_t align, const uint8_t *loc, int64_t loclen) { + /* [a] is NULL only when no allocator was named at the site and the context + * is being used. An allocator *named* at the site and null is a zeroed + * Allocator nobody assigned, and substituting the heap for it would be the + * same "released the region / never made one" collapse flan_alloc_free_all + * traps for — except silent, and discovered as a leak. The checker cannot + * see it, because a null is a run-time value. + * + * The no-allocator-named case never arrives here as NULL: the checker passes + * flan_context_allocator(), which always answers one. */ + if (!a) flan_null_alloc_fail(loc, loclen); + v->ptr = NULL; + v->len = 0; + v->cap = 0; + v->gen = 0; + v->alloc = a; + v->epoch = (int64_t)v->alloc->epoch; + if (cap <= 0) return 1; + return flan_vec_grow(v, cap, size, align); +} + +int8_t flan_vec_reserve(flan_vec *v, int64_t n, int64_t size, int64_t align, + const uint8_t *loc, int64_t loclen) { + flan_vec_check(v, loc, loclen); + if (n <= v->cap) return 1; + return flan_vec_grow(v, n, size, align); +} + +int8_t flan_vec_push(flan_vec *v, const void *elem, int64_t size, + int64_t align, const uint8_t *loc, int64_t loclen) { + flan_vec_check(v, loc, loclen); + if (v->len + 1 > v->cap && !flan_vec_grow(v, v->len + 1, size, align)) + return 0; + memcpy((uint8_t *)v->ptr + v->len * size, elem, (size_t)size); + v->len++; + return 1; +} + +int64_t flan_vec_len(flan_vec *v, const uint8_t *loc, int64_t loclen) { + flan_vec_check(v, loc, loclen); + return v->len; +} + +void *flan_vec_at(flan_vec *v, int32_t i, int64_t size, const uint8_t *loc, + int64_t loclen) { + flan_vec_check(v, loc, loclen); + /* The same unsigned comparison the fixed-array bounds check uses: a negative + * index sign-extends to a huge unsigned and is caught by the one test. */ + if ((uint64_t)(int64_t)i >= (uint64_t)v->len) + flan_vec_bounds_fail(loc, loclen, (int64_t)i, v->len); + return (uint8_t *)v->ptr + (int64_t)i * size; +} + +/* [hi] of -1 means "to the end": (as-slice v) has no static length to write. */ +void flan_vec_as_slice(flan_vec *v, void *out, int32_t lo, int32_t hi, + int64_t size, const uint8_t *loc, int64_t loclen) { + struct { void *p; int64_t n; } s; + int64_t l = lo, h = (hi < 0) ? v->len : hi; + flan_vec_check(v, loc, loclen); + if (l < 0 || h > v->len || l > h) flan_vec_bounds_fail(loc, loclen, l, v->len); + s.p = (uint8_t *)v->ptr + l * size; + s.n = h - l; + memcpy(out, &s, sizeof s); +} + +/* spec-memory.md's first release point. The Vec is left zeroed rather than + * dangling — the checker has already made using it afterwards a compile error, + * and zeroing costs nothing and makes a bug that slips past the checker a null + * deref rather than a use-after-free. An allocator without can-free keeps the + * block: releasing it is free-all's job, and pretending otherwise here is the + * silent-no-op this file refuses elsewhere. */ +void flan_vec_free(flan_vec *v, int64_t size, int64_t align, + const uint8_t *loc, int64_t loclen) { + flan_vec_check(v, loc, loclen); + if (v->ptr && v->alloc && (v->alloc->caps & FLAN_CAN_FREE)) + v->alloc->proc(v->alloc, FLAN_ALLOC_FREE, v->ptr, v->cap * size, 0, align); + (void)align; + v->ptr = NULL; + v->len = 0; + v->cap = 0; + v->alloc = NULL; + v->gen++; + v->epoch = 0; +} + +int8_t flan_vec_clone(flan_vec *dst, flan_vec *src, flan_allocator *a, + int64_t size, int64_t align, const uint8_t *loc, + int64_t loclen) { + flan_vec_check(src, loc, loclen); + if (!flan_vec_init(dst, a, src->len, size, align, loc, loclen)) return 0; + if (src->len > 0) memcpy(dst->ptr, src->ptr, (size_t)(src->len * size)); + dst->len = src->len; + return 1; +} diff --git a/test/programs/allocators.flan b/test/programs/allocators.flan new file mode 100644 index 0000000..5ac0dc8 --- /dev/null +++ b/test/programs/allocators.flan @@ -0,0 +1,68 @@ +;;;; Allocators — spec-memory.md, "Allocators". No container here: this is the +;;;; tier on its own, so that a failure in it is not read as a Vec bug. +;;;; +;;;; What is asserted: the capability set is readable at run time and differs +;;;; per allocator; with-allocator rebinds for its dynamic extent and restores +;;;; afterwards, including out of a call and out of a transfer; free-all is +;;;; retain-capacity and bumps the epoch anyway; and nothing is released at +;;;; scope exit, which is the point the spec is most emphatic about. + +;; A zeroed Allocator. A global rather than a local because the arena has to +;; outlive the frame that makes it, and because a handler cannot see a local +;; (check.ml's `captured` says so by name). +(defvar frame Allocator) + +;;; The context is a dynamic variable, so a function called from inside a +;;; with-allocator body sees the rebinding without anything being passed. +(defn who-am-i [] bool + (can-free? context/allocator)) + +(defn main [] i32 + ;; The heap allocator frees one block; an arena does not. That is Odin's + ;; answer too — its arena returns Mode_Not_Implemented for .Free — and it is + ;; the capability spec-memory.md calls load-bearing. + (set frame (arena-new 1024)) + (println (can-free? (heap-allocator))) ; true + (println (can-free? frame)) ; false + (println (can-free-all? (heap-allocator))) ; false + (println (can-free-all? frame)) ; true + + ;; The default context is the heap allocator, and context/temp is its own + ;; arena — the per-frame tier, distinct from it. + (println (can-free? context/allocator)) ; true + (println (can-free? context/temp)) ; false + + ;; with-allocator rebinds for the dynamic extent, so a call made from inside + ;; the body sees the arena, and the binding is gone after the body. + (println (with-allocator frame (who-am-i))) ; false + (println (who-am-i)) ; true + + ;; ... and it is an expression: the body's last value is the form's value. + (println (with-allocator frame 41)) ; 41 + + ;; free-all is retain-capacity: the pages stay, the epoch moves. Both halves + ;; matter — the first is what makes a per-frame reset free, and the second is + ;; what a container's dev trap reads. + (println (alloc-epoch frame)) ; 0 + (free-all frame) + (println (alloc-epoch frame)) ; 1 + (free-all frame) + (println (alloc-epoch frame)) ; 2 + + ;; Nothing is released at scope exit — not at the end of a let, not at the + ;; end of a with-allocator body. The epoch is the observable proof: leaving + ;; the body did not release the region it named. + (let [before (alloc-epoch frame)] + (with-allocator frame (println (alloc-epoch frame))) ; 2 + (println (= before (alloc-epoch frame)))) ; true + + ;; And out of a transfer. The restart-case's clause runs after the body has + ;; left through the pad, so the context allocator here is the one the + ;; with-allocator displaced, not the arena. + (println + (restart-case + (with-allocator frame (invoke-restart 'resync)) + (resync [] (can-free? context/allocator)))) ; true + + (arena-destroy frame) + 0) diff --git a/test/programs/exhausted-unhandled.flan b/test/programs/exhausted-unhandled.flan new file mode 100644 index 0000000..2d86bef --- /dev/null +++ b/test/programs/exhausted-unhandled.flan @@ -0,0 +1,12 @@ +;;;; An exhausted allocator with nothing handling it. §2: `error` is the +;;;; diverging variant — a handler that returns normally has not answered it, +;;;; and with no handler at all the program stops on the frame that erred +;;;; rather than carrying on with a push that appended nothing. +(defn main [] i32 + (let [a (arena-new 32)] + (let [v (vec-new i32 a)] + (println "before") + (dotimes [i 64] (push v i)) + (println "unreachable") + (free v))) + 0) diff --git a/test/programs/exhausted.flan b/test/programs/exhausted.flan new file mode 100644 index 0000000..070c196 --- /dev/null +++ b/test/programs/exhausted.flan @@ -0,0 +1,92 @@ +;;;; StorageExhausted and retry — spec-memory.md, "Allocation failure". +;;;; +;;;; No allocating operation returns an error and none can fail silently. The +;;;; operation signals StorageExhausted with `error`, whose type is Never, +;;;; inside a restart-case offering `retry` — so push stays Unit, clone stays +;;;; the container, and no signature anywhere grows a Result. Odin's append +;;;; returns an ignorable Allocator_Error; an append that appends nothing and +;;;; says nothing is the outcome this rule exists to make impossible. +;;;; +;;;; This is also the named exception to plan.org's "restarts go at the resync +;;;; point, once": the restart is established *at the failing allocation*, +;;;; because a restart at an outer loop cannot re-attempt an allocation and +;;;; only the allocation site can. +;;;; +;;;; The handler that works is the one that raises the ceiling and retries. +;;;; Releasing the region the container lives in does not work and must not be +;;;; written: it invalidates the container, which the epoch check then catches +;;;; — and that case is its own program, stale-region.flan. + +;; Globals, because a handler cannot see the locals of the function that +;; established it: check.ml's `captured` refuses one by name and says to use a +;; global. That refusal is the accumulation pattern, and it is not built. +(defvar tight Allocator) +(defvar failures i64) +(defvar last-bytes i64) +(defvar last-align i64) +(defvar same-allocator bool) + +(defn main [] i32 + ;; The general-purpose tier, with a ceiling on it. 32 bytes is four i32 and + ;; the doubling past it is not. + (set tight (heap-allocator)) + (set-alloc-budget tight 32) + + (handler-bind + [(StorageExhausted [c] + (set failures (+ failures 1)) + ;; The condition is a value struct with fixed numeric fields and no + ;; rendered message: formatting would allocate, and this is the one path + ;; that must not. Rendering happens here, where a working allocator is + ;; known. + (set last-bytes (.bytes c)) + (set last-align (.align c)) + ;; It names which region ran out, so a handler holding several can tell + ;; them apart. + (set same-allocator (= (.allocator c) (alloc-id tight))) + ;; Grow it, then re-attempt the same request. The Vec is untouched and + ;; its allocator is unchanged, which is why this retry can succeed. + (set-alloc-budget tight (* 4 (alloc-budget tight))) + (invoke-restart 'retry))] + (let [v (vec-new i32 tight)] + ;; Somewhere in here the ceiling is hit, the handler raises it, and the + ;; push that failed is re-attempted. No push is lost: a failed push + ;; appends nothing and the retry appends exactly once. + (dotimes [i 64] (push v (* i 2))) + (println (len v)) ; 64 + (println (at v 0)) ; 0 + (println (at v 63)) ; 126 + (free v))) + + ;; The handler ran, more than once, and what it saw were the numbers of the + ;; request that did not fit. + (println (> failures 1)) ; true + (println (> last-bytes 0)) ; true + (println last-align) ; 4 — align-of i32, from the call site + (println same-allocator) ; true + + ;; Every allocating operation, not only push. reserve asks for the whole + ;; block at once, and clone asks the new allocator for the source's length. + (set-alloc-budget tight 32) + (set failures 0) + (handler-bind + [(StorageExhausted [c] + (set failures (+ failures 1)) + (set-alloc-budget tight 4096) + (invoke-restart 'retry))] + (let [v (vec-new i32 tight)] + (reserve v 256) + (println (len v)) ; 0 + (dotimes [i 8] (push v i)) + (set-alloc-budget tight 4128) + (let [w (clone v)] + (println (len w)) ; 8 + (println (at w 7)) ; 7 + (free w)) + (free v))) + (println (> failures 0)) ; true + + ;; And the restart is not once-per-program: it is established at each + ;; allocation, so a later one offers it again. + (set-alloc-budget tight 0) + 0) diff --git a/test/programs/free-all-refused.flan b/test/programs/free-all-refused.flan new file mode 100644 index 0000000..65aeca2 --- /dev/null +++ b/test/programs/free-all-refused.flan @@ -0,0 +1,6 @@ +;;;; free-all on an allocator that does not offer it. The heap allocator frees +;;;; one block and has no region to release, so this traps rather than doing +;;;; nothing: "I released the region" and "I leaked the region" must not be the +;;;; same program text. The capability set is what says which it is, and +;;;; (can-free-all? a) is how a program asks before committing. +(defn main [] i32 (free-all (heap-allocator)) 0) diff --git a/test/programs/stale-region.flan b/test/programs/stale-region.flan new file mode 100644 index 0000000..fbc1bff --- /dev/null +++ b/test/programs/stale-region.flan @@ -0,0 +1,22 @@ +;;;; spec-memory.md, "Dev builds detect a released region". +;;;; +;;;; A Vec records the epoch of the allocator it was made with, and free-all +;;;; bumps that counter. Any operation on a container whose recorded epoch has +;;;; moved traps, naming the site. This is the shipping answer to the section +;;;; the spec leaves open — detection, loud and immediate, rather than the +;;;; static prevention that with-allocator and context/allocator deny. +;;;; +;;;; It is a separate counter from the per-Vec generation word, which answers a +;;;; different question (a stale slice), and the two must not be conflated. +(defn main [] i32 + (let [a (arena-new 4096)] + (let [v (vec-new i32 a)] + (push v 1) + (push v 2) + (println (at v 1)) + ;; The region goes. v is still in scope and still looks fine — nothing + ;; is released at scope exit and nothing marked v — which is exactly the + ;; case a static rule cannot see. + (free-all a) + (println (at v 1)))) + 0) diff --git a/test/programs/user-allocator.flan b/test/programs/user-allocator.flan new file mode 100644 index 0000000..3e84c5b --- /dev/null +++ b/test/programs/user-allocator.flan @@ -0,0 +1,7 @@ +;;;; The one thing in the allocator tier that really does need milestone 5. +;;;; "Here is my proc, make an Allocator from it" wants a defn's name in value +;;;; position, which is a function value. The *built-in* allocators need none +;;;; of that — their procedures are runtime symbols and no Flan type names them +;;;; — and this refusal is the other half of that claim: it says which half is +;;;; which, rather than coming back as an unknown function. +(defn main [] i32 (println (make-allocator 1)) 0) diff --git a/test/programs/vec-double-free.flan b/test/programs/vec-double-free.flan new file mode 100644 index 0000000..049ee1c --- /dev/null +++ b/test/programs/vec-double-free.flan @@ -0,0 +1,8 @@ +;;;; `free` consumes its argument exactly as any other move does, so the second +;;;; one is a compile error rather than a runtime crash. Nothing analyses this +;;;; specially: it is the same dead-binding rule as passing one to a function. +(defn main [] i32 + (let [v (vec-new i32)] + (free v) + (free v) + 0)) diff --git a/test/programs/vec-global.flan b/test/programs/vec-global.flan new file mode 100644 index 0000000..b1be5f6 --- /dev/null +++ b/test/programs/vec-global.flan @@ -0,0 +1,9 @@ +;;;; A global of move-only type. The dead set is per function, so two functions +;;;; each freeing this is a double free nothing here could see — and a global +;;;; read does not go through the move path at all, so even the one-function +;;;; case would be accepted. Half a rule is worse than none, so the type is +;;;; refused where it is declared. A global *Allocator* is a different thing +;;;; and is allowed: an allocator is a copyable opaque handle. +(defvar everything (Vec i32)) + +(defn main [] i32 0) diff --git a/test/programs/vec-in-struct.flan b/test/programs/vec-in-struct.flan new file mode 100644 index 0000000..e0a5a08 --- /dev/null +++ b/test/programs/vec-in-struct.flan @@ -0,0 +1,9 @@ +;;;; spec-memory.md: "Ownership is structural, not declared" — a struct +;;;; containing a Vec is itself move-only, transitively, with recursive +;;;; teardown, and with a field that cannot be freed on its own. None of that +;;;; machinery exists: it is the same recursive teardown `drop` brings, and it +;;;; lands with it. Accepting the field meanwhile would give a struct that +;;;; copies its header on assignment two owners of one buffer. +(defstruct Builder [buf (Vec u8)]) + +(defn main [] i32 0) diff --git a/test/programs/vec-moved-in-loop.flan b/test/programs/vec-moved-in-loop.flan new file mode 100644 index 0000000..fdcd01c --- /dev/null +++ b/test/programs/vec-moved-in-loop.flan @@ -0,0 +1,8 @@ +;;;; A loop body that moves a binding declared outside the loop: the second +;;;; iteration would use what the first gave away. The dead set alone cannot +;;;; see this — merged once at the end of the body it counts one move, not two +;;;; — so it is a rule, and it is refused with the reason. +(defn main [] i32 + (let [v (vec-new i32)] + (dotimes [i 3] (free v)) + 0)) diff --git a/test/programs/vec-moved.flan b/test/programs/vec-moved.flan new file mode 100644 index 0000000..7d2ce89 --- /dev/null +++ b/test/programs/vec-moved.flan @@ -0,0 +1,15 @@ +;;;; A Vec is move-only: passing one to a function transfers ownership, and the +;;;; source binding is dead afterwards. That rule is what makes a double free +;;;; unrepresentable, which is why `free` needs no analysis of its own. +(defn take [v (Vec i32)] i32 + (let [n (len v)] + (free v) + n)) + +(defn main [] i32 + (let [v (vec-new i32)] + (push v 1) + (println (take v)) + ;; v went with the call. Being refused here is the whole test. + (println (len v)) + 0)) diff --git a/test/programs/vec-of-vec.flan b/test/programs/vec-of-vec.flan new file mode 100644 index 0000000..5e45125 --- /dev/null +++ b/test/programs/vec-of-vec.flan @@ -0,0 +1,10 @@ +;;;; A Vec of a Vec is representable and would be wrong. The runtime is +;;;; type-erased: it copies and releases elements bytewise, so `clone` would +;;;; duplicate the inner headers instead of copying what they own, and `free` +;;;; would drop their buffers on the floor. spec-memory.md makes clone a deep +;;;; copy and makes free recurse structurally into owning fields; recursive +;;;; teardown is what `drop` brings, and this is refused until it does rather +;;;; than shipping the shallow answer under the deep name. +(defn rows [xs (Vec (Vec i32))] i32 0) + +(defn main [] i32 0) diff --git a/test/programs/vec-to-c.flan b/test/programs/vec-to-c.flan new file mode 100644 index 0000000..8ebc429 --- /dev/null +++ b/test/programs/vec-to-c.flan @@ -0,0 +1,8 @@ +;;;; A Vec cannot cross to C. The shim flattens a struct that crosses, and a +;;;; Vec is not a struct anyone should flatten: it owns storage, and handing +;;;; its header to C hands out an owner. It falls to the same aggregate +;;;; refusal every other non-scalar declare-c parameter gets, which is the +;;;; point — nothing special was needed and nothing special was added. +(declare-c vec-sum [v (Vec i32)] i32 "vec_sum") + +(defn main [] i32 0) diff --git a/test/programs/vec-untyped.flan b/test/programs/vec-untyped.flan new file mode 100644 index 0000000..0c9651e --- /dev/null +++ b/test/programs/vec-untyped.flan @@ -0,0 +1,8 @@ +;;;; `let` has no type annotation — parse.ml settles that a triple binding is +;;;; ambiguous and that types are inferred — so a local Vec has nowhere to say +;;;; what it holds, and the element type is written at the call instead. With +;;;; neither, this is refused rather than guessed at. +(defn main [] i32 + (let [v (vec-new)] + (free v) + 0)) diff --git a/test/programs/vec.flan b/test/programs/vec.flan new file mode 100644 index 0000000..4a8811e --- /dev/null +++ b/test/programs/vec.flan @@ -0,0 +1,109 @@ +;;;; (Vec T) — spec-memory.md, "The four container types" and "Allocators". +;;;; +;;;; ptr + len + cap + allocator, owning and move-only, over one type-erased +;;;; runtime. The element type appears nowhere in that runtime: size_of and +;;;; align_of are produced at the call site, which without generics is simply +;;;; the concrete call site. So this file being two element types with one +;;;; runtime behind them is the whole claim. + +(defstruct Point [x i32 y i32]) + +;;; Ownership transfers on the call. The caller's binding is dead after this, +;;; which is what the refusal cases in test_acceptance assert. +(defn consume [v (Vec i32)] i32 + (let [n (len v)] + (free v) + n)) + +;;; A Vec is returned by moving it out, so the callee's binding is the +;;; caller's. Nothing is released at function exit — there is no scope-end +;;; anything in this language. +(defn make [n i32] (Vec i32) + (let [v (vec-new i32)] + (dotimes [i n] (push v (* i i))) + v)) + +(defn sum [xs [i32]] i32 + (let [total 0] + (dotimes [i (len xs)] (set total (+ total (at xs i)))) + total)) + +(defn main [] i32 + (let [v (vec-new i32)] + (println (len v)) ; 0 + (push v 10) + (push v 20) + (push v 30) + (println (len v)) ; 3 + (println (at v 0)) ; 10 + (println (at v 2)) ; 30 + ;; A Vec element is a place, and the same bounds and epoch check stands + ;; behind the value form and the place form. + (set (at v 1) 99) + (println (at v 1)) ; 99 + + ;; as-slice is a non-owning view: it copies ptr+len and never the + ;; elements, and it carries no allocator, so nothing can be freed through + ;; one. [at] and [len] over it are the array operations, unchanged. + (println (sum (as-slice v))) ; 139 + (println (len (as-slice v 1 3))) ; 2 + (println (at (as-slice v 1 3) 0)) ; 99 + + ;; clone is the only copy: assignment moves. The copy is independent, and + ;; freeing it leaves the original alone. + (let [w (clone v)] + (set (at w 0) -1) + (println (at w 0)) ; -1 + (println (at v 0)) ; 10 + (free w)) + + ;; reserve does not change the length, only the capacity, so a reserve + ;; that succeeds is invisible except that the pushes after it do not grow. + (reserve v 64) + (println (len v)) ; 3 + (push v 40) + (println (len v)) ; 4 + + ;; The structural printer reaches both new types. Neither is followed: a + ;; Vec's elements are printed through (as-slice v), which says at the call + ;; site that it borrowed, and an allocator's contents are the runtime's and + ;; its address is not stable across runs. + (println v) ; + (println context/allocator) ; + + (free v)) + + ;; A second element type over the same runtime, and a struct element, so + ;; that size_of and align_of are doing work rather than both being 4. + (let [ps (vec-new Point)] + (push ps (Point {:x 1 :y 2})) + (push ps (Point {:x 3 :y 4})) + (println (len ps)) ; 2 + (println (.y (at ps 1))) ; 4 + (free ps)) + + ;; A Vec made against an explicit allocator records it, so free and clone + ;; never need it named again. An arena cannot free one block, so this free + ;; keeps the block — releasing it is free-all's job, and that is the + ;; difference the capability set exists to state. + (let [a (arena-new 4096)] + (let [v (vec-new i32 a)] + (push v 7) + (println (at v 0)) ; 7 + (free v)) + (println (can-free? a)) ; false + (free-all a) + (arena-destroy a)) + + ;; The pushes go into whatever the context names, with nothing passed. + (let [a (arena-new 4096)] + (with-allocator a + (let [v (vec-new i32)] + (push v 5) + (push v 6) + (println (+ (at v 0) (at v 1))) ; 11 + (free v))) + (arena-destroy a)) + + (println (consume (make 5))) ; 5 + 0) diff --git a/test/test_acceptance.ml b/test/test_acceptance.ml index f840e93..e71ec30 100644 --- a/test/test_acceptance.ml +++ b/test/test_acceptance.ml @@ -360,6 +360,117 @@ let () = "(defn main [] i32 (restart-case 0 (use-value [v i32] v))\n\ \ (invoke-restart 'use-value (println \"\")) 0)" "a restart argument must be a value"; + (* Allocators, spec-memory.md. The tier on its own, with no container + above it, so that a failure here is not read as a Vec bug. What is + asserted is the capability set differing per allocator, the context + rebinding for a dynamic extent and restoring — out of a call and out of + a *transfer* — and free-all moving the epoch while keeping the pages. + At -O0 as well, because with-allocator's restore on the transfer path is + control flow an optimiser would otherwise launder, and as a dev build, + because the call inside the body then goes through a cell. *) + let allocators_out = + "true\nfalse\nfalse\ntrue\ntrue\nfalse\nfalse\ntrue\n41\n0\n1\n2\n2\ntrue\ntrue\n" + in + outputs "allocators" "programs/allocators.flan" allocators_out; + outputs ~opt:"-O0" "allocators, -O0" "programs/allocators.flan" allocators_out; + outputs ~dev:true "allocators, dev" "programs/allocators.flan" allocators_out; + (* free-all on an allocator that does not offer it traps rather than doing + nothing, because "I released the region" and "I leaked the region" must + not be the same program text. Its own case for the same reason the + bounds traps are: a trap has no result, only an exit and a message. *) + let exe = compile "programs/free-all-refused.flan" in + let code, text = run exe None in + if code <> 134 + || not (contains text "programs/free-all-refused.flan:") + || not (contains text "does not offer free-all") + then begin + incr failures; + Printf.printf + "FAIL free-all on an allocator without it\n\ + \ got: %S (exit %d)\n wanted: exit 134, naming the site\n" + text code + end; + (try Sys.remove exe with Sys_error _ -> ()); + + (* (Vec T), spec-memory.md. Two element types over one type-erased + runtime, which is the whole claim: size_of and align_of are produced at + the concrete call site and nothing below it knows the element type. The + moves are here too — into a call and out of one — because a Vec that + cannot be handed to a function is not a container anyone can use. *) + let vec_out = + "0\n3\n10\n30\n99\n139\n2\n99\n-1\n10\n3\n4\n\ + \n\n2\n4\n7\nfalse\n11\n5\n" + in + outputs "vec" "programs/vec.flan" vec_out; + outputs ~opt:"-O0" "vec, -O0" "programs/vec.flan" vec_out; + outputs ~dev:true "vec, dev" "programs/vec.flan" vec_out; + (* A debug build, because [dty] is a separate path from everything above: + [outputs ~dev:true] goes through the cells, not through DWARF, and a + type with no arm there dies at emit rather than being merely undebugged. + That is NEXT.md's landed item 2 exactly — [field_addr] took only + [Types.Named], so the printer's Option arm had never run. Asserted on + the metadata as well as on the program still working: a composite whose + element count disagreed with [lay] would print plausible values for the + wrong fields, which is the failure debug info has. *) + let dbg = Emit.program ~debug:true (Check.program + (Parse.program (Reader.read_file "programs/vec.flan"))) in + if not (contains dbg "name: \"Allocator\"") + || not (contains dbg "name: \"(Vec i32)\", size: 384") + then begin + incr failures; + print_endline "FAIL debug info for Allocator and (Vec T)" + end; + + (* StorageExhausted and retry. The allocator is genuinely exhausted — a + ceiling on live bytes, hit repeatedly — and the handler raises it and + invokes retry, so the same request is re-attempted and no push is lost. + Every allocating operation is covered, not only push: reserve asks for + the whole block at once and clone asks for the source's length. + At -O0 because the retry loop and the guard after the error are control + flow an optimiser would otherwise launder. *) + let exhausted_out = "64\n0\n126\ntrue\ntrue\n4\ntrue\n0\n8\n7\ntrue\n" in + outputs "storage exhausted, retried" "programs/exhausted.flan" exhausted_out; + outputs ~opt:"-O0" "storage exhausted, retried, -O0" "programs/exhausted.flan" + exhausted_out; + outputs ~dev:true "storage exhausted, retried, dev" "programs/exhausted.flan" + exhausted_out; + + (* The same exhaustion with nothing handling it. [error] is the diverging + variant: the program stops on the frame that erred rather than carrying + on with a push that appended nothing, which is the Odin outcome the rule + exists to make impossible. *) + let exe = compile "programs/exhausted-unhandled.flan" in + let code, text = run exe None in + if code <> 134 || not (contains text "before") + || not (contains text "unhandled StorageExhausted") + || contains text "unreachable" + then begin + incr failures; + Printf.printf + "FAIL an unhandled StorageExhausted stops the program\n\ + \ got: %S (exit %d)\n wanted: exit 134, naming the condition\n" + text code + end; + (try Sys.remove exe with Sys_error _ -> ()); + + (* The epoch trap: a container whose allocator has been released. This is + spec-memory.md's shipping answer to "Open: catching a use-after-release + statically" — detection, loud and immediate, rather than a static rule + that with-allocator and context/allocator deny the knowledge for. What + is asserted is the reason and the site, not the line. *) + let exe = compile "programs/stale-region.flan" in + let code, text = run exe None in + if code <> 134 || not (contains text "programs/stale-region.flan:") + || not (contains text "allocator was released") + then begin + incr failures; + Printf.printf + "FAIL a container used after its region was released\n\ + \ got: %S (exit %d)\n wanted: exit 134, naming the site\n" + text code + end; + (try Sys.remove exe with Sys_error _ -> ()); + (* §2's other half, which cannot be an [outputs] case because it does not exit 0: a handler runs, returns normally, and has still not answered the error, so the program stops and names the condition. *) @@ -829,6 +940,42 @@ let () = and this row is what says so. *) refuses "nth is not a name" "programs/nth-gone.flan" "unknown function nth"; + (* The one thing in the allocator tier that really does need milestone 5, + refused by name and with the reason rather than as an unknown function. + NEXT.md's escape is that the *built-in* set needs nothing from milestone + 5; this row is the other half of that claim. *) + refuses "a user-written allocator" "programs/user-allocator.flan" + "a defn's name in value position"; + (* Move-only, spec-memory.md. Each of these would otherwise be a double + free or a use-after-free at run time, and each is refused at the second + use with the first one's location in the message. *) + refuses "a Vec used after it was passed" "programs/vec-moved.flan" + "was moved at"; + refuses "a Vec freed twice" "programs/vec-double-free.flan" + "double free unrepresentable"; + (* The one case the dead set cannot answer on its own: merged once at the + end of the body it counts one move, not two. *) + refuses "a Vec moved inside a loop" "programs/vec-moved-in-loop.flan" + "the next iteration would use what this one gave away"; + (* let has no type annotation, so with no element type and no expectation + there is nothing to infer from — and guessing is the alternative. *) + refuses "vec-new with nothing saying what of" "programs/vec-untyped.flan" + "write the element type"; + (* The three shapes ownership is not transitive through yet. Each is + refused where it is declared, naming drop as what it waits on, rather + than accepted into a path that would copy a header and hand out a + second owner. *) + refuses "a struct field that owns a Vec" "programs/vec-in-struct.flan" + "a struct that owns one is move-only too"; + refuses "a global Vec" "programs/vec-global.flan" + "the dead set is per function"; + refuses "a Vec of a Vec" "programs/vec-of-vec.flan" + "copies and releases elements bytewise"; + (* And it does not cross to C: the shim would flatten a header that owns + storage. Refused by the shim generator, where the message can say what + to pass instead. *) + refuses "a Vec crossing to C" "programs/vec-to-c.flan" + "handing its header to C hands out an owner"; (* ── wasm32 (NEXT.md, deferred item 6) ────────────────────────────── The second target, and the reason sand-headless imports no raylib. What diff --git a/test/test_flan.ml b/test/test_flan.ml index 8b92399..8e1b1dc 100644 --- a/test/test_flan.ml +++ b/test/test_flan.ml @@ -674,8 +674,11 @@ let () = (* ── Unconstrained operators, and everything past milestone 2 ──── *) rejects_check "no built-in = on strings" "(defn f [] bool (= \"a\" \"b\"))" ~needle:"no built-in comparison"; - rejects_check "Vec is milestone 6" "(defn f [x (Vec i32)])" - ~needle:"milestone 6"; + (* (Vec T) is built. What is still refused is the arity: one element type, + and a near-miss there would otherwise resolve to a type variable and come + back as generics. *) + rejects_check "Vec takes one type" "(defn f [x (Vec i32 i32)])" + ~needle:"exactly one type"; rejects_check "Map is milestone 6" "(defn f [x {string i32}])" ~needle:"milestone 6"; rejects_check "Result is milestone 6" "(defn f [] (Result i32 i32) None)"