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

loop and recur, and into that fuses a chain

Browse Source
This commit is contained in:
Joseph Ferano 2026-09-13 09:35:49 +07:00
commit d07edef8e5
12 changed files with 872 additions and 37 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

159
BUILT.md
View File

@ -3006,6 +3006,165 @@ and the function still has to answer. The loop-with-a-sentinel-flag shape that b
in the prelude. The two compiler-emitted retry loops in `check.ml` are that shape, and they are the one place it
cannot help: their sentinel is set inside a `restart-case` body, which is a barrier.
## `into`, which fuses at compile time because it is a macro
```
(into xs (vec-new i32) (map double) (filter even?))
```
Source, destination, then any number of transforms — the shape of the `into->` macro the author already uses in
Clojure. It reads as a sentence (take this, put it there, doing these) and the variadic tail has to trail anyway,
which is the mechanical reason the transforms cannot sit in the middle.
**A macro, and therefore not transducers and not iterators.** Transducers compose at *run time*: function values,
closures, an allocation, and a chain of indirect calls per element. Rust has no transducers either — it has iterators,
which fuse into one loop at compile time through monomorphisation, and that needs generics. A macro reaches the same
place with neither. `(map double)` expands to `(double x)` written straight into the loop body, so the function name
is **syntax and never a value**: no intermediate collection at any step, no closure, no generics, and nothing to
inline. `into.flan` counts every call to the transform functions, which is the assertion a unit test cannot make — a
chain that built a `Vec` per stage would pull a different number.
What it gives up is building a transformation at run time and passing it around. That is transducers' actual selling
point, it is the one part that would need run-time machinery, and it is close to useless in a game. Clojure's
`:eduction` branch is dropped for exactly that reason.
**Why the destination is in the form.** Every collecting operation here allocates from an *explicit* allocator, which
is a frozen rule in `spec-memory.md`. A `->>` chain hides where the result goes; naming the destination means the
macro knows its type, emits the right loop, and the rule is honoured by construction. `(vec-new i32 a)` names an
allocator here as it does anywhere else, because the destination form is written out untouched. This is what `->>`
threading over slices in `plan.org` is replaced by for the collecting cases.
### Reductions do not share the form, and that was the open question
`(into xs 0 (map cost) (sum))` reads oddly because zero is not a collection, and the oddness is the tell rather than a
matter of taste. The whole reason the destination sits in the form is that **the destination is the allocation** — it
is what makes the explicit-allocator rule checkable by construction. A seed is not an allocation, so a form that
accepted one would be two forms sharing a spelling, and the destination would have stopped being honest about what it
is. So `into` collects, and a reducing macro of the same shape is a separate form the day something wants one.
### The parts that took a decision
- **The destination is a `Vec`**, because `push` is what fills it. A `Map` destination is refused by `push` itself,
which says *push takes a (Vec T)* and names the real problem. There is no second lowering and no reason to invent
one before something asks.
- **A source that is already a name is used as it is; anything else is bound to a gensym.** Both halves are needed and
neither is cosmetic. Binding is what a source that is a *call* needs — `(len s)` and `(at s i)` have to be the same
`s`, or the call is made once per element. Not binding a name is what everything else needs: a `(Vec T)` is
move-only, so `(let [s v] ...)` would hand the caller's `v` to a binding it cannot see and `v` would be dead after
an `into` that only read it; and a fixed array would be *copied* into the binding, once per `into`. `len` and `at`
borrow, so used directly the source is only read.
- **An owning temporary as the source leaks**, and this is the wart. `(into (make-a-vec) ...)` binds the result to a
name the caller cannot reach and therefore cannot free. The macro cannot know whether the type owns anything. A call
in that position should borrow — `into.flan`'s does — and the day `drop` exists this stops being a question.
- **One element name throughout**, shadowed by each `(map f)` stage: `(let [x (f x)] ...)`. A `let` binding's value is
checked before its name is bound, so the initialiser reads the outer `x` — that is the language's rule, not an
accident, and `bind`'s `x~2` debug suffix exists precisely so a debugger does not lie about which is which. A
**type-changing** `map` is the case this most plausibly breaks and it does not: each stage is a fresh slot at the
stage's own type, and `into.flan` runs an `i32` source into a `(Vec f32)` to say so.
### What the prelude's macro limits cost, exactly
All four bit, and none blocked anything.
- **A macro has no error facility**, so the three refusals are calls to names nothing defines:
`into-takes-a-source-a-destination-and-transforms`, `into-transform-is-map-or-filter` and
`…-of-one-function`. The report is *unknown function* at the call site with a *expanded from the macro into* note
under it, which is the right place and the wrong sentence. The bad transform is passed along as an argument so that
at least it is named.
- **A prelude macro may not call another macro**, so `into-wrap` is a plain `defn` and uses only special forms —
`loop`, `cond`, `when`, `let`, `if`. A `clamp` or an `unless` in there would have put it in the set `Macro.reduce`
drops.
- **Nested quasiquote is refused**, and it was not needed: each wrapper is a single-level quasiquote over a `body`
already built.
- **Macros are not importable**, which is why `into` is in the prelude rather than a library.
`into-wrap` walks the transforms **in reverse**, because the chain is built from the inside out: the innermost form is
the `push`, and each transform wraps what the ones after it produced. That reverse walk with two accumulators is the
first thing in the prelude written as a `loop`/`recur`, which landed in the commit before this one.
## `loop` and `recur`, and why `recur` is better than tail calls and not only cheaper
There is no TCO anywhere in this compiler — nothing emits a tail call, and `plan.org` mentions them only as something
the backend choice *could* control. `recur` is the answer, and the reason is not that it is cheap. **It is checked.**
The compiler verifies the call is in the loop body's tail position and turns it into a jump, so writing it in the
wrong place is a compile error at the place it was written. Under silent TCO the same mistake compiles and is a stack
overflow at run time, with a backtrace pointing at whatever ran out of stack rather than at what was wrong. Clojure
adopted `recur` because the JVM lacks TCO; it turned out to be the better design, and it is the better design here for
the same reason.
What it does **not** give is mutual recursion between two functions. That needs real tail calls and is out of scope,
and the refusal for a `recur` outside any loop says so in as many words.
### Nothing new reaches the backend
`(loop [x 0 acc 1] body ...)` is a `let` over the names, a `While` whose condition is `true`, and two jumps. `emit.ml`
is untouched. That is the whole argument for building this on the labelled `break`/`continue` that landed just before
it: the machinery was already there, and the question `recur` asks — *may this jump cross that* — is the question
`break` already answers.
- **A loop answers with the value of its body.** The result goes into a slot of its own on the way out and is read
after the loop, so an accumulator comes back without a mutable local and without a sentinel flag.
- **A `Unit` body needs no slot**, and a **`Never` body needs neither slot nor break** — a body every path of which
recurs or returns never falls off the end, so there is nothing to break to and nothing to store.
- **`Set` of a `Never` body is safe**, which is the one thing that had to be checked rather than assumed. `emit`
closes a block at its terminator and drops what follows (`ins` tests `f.live`), and `Tast.Set` resolves the place
before the value, where a local's place is an address with no instruction behind it. So when the body ends in a
jump, the store is simply never written.
- **`recur` rebinds every name at once.** The new values go into temporaries and are written afterwards, so
`(recur y x)` swaps. Interleaved writes would give `y y`, and `recur.flan` asserts the swap for exactly that
reason.
- **A move-only accumulator goes round.** `(loop [acc (vec-new i32) i 0] ... (recur acc (+ i 1)))` is the shape the
form exists for, and it is the one the move tracker had to be taught about (below). `recur.flan` carries a `Vec`
round three iterations and answers with it.
`tast.ml` said a `While` the checker *invents* contains no jumps, because the depths would be minted against a stack
it is not on. `check_loop`'s `While` is the exception, and it is the exception because it is pushed on `ctx.loops`
like any other: being invented was never the property that mattered, being on the stack is. The comment now says so.
### Tail position, as a permission that is withdrawn
The alternative was a pre-pass over the `Ast` marking tail positions, which would have to enumerate every constructor
and stay in step with the type forever. Instead `ctx.tail` is read and withdrawn at the top of `check`, the same
read-and-withdraw `defer_ok` already does and for the same reason: nothing reached from here inherits it. Three forms
hand it back on, and they are the only three that pass a tail through — the last form of a `block`, both arms of an
`if` (including the one-armed `when` shape, which is how nearly every loop is written), and a `match` arm. Everything
else is non-tail **by construction**, and no walk has to list the cases that are not.
The bodies of `restart-case` and `handler-bind` are tails semantically and are deliberately not given the permission
here — the barrier below refuses them anyway, and with a better sentence.
### `loop` is a barrier for `break` and `continue`
`lentry` gains `Lrecur`, carrying the slot and type of each of the loop's names. It is the target a `recur` resolves
to, by the same walk over the same stack `break` makes, refusing on the same barriers — `handler-bind`, `restart-case`
and a `defer`'s forms — rather than by a second mechanism.
It is **also a barrier itself**, and that is a restriction added here rather than one inherited. A loop answers with
the value of its body; a `break` out of one would have to produce that value from somewhere and there is nowhere, and
a `continue` would re-run the body without rebinding anything. So both are refused, and the message names the fix
(*answer with the value, or use a while*). A `while` written **inside** a loop sits below the entry and keeps its own
perfectly good break, which is the relative rule doing the job it was built for.
Two consequences fall out of this and are worth stating:
- **`loop` takes no label**, because there is nothing for a label to name. A leading keyword is caught in `parse.ml`
rather than left to `bindings`, which would have complained that `:outer` has no value.
- **A `recur` can only ever be at depth 0 in practice.** A loop body is not a tail position, so no `recur` is ever
written inside a nested loop. `recur_target` counts the depth anyway rather than assuming it, because the count is
what `emit` indexes.
### Two small things the shape forced
**A loop binding is a plain name.** `let`'s `bindings` expands a destructuring pattern into several bindings from one
form, and then `recur`'s argument count would no longer be readable off the binding vector. `loop_bindings` is the
pairs without the patterns, and it refuses a duplicate name.
**The move tracker had to be told.** `in_loop` refuses a body that moves a binding declared outside the loop, because
the second iteration would use what the first gave away. A loop's own names are bound before the entry is pushed —
their initial values are evaluated once, outside — so they would have landed in that set, and
`(loop [v (vec-new i32)] ...)` would have been refused for doing the ordinary thing. `recur` writes every one of them
on the way round, so the rule is not about them; `in_loop` takes the loop's own slots and excludes them.
## `(array 4 rl/Vector2)`, and the one position with no type slot
`[4 T]` is the ordinary type spelling and is unchanged. It already works everywhere a type is expected — `(defvar

49
NEXT.md
View File

@ -120,7 +120,9 @@ abandoned frame leaving half-written state behind; rollback is what finishes tha
**What `PORTING.md` says NOT to build, with evidence:** escaping closures (one capture site, fixed by one parameter),
`Handle`/pools, `Result`/`try`, `handler-case`, `loop`/`recur` and tail calls, user allocators, structural typing —
**none has a customer in that code**. (`Handle` and the pool were built anyway, and on the other reason: they are the
gate on classes. The finding stands and is why they were built small — see [`BUILT.md`](BUILT.md).) And **generics is not the blocker** there either: the element-changing maps are
gate on classes. The finding stands and is why they were built small — see [`BUILT.md`](BUILT.md). `loop`/`recur` was
built too, and the finding stands there as well: what it is not is **tail calls**, which are still not built and still
have no customer.) And **generics is not the blocker** there either: the element-changing maps are
five-line load-time loops. That last one hangs on a design decision the report states flatly — whether the game's
state holds fixed arrays or `Vec`s.
@ -794,7 +796,7 @@ Sources are community consensus rather than a specification; the `contains?` com
Clojure*. Recorded because these are cheap to honour now and expensive to unpick once a standard library depends on
them.
## Queued: `into`, fused transformation without transducers
## ~~Queued: `into`, fused transformation without transducers~~ — **landed**
Decided in conversation. **Not transducers, and not Rust's iterators — a macro that fuses the chain at compile time.**
@ -831,7 +833,26 @@ destination is always honest about what it is.
Drop Clojure's `:eduction` branch — that is the pass-around case, and the one part that would need runtime machinery.
## Queued: `loop`/`recur` (the return type is done)
**Done.** See *`into`, which fuses at compile time because it is a macro* in [`BUILT.md`](BUILT.md). It is a prelude
`defmacro` over a plain `defn` that walks the transforms in reverse, and all four of the macro limits bit without
blocking anything: the three refusals are names nothing defines, `into-wrap` uses only special forms so
`Macro.reduce` does not drop it, the quasiquotes are all single-level, and `into` lives in the prelude because a
macro is not importable.
**The open question is settled: reductions do not share the form.** The reason the destination sits in `into` at all
is that the destination *is* the allocation, which is what makes `spec-memory.md`'s explicit-allocator rule true by
construction. A seed is not an allocation, so `(into xs 0 (map cost) (sum))` would be a second form wearing the same
spelling and the destination would stop being honest about what it is. A reducing macro of the same shape is a
separate form the day something wants one.
Two things the design did not anticipate, both written up there. **A source that is already a name is used as it is**
rather than bound — a `(Vec T)` is move-only, so binding it would take the caller's ownership for a read, and a fixed
array would be copied once per `into`; a source that is anything else is still bound once, which is what a call
needs. And **an owning temporary as the source leaks**, because the macro binds it to a name the caller cannot reach
and cannot know whether the type owns anything. A call in that position should borrow. `drop` is what would close
this, and it does not exist.
## ~~Queued: `loop`/`recur` (the return type is done)~~ — **landed**
~~**1. A `defn` must always state its return type, and unit is written `()`.**~~ **Done.** See *The return type is
the slot, and unit is `()`* in [`BUILT.md`](BUILT.md).
@ -862,18 +883,20 @@ python3 tools/unit-return.py --in-html web/index.html
reports exactly six sites, all in `test_flan.ml`, which spell the refused forms *on purpose* so the refusals can be
tested. Read the diff of every non-`.flan` file — BUILT.md lists what the script can and cannot see.
**2. `loop` and `recur`.** Both are already refused by name in `parse.ml`. There is **no TCO** — nothing emits tail
calls, and `plan.org` mentions them only as something the current backend choice *could* control (LLVM's `musttail` is
there if wanted).
~~**2. `loop` and `recur`.**~~ **Done.** See *`loop` and `recur`, and why `recur` is better than tail calls and not
only cheaper* in [`BUILT.md`](BUILT.md). `emit.ml` is untouched: a loop is a `let`, a `While` whose condition is
`true`, and two jumps, and the barrier question `recur` asks is the one labelled `break` already answered.
`recur` is the better answer than silent TCO, and not only because it is cheaper. **It is checked**: the compiler
verifies the call is in tail position and turns it into a jump, so breaking tail position is a compile error rather
than a stack overflow at run time. Clojure adopted it because the JVM lacks TCO and it turned out to be the better
design.
Three things the plan did not anticipate, each written up there. **Tail position is a permission that is withdrawn**
rather than a pre-pass over the `Ast` — `ctx.tail` is read and cleared at the top of `check`, exactly as `defer_ok`
is, and handed back only by the three forms that pass a tail through, so nothing has to enumerate the forms that do
not. **`loop` is itself a barrier** for `break` and `continue`, which is a restriction added rather than inherited: a
loop answers with the value of its body, so a jump out of one has no value to give, and therefore `loop` also takes
no label. And **the move tracker had to be told about the loop's own names**, which are bound before the loop entry is
pushed and would otherwise have tripped the "moves a value bound outside the loop" rule on the ordinary case.
Cheap here — a jump to the top of a `loop`, which is the machinery `while` and the new labelled `break`/`continue`
already have. What it does **not** give is mutual recursion between two functions; that needs real tail calls, and is
a separate question if it is ever wanted.
Still not given, and still out of scope: **mutual recursion between two functions.** That needs real tail calls. The
refusal for a `recur` outside any loop says so by name.
## The next batch, in order

10
lib/ast.ml
View File

@ -43,6 +43,16 @@ and expr_kind =
(* The [string option] is a loop label: [(while :outer c ...)]. A keyword in
that position is unambiguous because a loop condition is never one. *)
| While of string option * expr * expr list
(* [(loop [x 0 acc 1] body ...)] and [(recur v ...)]. A loop answers with the
value of its body; a [recur] rebinds every one of the loop's names at once
and jumps back to the top. It is not a tail call and there is no tail-call
elimination anywhere in this compiler — the checker refuses a [recur] that
is not in the loop body's tail position, so what would be a stack overflow
under silent TCO is a compile error here. Each name takes a plain symbol:
a destructuring pattern would turn one name into several and [recur]'s
argument count could no longer be read off the binding vector. *)
| Loop of (string * expr) list * expr list
| Recur of expr list
| Return of expr option
(* Leaving a loop, and starting its next iteration. The [string option] is
the label of the loop meant, and [None] means the innermost. Neither is a

246
lib/check.ml
View File

@ -143,6 +143,12 @@ let declared_note env name =
it can name a loop outside it. *)
type lentry =
| Lloop of string option
(* A [(loop ...)], carrying the slot and type of each of its names so that a
[recur] can rebind them. It is *also* a barrier for [break] and
[continue]: a loop answers with the value of its body, so a jump that left
one would have no value to give. A [while] written inside a loop is
unaffected, which is the relative rule doing its job again. *)
| Lrecur of (int * Types.t) list
| Lbarrier of string
(* Per-function state. Slots are never reused, so [slots] is also the frame
@ -205,6 +211,13 @@ type ctx = {
of why they are not a goto — a label that names no loop on this list is
refused, so control can only leave a loop it is already in. *)
mutable loops : lentry list;
(* True where this form's value is the value of the enclosing [loop]'s body,
which is the only place a [recur] may stand. Read and withdrawn at the top
of [check] exactly as [defer_ok] is, and granted again by the three forms
that pass a tail through: the last form of a block, both arms of an [if],
and a [match] arm. Everything else is therefore non-tail by construction,
and no walk has to enumerate the cases that are not. *)
mutable tail : bool;
(* True inside a [defer]'s forms. A defer is the cleanup a transfer runs on
its way out (§5), so a transfer *starting* there has no answer: this
function's defers are already half run and the first transfer's target is
@ -794,7 +807,7 @@ let hash_ty = Types.Int Types.U64
none of these is a body anyone wrote. *)
let invented_ctx env ret =
{ env; ret; slots = 0; slot_tys = []; slot_names = []; scope = [];
defers = []; outer = []; outer_what = None; in_frames = None; loops = [];
defers = []; outer = []; outer_what = None; in_frames = None; loops = []; tail = false;
in_defer = false; defer_ok = false; defer_block = "a nested form";
dead = []; borrow = false; owner = "<none>" }
@ -995,6 +1008,11 @@ let rec check ctx ?want (e : Ast.expr) : Tast.expr =
grant it again before the *next* form rather than once around the body. *)
let defer_ok = ctx.defer_ok in
ctx.defer_ok <- false;
(* The same read-and-withdraw, for the same reason: a [recur] is in tail
position only if *this* form was, and nothing reached from here inherits
it unless the arm below hands it on deliberately. *)
let tail = ctx.tail in
ctx.tail <- false;
match e.Ast.e with
| Ast.Int n -> int_literal loc ~want n
| Ast.Byte b -> int_literal loc ~want ~default:Types.U8 (Int64.of_int b)
@ -1033,11 +1051,13 @@ let rec check ctx ?want (e : Ast.expr) : Tast.expr =
| Ast.Quote _ ->
unimplemented loc "a quoted symbol (restart names)" 6
| Ast.Var name -> var ctx loc ~want name
| Ast.Do body -> block ctx ?want loc body
| Ast.Do body -> ctx.tail <- tail; block ctx ?want loc body
(* [defer_ok] rides through: a [let] at the top level of a function body has
exactly the function's extent, and so does a [let] nested inside one. *)
| Ast.Let (bs, body) -> check_let ctx ?want ~defer_ok loc bs body
| Ast.If (c, t, e') -> check_if ctx ?want loc c t e'
exactly the function's extent, and so does a [let] nested inside one.
[tail] rides through for the same shape of reason: a [recur] written as
the last form of a [let] inside a loop body is in the loop's tail. *)
| Ast.Let (bs, body) -> check_let ctx ~tail ?want ~defer_ok loc bs body
| Ast.If (c, t, e') -> check_if ctx ~tail ?want loc c t e'
| Ast.While (label, c, body) ->
let c = check ctx ~want:Types.Bool c in
let body = in_loop ctx ?label (fun () ->
@ -1048,6 +1068,12 @@ let rec check ctx ?want (e : Ast.expr) : Tast.expr =
expect loc ~want (mk loc Types.Unit (Tast.While (c, body, [])))
(* [Never], as [exit] and [return] are: nothing after one of these runs, and
an [if] arm that ends in a break does not have to agree with the other. *)
(* (loop [x 0 acc 1] body ...) — a loop that answers with the value of its
body, and the only place a [recur] may stand. Not an IR node: it is a
[let] over the names, a [While] whose condition is [true], and a jump.
See [check_loop]. *)
| Ast.Loop (bs, body) -> check_loop ctx ?want loc bs body
| Ast.Recur args -> check_recur ctx ~tail loc args
| Ast.Break label ->
mk loc Types.Never (Tast.Break (loop_target ctx loc "break" label))
| Ast.Continue label ->
@ -1101,7 +1127,7 @@ let rec check ctx ?want (e : Ast.expr) : Tast.expr =
| Ast.ArrayOf t ->
let ty = resolve ctx.env t in
expect loc ~want (mk loc ty (Tast.Zero ty))
| Ast.Match (scrutinee, arms) -> check_match ctx ?want loc scrutinee arms
| Ast.Match (scrutinee, arms) -> check_match ctx ~tail ?want loc scrutinee arms
| Ast.Call (head, args) -> check_call ctx ~want loc head args
| Ast.Unwrap (Ast.Usome, v) ->
(* Unwrap Some, else early-return None from the enclosing function, so the
@ -1372,14 +1398,22 @@ and borrowed ctx (a : Ast.expr) f =
[let] is the case the relaxation exists for. *)
and block ctx ?want ?(defer_ok = false) loc body =
match body with
| [] -> expect loc ~want (unit_at loc)
(* Withdrawn here too. An empty body has no last form to be the tail, so
leaving the permission set would hand it to whatever is checked next. *)
| [] -> ctx.tail <- false; expect loc ~want (unit_at loc)
| _ ->
(* A block's tail is its last form and nothing else. Callers that must not
pass one on need do nothing: [check] withdrew it before they were
reached, so [tail] is already false here for all of them. *)
let tail = ctx.tail in
let rec go = function
| [ last ] ->
ctx.defer_ok <- defer_ok;
ctx.tail <- tail;
let l = check ctx ?want last in [ l ], l.Tast.ty
| x :: rest ->
ctx.defer_ok <- defer_ok;
ctx.tail <- false;
let x = check ctx x in
let rest, ty = go rest in x :: rest, ty
| [] -> assert false
@ -1433,7 +1467,7 @@ and check_fn ctx ~want loc (params : string list) body =
let fctx =
{ env = ctx.env; ret; slots = 0; slot_tys = []; slot_names = [];
scope = []; defers = []; outer = ctx.scope;
outer_what = Some "an fn"; in_frames = None; loops = [];
outer_what = Some "an fn"; in_frames = None; loops = []; tail = false;
in_defer = false; defer_ok = false; defer_block = "a nested form";
dead = []; borrow = false; owner = ctx.owner }
in
@ -1509,7 +1543,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; outer_what = Some "a handler"; in_frames = None; loops = []; in_defer = false; defer_ok = false; defer_block = "a nested form"; dead = []; borrow = false; owner = "<none>" }
scope = []; defers = []; outer = ctx.scope; outer_what = Some "a handler"; in_frames = None; loops = []; tail = false; in_defer = false; defer_ok = false; defer_block = "a nested form"; 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.
@ -1661,7 +1695,7 @@ and register_defer ctx loc forms =
(* [defer_ok] says whether *this* let has the function's extent. If it does, so
does every form in its body, including a nested let — which is why the flag
is handed to the body rather than consumed here. *)
and check_let ctx ?want ?(defer_ok = false) loc bs body =
and check_let ctx ?(tail = false) ?want ?(defer_ok = false) loc bs body =
scoped ctx (fun () ->
let bs =
map_lr
@ -1678,6 +1712,8 @@ and check_let ctx ?want ?(defer_ok = false) loc bs body =
(slot, v))
bs
in
(* After the bindings, because checking each of them withdrew it. *)
ctx.tail <- tail;
let body = block ctx ?want ~defer_ok loc body in
mk loc body.Tast.ty (Tast.Let (bs, [ body ])))
@ -1690,13 +1726,20 @@ and check_let ctx ?want ?(defer_ok = false) loc bs body =
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 ?label f =
let outer_slots = List.map (fun (_, b) -> b.slot) ctx.scope in
and in_loop ctx ?label ?entry ?(fresh = []) f =
let outer_slots =
List.filter (fun s -> not (List.mem s fresh))
(List.map (fun (_, b) -> b.slot) ctx.scope)
in
let before = ctx.dead in
(* The loop goes on the stack before the body is checked and comes off after,
so a [break] inside it can see it and one outside it cannot. *)
let loops = ctx.loops in
ctx.loops <- Lloop label :: loops;
(* [fresh] is a [loop]'s own names. They are bound before the entry is pushed
— their initial values are evaluated once, outside — but [recur] writes
every one of them on the way round, so the next iteration never sees what
this one gave away and the rule below is not about them. *)
ctx.loops <- (match entry with Some e -> e | None -> Lloop label) :: loops;
(* Named so that a defer written in here is refused as "a loop body" rather
than as a nested form: the reason is specific — it would fire once at
function exit rather than once per iteration — and the message says it. *)
@ -1736,6 +1779,23 @@ and loop_target ctx loc verb label =
| None -> depth
| Some l when name = Some l -> depth
| Some _ -> go (depth + 1) rest)
(* A [loop] answers with the value of its body. A jump out of one would
have to produce that value from somewhere and there is nowhere, so it is
a barrier like the others, named as what it is. A [while] written inside
a loop sits below this entry and keeps its own break. *)
| Lrecur _ :: _ ->
(match label with
| None ->
fail loc
"%s is not allowed here: the nearest loop is a (loop ...), which \
answers with the value of its body, so leaving it this way would \
have no value to give. Answer with the value, or use a while"
verb
| Some l ->
fail loc
"%s :%s would leave a (loop ...), which it may not: a loop answers \
with the value of its body and a jump out of one has no value to \
give" verb l)
| Lbarrier what :: rest ->
(* Crossing it would skip whatever the construct does on the way out —
the handler or restart frames it pushed, or, for a defer, would jump
@ -1785,13 +1845,152 @@ and check_dotimes ctx ~want loc label name count body =
expect loc ~want
(mk loc Types.Unit (Tast.Let ([ (i, zero); (limit, count) ], [ loop ]))))
and check_if ctx ?want loc c t e =
(* ── (loop [...] ...) and (recur ...) ───────────────────────────────────
A loop is a [let] over its names, a [While] whose condition is [true], and
two jumps: [recur] rebinds every name and continues, and falling off the end
of the body breaks. Nothing new reaches the backend, which is the whole
argument for [recur] over tail calls — the machinery is the one [while] and
the labelled [break]/[continue] already needed.
**The value.** A loop answers with the value of its body, so the result is
written into a slot of its own on the way out and read after the loop. A
body that is [Unit] needs no slot, and a body that is [Never] — one that
only ever recurs or returns — needs neither a slot nor the break, because
nothing falls off the end of it.
**Why [Set] of a [Never] body is safe.** [emit] closes a block at its
terminator and drops what follows ([ins] checks [f.live]), so when the body
ends in a jump the store is simply never written. The one ordering that
matters is inside [Tast.Set]: the place is resolved before the value, and a
local's place is an address with no instruction behind it.
**Why the invented [While] may carry jumps.** [tast.ml] says a [While] the
checker invents contains none, because the depths it would carry were minted
against a stack it is not on. This one is different and the difference is
the licence: it is pushed on [ctx.loops] like any other, so the [Break 0]
below and every [continue] a [recur] mints count from the same stack [emit]
indexes. *)
and check_loop ctx ?want loc bs body =
scoped ctx (fun () ->
(* Each initial value is evaluated once, before the loop, exactly as a
[let]'s is and as [dotimes]'s bound is. *)
let inits =
map_lr
(fun (n, v) ->
let v = check ctx v in
(match v.Tast.ty with
| Types.Unit | Types.Never ->
fail v.Tast.loc "%s would be bound to %s, which is not a value" n
(Types.to_string v.Tast.ty)
| _ -> ());
(n, v))
bs
in
let binds =
List.map (fun (n, v) -> (bind ctx n v.Tast.ty ~assignable:true, v)) inits
in
let names = List.map (fun (slot, v) -> (slot, v.Tast.ty)) binds in
(* The singleton is [in_loop]'s doing: it sits in this recursive group and
is therefore monomorphic, and every other caller hands it a list. *)
let tbody =
match
in_loop ctx ~entry:(Lrecur names) ~fresh:(List.map fst binds) (fun () ->
[ scoped ctx (fun () ->
(* The body's last form is the loop's tail, which is the only
place a [recur] may stand. [block] distributes it. *)
ctx.tail <- true;
block ctx ?want loc body) ])
with
| [ b ] -> b
| _ -> assert false
in
let ty = tbody.Tast.ty in
let yes = mk loc Types.Bool (Tast.Bool true) in
let leave = mk loc Types.Never (Tast.Break 0) in
let inner, result =
if ty = Types.Never then ([ tbody ], None)
else if ty = Types.Unit then ([ tbody; leave ], None)
else
let r = fresh_slot ctx ty in
([ mk loc Types.Unit (Tast.Set (Tast.Plocal r, tbody)); leave ], Some r)
in
let loop = mk loc Types.Unit (Tast.While (yes, inner, [])) in
match result with
| None -> expect loc ~want (mk loc ty (Tast.Let (binds, [ loop ])))
| Some r ->
expect loc ~want
(mk loc ty
(Tast.Let (binds @ [ (r, mk loc ty (Tast.Zero ty)) ],
[ loop; mk loc ty (Tast.Local r) ]))))
(* Which loop a [recur] means, and what it has to rebind. The same walk
[break] and [continue] make, over the same stack and refusing on the same
barriers — [recur] asks "may this jump cross that" and gets the answer that
was already settled, not a second mechanism. *)
and recur_target ctx loc =
let rec go depth = function
| [] ->
fail loc
"recur is only allowed inside a (loop ...). There are no tail calls in \
this compiler, so a function cannot recur into itself and two \
functions cannot recur into each other — write the repetition as a \
loop with a recur in its tail"
| Lrecur names :: _ -> (depth, names)
(* Unreachable while the tail rule holds — a loop body is not a tail
position, so no [recur] is ever written inside one — but the depth is
counted rather than assumed, because it is what [emit] indexes. *)
| Lloop _ :: rest -> go (depth + 1) rest
| Lbarrier what :: _ ->
fail loc
"recur would leave %s, which it may not: whatever %s does on the way \
out would be skipped. Write the loop inside it, or leave with a value \
and test that after"
what what
in
go 0 ctx.loops
and check_recur ctx ~tail loc args =
let depth, names = recur_target ctx loc in
(* Checked, which is the whole of why this is better than a silent TCO: a
recur that is not in tail position is a compile error here, where under
tail calls it would have been a stack overflow at run time. *)
if not tail then
fail loc
"recur must be in the tail position of its loop — the last thing the \
body does, or the last thing in an if, match or let arm that is itself \
in the tail. Here something would still have to run afterwards, and a \
recur is a jump back to the top, not a call that returns";
let want = List.length names and got = List.length args in
if want <> got then
fail loc "this loop binds %d name%s and this recur passes %d" want
(if want = 1 then "" else "s") got;
let vals = List.map2 (fun a (_, ty) -> check ctx ~want:ty a) args names in
(* Every name is rebound at once. The new values go into temporaries first,
so that (recur y x) swaps rather than writing y over x and then reading it
back — the same reason Clojure's recur is simultaneous. *)
let temps = List.map2 (fun v (_, ty) -> (fresh_slot ctx ty, v)) vals names in
let sets =
List.map2
(fun (t, _) (slot, ty) ->
mk loc Types.Unit
(Tast.Set (Tast.Plocal slot, mk loc ty (Tast.Local t))))
temps names
in
mk loc Types.Never
(Tast.Let (temps, sets @ [ mk loc Types.Never (Tast.Continue depth) ]))
and check_if ctx ?(tail = false) ?want loc c t e =
let c = check ctx ~want:Types.Bool c in
(* Both arms are the tail, and a one-armed [if] counts: [(when c (recur ...))]
is how nearly every loop is written, and the branch is still the last
thing the body does. *)
let in_tail f = ctx.tail <- tail; f () in
match e with
| None ->
(* A one-armed if produces Unit whatever the branch evaluates to: there is
no value on the missing side. `when` desugars to this. *)
let t = branch ctx (fun () -> check ctx t) in
let t = branch ctx (fun () -> in_tail (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
@ -1800,7 +1999,7 @@ and check_if ctx ?want loc c t e =
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 = branch ctx (fun () -> check ctx ?want t) in
let t = branch ctx (fun () -> in_tail (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,
@ -1810,7 +2009,7 @@ and check_if ctx ?want loc c t e =
| Some _ -> want
| None -> if t.Tast.ty = Types.Never then None else Some t.Tast.ty
in
let e = branch ctx (fun () -> check ctx ?want:ewant e) in
let e = branch ctx (fun () -> in_tail (fun () -> check ctx ?want:ewant e)) in
ctx.dead <-
after_then
@ List.filter (fun (k, _) -> not (List.mem_assoc k after_then)) ctx.dead;
@ -1959,7 +2158,7 @@ and check_arr ctx ~want loc items =
an array literal does not satisfy a slice expectation. *)
expect loc ~want (mk loc (Types.Array (n, elem)) (Tast.Arr items))
and check_match ctx ?want loc scrutinee arms =
and check_match ctx ?(tail = false) ?want loc scrutinee arms =
let s = check ctx scrutinee in
(* What the arms are alternatives over. An [Option] is a two-case union
wearing a special coat, so the two shapes below are the same shape: a set
@ -2066,6 +2265,9 @@ and check_match ctx ?want loc scrutinee arms =
List.map
(fun (n, ty) -> bind ctx n ty ~assignable:false) binds
in
(* Every arm is the tail, exactly as an [if]'s two arms are.
Restored here because checking the scrutinee withdrew it. *)
ctx.tail <- tail;
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;
@ -4345,7 +4547,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 = []; outer_what = None; in_frames = None; loops = []; in_defer = false; defer_ok = false; defer_block = "a nested form"; dead = []; borrow = false; owner = "<none>" } v).Tast.ty
outer = []; outer_what = None; in_frames = None; loops = []; tail = false; in_defer = false; defer_ok = false; defer_block = "a nested form"; dead = []; borrow = false; owner = "<none>" } v).Tast.ty
in
let pending = ref (List.rev !untyped) in
let rec settle () =
@ -4398,7 +4600,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 = []; outer_what = None; in_frames = None; loops = []; in_defer = false; defer_ok = false; defer_block = "a nested form"; dead = []; borrow = false;
outer = []; outer_what = None; in_frames = None; loops = []; tail = false; in_defer = false; defer_ok = false; defer_block = "a nested form"; dead = []; borrow = false;
owner = fn.Ast.name } in
List.iter2
(fun (p : Ast.field) ty ->
@ -4501,7 +4703,7 @@ let no_move_only_global loc n (ty : Types.t) =
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 = []; outer_what = None; in_frames = None; loops = []; in_defer = false; defer_ok = false; defer_block = "a nested form"; dead = []; borrow = false; owner = "<none>" } in
outer = []; outer_what = None; in_frames = None; loops = []; tail = false; in_defer = false; defer_ok = false; defer_block = "a nested form"; dead = []; borrow = false; owner = "<none>" } in
match d.Ast.d with
| Ast.Defvar (n, _, init) ->
let ty, _ = Hashtbl.find env.globals n in
@ -4665,7 +4867,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 = []; outer_what = None; in_frames = None; loops = []; in_defer = false; defer_ok = false; defer_block = "a nested form"; dead = []; borrow = false; owner = "<none>" }
outer = []; outer_what = None; in_frames = None; loops = []; tail = false; in_defer = false; defer_ok = false; defer_block = "a nested form"; dead = []; borrow = false; owner = "<none>" }
in
let t = check ctx e in
(t, Array.of_list (List.rev ctx.slot_tys),

7
lib/load.ml
View File

@ -184,6 +184,11 @@ let rec rename_expr owned alias bound (e : Ast.expr) : Ast.expr =
Ast.Let (List.rev bs, List.map (rename_expr owned alias bound) body)
| Ast.If (c, t, e') -> Ast.If (go c, go t, Option.map go e')
| Ast.While (l, c, body) -> Ast.While (l, go c, gos body)
(* A loop's names are its own and are never imported; its initial
values and its body are ordinary expressions. *)
| Ast.Loop (bs, body) ->
Ast.Loop (List.map (fun (n, v) -> (n, go v)) bs, gos body)
| Ast.Recur args -> Ast.Recur (gos args)
(* A loop label is not a top-level name: it is resolved against the loops
this form is inside, so an import has nothing to qualify. *)
| (Ast.Break _ | Ast.Continue _) as k -> k
@ -377,6 +382,8 @@ let rec expr_uses acc (e : Ast.expr) =
gos body
| Ast.If (c, t, e') -> go c; go t; Option.iter go e'
| Ast.While (_, c, body) -> go c; gos body
| Ast.Loop (bs, body) -> List.iter (fun (_, v) -> go v) bs; gos body
| Ast.Recur args -> gos args
| Ast.Break _ | Ast.Continue _ -> ()
| Ast.Return v -> Option.iter go v
| Ast.Set (p, v) -> place_uses acc e.Ast.loc p; go v

43
lib/parse.ml
View File

@ -233,6 +233,25 @@ and form f mk (head : Form.t) (args : Form.t list) : Ast.expr =
mk (Ast.Dotimes (lbl, sym n, expr count, body_of body))
| _ -> fail f "dotimes is (dotimes [name count] body ...)")
(* [(loop [x 0 acc 1] body ...)]. No label: [break] and [continue] may not
leave a loop — a loop answers with the value of its body, and a jump out
of one has no value to give — so there is nothing here for a label to
name. A leading keyword is caught here rather than left to [bindings],
which would complain that [:outer] has no value. *)
| Sym "loop" ->
(match args with
| { v = Kw k; _ } :: _ ->
fail f
":%s — loop takes no label. break and continue may not leave a loop, \
because a loop answers with the value of its body; there is nothing \
for a label to name" k
| { v = Vec bs; _ } :: body -> mk (Ast.Loop (loop_bindings f bs, body_of body))
| _ -> fail f "loop is (loop [name value ...] body ...)")
(* Rebind and jump to the top. Its arguments are checked against the loop's
names in order, so the count is the binding vector's count. *)
| Sym "recur" -> mk (Ast.Recur (List.map expr args))
| Sym "defer" ->
(match args with
| [] -> fail f "defer is (defer body ...)"
@ -350,7 +369,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" | "loop" | "recur"
| "errdefer"
| "await" as name) ->
fail f "%s is not implemented yet (see the build sequence in plan.org)" name
@ -384,6 +403,28 @@ and label (items : Form.t list) : string option * Form.t list =
| { v = Kw k; _ } :: rest -> (Some k, rest)
| _ -> (None, items)
(* A loop's binding vector. Pairs like [let]'s, but plain names only: a
destructuring pattern expands to several bindings from one form, and then
[recur]'s argument count would no longer match what is written here. *)
and loop_bindings f (items : Form.t list) : (string * Ast.expr) list =
let rec go = function
| [] -> []
| name :: value :: rest ->
no_pattern name;
(sym name, expr value) :: go rest
| [ odd ] ->
Loc.fail odd.loc
"binding %s has no value — loop takes name/value pairs"
(Form.to_string odd)
in
let bs = go items in
List.iter
(fun (n, _) ->
if List.length (List.filter (fun (m, _) -> m = n) bs) > 1 then
fail f "%s is bound twice in this loop" n)
bs;
bs
and bindings f (items : Form.t list) : Ast.binding list =
(* [name value ...] and [name Type value ...] both read; a type is a form
that is not a value position — disambiguated by pair vs triple is

122
lib/prelude.ml
View File

@ -1519,6 +1519,128 @@ let source = {flan|
`(unless-takes-a-test-and-a-body)
`(if (not ~(at args 0)) (do ~@(form-rest args 1)))))
;; ── into: a fused transformation, and not a transducer ────────────────
;;
;; (into xs (vec-new i32) (map double) (filter even?))
;;
;; Source, destination, then any number of transforms. It reads as a sentence
;; — take this, put it there, doing these — and the variadic tail has to trail
;; anyway, which is the mechanical reason the transforms cannot sit in the
;; middle.
;;
;; **A macro, not transducers.** Transducers compose at run time: function
;; values, closures, an allocation, and a chain of indirect calls per element.
;; Rust has no transducers either — it has iterators, which fuse at compile
;; time through monomorphisation, and that needs generics. A macro reaches the
;; same place with neither. (map double) expands to (double x) written straight
;; into the loop body, so the function name is *syntax* and never a value:
;; there is no intermediate collection at any step, no closure, no generics and
;; nothing to inline. What it gives up is building a transformation at run time
;; and passing it around, which is transducers' actual selling point and is
;; close to useless in a game.
;;
;; **The destination is in the form on purpose.** Every collecting operation
;; here allocates from an explicit allocator, which is a frozen rule in
;; spec-memory.md. A ->> chain would hide where the result goes; naming the
;; destination means this macro knows its type, emits the right loop, and the
;; rule is honoured by construction. `(vec-new i32 a)` names an allocator here
;; as it does anywhere else, because the destination form is written out
;; untouched.
;;
;; **The destination is a Vec**, because push is what fills it. A Map
;; destination is refused by push, which says "push takes a (Vec T)" and names
;; the real problem; there is no second lowering for it and no reason to invent
;; one before something wants it.
;;
;; **Reductions do not share this form**, and that was the open question. (into
;; xs 0 (map cost) (sum)) reads oddly because zero is not a collection, and the
;; oddness is the tell: the whole reason the destination sits in the form is
;; that it is the allocation, and a seed is not one. Keeping `into` to
;; collections means the destination is always honest about what it is. A
;; reducing macro of the same shape is a separate form when something wants it.
;; The chain, built from the inside out: the innermost form is the push, and
;; each transform wraps whatever the transforms after it produced. Walked in
;; reverse for that reason, which is what the loop's two names are.
;;
;; One element name throughout, shadowed by each (map f) stage. A let binding's
;; value is checked before the name is bound, so (let [x (f x)] ...) reads the
;; outer x and binds the inner one — that is the language's rule and not an
;; accident of the compiler; the debug-info suffix `x~2` exists precisely so a
;; debugger does not lie about which is which. The name is a gensym, so it
;; cannot collide with anything at the call site.
;;
;; A transform that is neither map nor filter expands to a call to a name
;; nothing defines, which is how a macro reports anything at all: it has no
;; error facility, so the report is "unknown name" at the call site — the right
;; place and the wrong sentence. The bad transform is passed along so that at
;; least it is named.
(defn into-wrap [ts [Form] dst Form x Form] Form
(loop [k (len ts) body `(push ~dst ~x)]
(if (= k 0)
body
(let [t (at ts (- k 1))
items (form-items t)]
(if (!= (len items) 2)
`(into-transform-is-map-or-filter-of-one-function ~t)
(let [head (at items 0)
f (at items 1)]
(cond
(form-sym? head "map") (recur (- k 1) `(let [~x (~f ~x)] ~body))
(form-sym? head "filter") (recur (- k 1) `(when (~f ~x) ~body))
:else `(into-transform-is-map-or-filter ~t))))))))
;; The items of a list form, and the empty slice for anything else — a
;; non-list transform falls into the arity complaint above rather than needing
;; a case of its own.
(defn form-items [f Form] [Form]
(match f
(Form.List xs) xs
_ (form-nil)))
(defn form-sym? [f Form name string] bool
(match f
(Form.Sym s) (bytes=? (bytes s) (bytes name))
_ false))
(defn form-is-sym? [f Form] bool
(match f
(Form.Sym s) true
_ false))
(defn form-pair [a Form b Form] [Form]
(form-cons a (form-cons b (form-nil))))
;; A source that is already a name is used as it is, and a source that is
;; anything else is bound to one. Both halves matter.
;;
;; Binding it is what a source that is a *call* needs: (len s) and (at s i)
;; have to be the same s, and without the binding the call would be made twice
;; per element.
;;
;; Not binding a name is what everything else needs. A (Vec T) is move-only, so
;; (let [s v] ...) would hand v's ownership to the macro's own binding and the
;; caller would find v dead after an (into v ...) that only read it — and a
;; fixed array would be *copied* into the binding, once per into. Neither is
;; what was written. len and at borrow, so used directly the source is only
;; read. A source that is a call and produces a Vec is still consumed, which is
;; right: nobody else is holding it.
(defmacro into [args]
(if (< (len args) 2)
`(into-takes-a-source-a-destination-and-transforms)
(let [from (at args 0)
named? (form-is-sym? from)
src (if named? from (gensym))
bind (if named? (form-nil) (form-pair src from))
dst (gensym)
x (gensym)
i (gensym)]
`(let [~dst ~(at args 1) ~@bind]
(dotimes [~i (len ~src)]
(let [~x (at ~src ~i)]
~(into-wrap (form-rest args 2) dst x)))
~dst))))
|flan}
let file = "<prelude>"

