An allocator, an arena, and a Vec that signals when storage runs out

This commit is contained in:
Joseph Ferano 2026-09-12 11:22:57 +07:00
commit ce59f90707
29 changed files with 2240 additions and 75 deletions

215
BUILT.md
View File

@ -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:

104
NEXT.md
View File

@ -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 215218 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.

View File

@ -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 = "<none>" }
scope = []; defers = []; outer = ctx.scope; in_handler = true; in_frames = None; in_defer = false; dead = []; borrow = false; owner = "<none>" }
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 = "<none>" } v).Tast.ty
outer = []; in_handler = false; in_frames = None; in_defer = false; dead = []; borrow = false; owner = "<none>" } 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 = "<none>" } in
outer = []; in_handler = false; in_frames = None; in_defer = false; dead = []; borrow = false; owner = "<none>" } 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 = "<none>" }
outer = []; in_handler = false; in_frames = None; in_defer = false; dead = []; borrow = false; owner = "<none>" }
in
let t = check ctx e in
(t, Array.of_list (List.rev ctx.slot_tys),

View File

@ -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

View File

@ -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.

View File

@ -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

View File

@ -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

View File

@ -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 "<ptr>" ]
(* 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 "<allocator>" ]
(* 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 "<vec>" ]
| 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

View File

@ -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, _) ->

View File

@ -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

View File

@ -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). *)

View File

@ -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;
}

View File

@ -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)

View File

@ -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)

View File

@ -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)

View File

@ -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)

View File

@ -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)

View File

@ -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)

View File

@ -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))

View File

@ -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)

View File

@ -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)

View File

@ -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))

View File

@ -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))

View File

@ -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)

View File

@ -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)

View File

@ -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))

109
test/programs/vec.flan Normal file
View File

@ -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) ; <vec>
(println context/allocator) ; <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)

View File

@ -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\
<vec>\n<allocator>\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

View File

@ -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)"