8
lib/tast.ml
View File

@ -112,7 +112,13 @@ and expr_kind =
only from its own loop stack, and both stacks are pushed once per [While].
A [While] the checker *invents* (alloc_guard, the file-failure retry) is
built directly and never contains one of these, so the entry it pushes in
[emit] matches nothing and is harmless — keep it that way. *)
[emit] matches nothing and is harmless — keep it that way.
[check_loop]'s [While] is the one exception and the exception proves the
rule: it *is* pushed on [ctx.loops], so the [Break 0] that leaves it and
every [Continue] a [recur] mints are counted against the same stack [emit]
indexes. Invented is not the property that matters; being on the stack
is. *)
| Break of int
| Continue of int
| Set of place * expr

94
test/programs/into.flan Normal file
View File

@ -0,0 +1,94 @@
;;;; into — a fused transformation, and not a transducer.
;;;;
;;;; What is asserted here is the thing a unit test cannot see: the loop that
;;;; comes out is one loop, and the values it produces are the ones the chain
;;;; describes in the order it was written.
;;;;
;;;; 1. The order of the transforms is the order of the stages. (filter even?)
;;;; before (map double) is not the same program as after it, and both are
;;;; here with different answers.
;;;; 2. There is no intermediate collection. `pulls` counts every call to the
;;;; transform functions: one pass over the source is one call per element
;;;; per stage it reaches, and a chain that built a Vec per stage would pull
;;;; a different number.
;;;; 3. A source that is already a name is only read. `src` is a (Vec i32),
;;;; which is move-only, and it is still alive and freeable afterwards.
;;;; 4. A source that is a call is evaluated once, not once per element.
(defvar pulls i32 0)
(defn double [x i32] i32
(set pulls (+ pulls 1))
(* x 2))
(defn even? [x i32] bool
(set pulls (+ pulls 1))
(= (% x 2) 0))
(defvar builds i32 0)
;; A source that is a call. It must be made once, however many elements come
;; out of it. It borrows rather than allocating, which is the shape a call in
;; this position wants: the macro binds the value to a name the caller cannot
;; see, so an owning temporary here would be a leak nobody can reach.
(defn source [xs [i32]] [i32]
(set builds (+ builds 1))
(slice xs 0 (len xs)))
(defn wide [x i32] f32 (f32 x))
(defn bigf? [x f32] bool (> x 2.5))
(defn show [v [i32]] ()
(dotimes [i (len v)] (print (at v i)) (print " "))
(println ""))
(defn main [] i32
;; No transforms: a copy into the destination named in the form.
(let [xs [7 8 9]
v (into xs (vec-new i32))]
(show (as-slice v)) ; 7 8 9
(free v))
;; map then filter.
(let [xs [1 2 3 4 5 6]
v (into xs (vec-new i32) (map double) (filter even?))]
(show (as-slice v)) ; 2 4 6 8 10 12
(free v))
;; filter then map, over the same source: a different answer, because the
;; stages are in the order they were written.
(let [xs [1 2 3 4 5 6]
v (into xs (vec-new i32) (filter even?) (map double))]
(show (as-slice v)) ; 4 8 12
(free v))
;; One pass and no intermediate collection. The two chains above pulled
;; 6 doubles + 6 evens, then 6 evens + 3 doubles: 21.
(print pulls) (println "") ; 21
;; A name as the source is read, not moved: src is still alive here.
(let [src (into [3 1 2] (vec-new i32))
v (into src (vec-new i32) (map double))]
(show (as-slice v)) ; 6 2 4
(show (as-slice src)) ; 3 1 2
(free v)
(free src))
;; A type-changing map: the chain's element name is rebound at the new type
;; by each stage, and the push sees the destination's element type. One name,
;; shadowed — a let binding's value is checked before its name is bound, so
;; each stage reads the stage before it.
(let [xs [1 2 3 4]
v (into xs (vec-new f32) (map wide) (filter bigf?))]
(dotimes [i (len v)] (print (at v i)) (print " "))
(println "") ; 3 4
(free v))
;; A source that is a call is bound once, so it is made once however many
;; elements come out of it.
(let [xs [1 2 3 4]
v (into (source (slice xs 0 4)) (vec-new i32) (filter even?))]
(show (as-slice v)) ; 2 4
(free v))
(print builds) (println "") ; 1
0)

102
test/programs/recur.flan Normal file
View File

@ -0,0 +1,102 @@
;;;; loop and recur.
;;;;
;;;; What is worth asserting here rather than in a unit test is the code that
;;;; comes out, and there are four things:
;;;;
;;;; 1. A loop answers with the value of its body — the accumulator comes back
;;;; without a mutable slot and without a sentinel flag.
;;;; 2. recur rebinds every name *at once*. A swap is the test that fails if
;;;; the writes were interleaved with the reads.
;;;; 3. recur is a jump, not a call. A loop that goes round ten million times
;;;; would overflow the stack if it were a call, and this one returns.
;;;; 4. A loop whose body never falls off the end (every path recurs or
;;;; returns) still terminates, which is the Never-bodied shape.
(defn gcd [a i32 b i32] i32
(loop [x a y b]
(if (= y 0)
x
(recur y (% x y)))))
;; The body is Never: neither arm produces a value, so there is no result slot
;; and no break — nothing falls off the end of this loop.
(defn first-over [n i32] i32
(loop [i 0]
(if (> (* i i) n)
(return i)
(recur (+ i 1)))))
;; Named so the match below has a return type to read None out of.
(defn step [i i32] (Option i32)
(if (= i 4) None (Some i)))
(defn main [] i32
;; The value of the body, with no mutable accumulator anywhere.
(print (loop [i 0 acc 0]
(if (= i 5)
acc
(recur (+ i 1) (+ acc i)))))
(println "") ; 0+1+2+3+4 = 10
;; Simultaneous rebinding. Interleaved writes would give 1 1.
(let [p (loop [a 1 b 2 n 0]
(if (= n 3)
a
(recur b a (+ n 1))))]
(print p) (println "")) ; three swaps: 2
(print (gcd 1071 462)) (println "") ; 21
(print (first-over 50)) (println "") ; 8
;; A jump and not a call: ten million frames is not a stack this has.
(print (loop [i 0]
(if (= i 10000000) i (recur (+ i 1)))))
(println "") ; 10000000
;; recur in the tail of a let, and of a when inside a do — both are tails,
;; and both are how a loop actually gets written.
(print (loop [i 0 acc 1]
(let [next (* acc 2)]
(if (= i 6) acc (recur (+ i 1) next)))))
(println "") ; 2^6 = 64
;; A Unit-bodied loop: it is run for its effect and answers with nothing.
(let [n 0]
(loop [i 0]
(when (< i 3)
(print i)
(recur (+ i 1))))
(println "") ; 012
(print n) (println "")) ; 0
;; A while nested inside a loop keeps its own break: the loop is a barrier
;; only to a jump that would *leave* it.
(print (loop [i 0 acc 0]
(if (= i 4)
acc
(let [j 0 hit 0]
(while (< j 10)
(set j (+ j 1))
(when (= j 3) (set hit 1) (break)))
(recur (+ i 1) (+ acc hit))))))
(println "") ; 4
;; A move-only accumulator, carried round by recur and answered with. This
;; is the shape the form exists for: no mutable local, no sentinel flag, and
;; the Vec is the loop's value. recur writes every name on the way round, so
;; the "moves a value bound outside the loop" rule is not about acc.
(let [v (loop [acc (vec-new i32) i 0]
(if (= i 3)
acc
(do (push acc i) (recur acc (+ i 1)))))]
(dotimes [i (len v)] (print (at v i)))
(println "") ; 012
(free v))
;; A match arm is a tail too.
(print (loop [i 0 acc 0]
(match (step i)
(Some v) (recur (+ i 1) (+ acc v))
None acc)))
(println "") ; 0+1+2+3 = 6
0)

12
test/test_acceptance.ml
View File

@ -126,6 +126,18 @@ let () =
watchdog above is what turns that failure back into a report. *)
outputs "break and continue" "programs/loops.flan"
"4\n9\n8\n3\n0\n1\n0\n0\n0\n3\n6\nhit\nhit\n2\n";
(* loop and recur. The ten-million line is the one that matters: a recur is
a jump to the top of a [While] and not a call, so the program returns
rather than running out of stack. The swap line is the other — recur
rebinds every name at once, and interleaved writes would print 1. *)
outputs "loop and recur" "programs/recur.flan"
"10\n2\n21\n8\n10000000\n64\n012\n0\n4\n012\n6\n";
(* into. The count of pulls is the assertion a unit test cannot make: one
pass, one call per element per stage it reaches, and no intermediate
collection anywhere. The two show lines either side of it are the same
source transformed in two orders, which have to differ. *)
outputs "into" "programs/into.flan"
"7 8 9 \n2 4 6 8 10 12 \n4 8 12 \n21\n6 2 4 \n3 1 2 \n3 4 \n2 4 \n1\n";
(* The prelude's slice algorithms. Every assertion here is over an input a
wrong implementation fails: unsorted with duplicates, negatives and an
odd length; a reverse-sorted slice; and a sort of a subslice whose

57
test/test_flan.ml
View File

@ -944,6 +944,63 @@ let () =
rejects_check "break may not leave a handler-bind"
"(defstruct C [n i32]) (defn f [] () (while true (handler-bind [(C [c] 0)] (break))))"
~needle:"a handler-bind";
(* loop and recur. The same stack, the same barriers, and one rule of its
own: a recur must be in the loop body's tail. That is what makes this
better than a silent TCO rather than only cheaper — the mistake is a
compile error here and would be a stack overflow there. *)
accepts "recur in the tail of the body"
"(defn f [] i32 (loop [i 0] (if (= i 3) i (recur (+ i 1)))))";
accepts "recur in the tail of a when"
"(defn f [] () (loop [i 0] (when (< i 3) (recur (+ i 1)))))";
accepts "recur in the tail of a nested let"
"(defn f [] i32 (loop [i 0] (let [n (+ i 1)] (if (= i 3) i (recur n)))))";
rejects_check "recur that is not in tail position"
"(defn f [] () (loop [i 0] (recur (+ i 1)) (println \"\")))"
~needle:"tail position";
rejects_check "recur under a call is not in tail position"
"(defn f [] i32 (loop [i 0] (+ 1 (recur (+ i 1)))))"
~needle:"tail position";
rejects_check "recur in a nested loop body is not in tail position"
"(defn f [] () (loop [i 0] (while true (recur (+ i 1)))))"
~needle:"tail position";
(* Where the "refuse mutual recursion by name" answer lives: there are no
tail calls, so a function cannot recur into itself either. *)
rejects_check "recur outside a loop"
"(defn f [] () (recur))" ~needle:"no tail calls";
rejects_check "recur with the wrong number of values"
"(defn f [] i32 (loop [i 0 j 1] (recur 1)))"
~needle:"binds 2 names and this recur passes 1";
(* The barrier, asked the same question break asks and given the same
answer, rather than a second mechanism. *)
rejects_check "recur may not leave a restart-case"
"(defn f [] () (loop [i 0] (restart-case (recur (+ i 1)) (go [] (println \"\")))))"
~needle:"a restart-case";
(* And the restriction this form adds: a loop answers with the value of its
body, so a jump out of one would have no value to give. A while written
inside a loop is untouched, which is the relative rule again. *)
accepts "a while inside a loop keeps its own break"
"(defn f [] () (loop [i 0] (while true (break))))";
rejects_check "break may not leave a loop"
"(defn f [] () (loop [i 0] (break)))" ~needle:"no value to give";
rejects_check "a labelled break may not leave a loop"
"(defn f [] () (while :o true (loop [i 0] (break :o))))"
~needle:"no value to give";
rejects_check "loop takes no label"
"(defn f [] () (loop :o [i 0] (recur i)))" ~needle:"loop takes no label";
rejects_check "a loop binding is a plain name"
"(defn f [] () (loop [[a b] 0] (recur 0)))" ~needle:"destructuring pattern";
(* into. The expansion is asserted in programs/into.flan, where the values
coming out are the test; what belongs here is the three things it refuses,
each through the one facility a macro has — a name nothing defines. *)
rejects_check "into needs a source and a destination"
"(defn f [] () (free (into [1 2 3])))"
~needle:"into-takes-a-source-a-destination-and-transforms";
rejects_check "a transform is map or filter"
"(defn f [] () (free (into [1 2 3] (vec-new i32) (take 2))))"
~needle:"into-transform-is-map-or-filter";
rejects_check "a transform names one function"
"(defn f [] () (free (into [1 2 3] (vec-new i32) (map))))"
~needle:"into-transform-is-map-or-filter-of-one-function";
(* An import is resolved by [Load] before the checker runs, so one that
reaches [Check] means a driver skipped that step. *)
rejects_check "an unresolved import is a driver bug"