From fedaec3e1801f643e0bb82624324614e6045ae78 Mon Sep 17 00:00:00 2001 From: Joseph Ferano Date: Sun, 13 Sep 2026 09:17:56 +0700 Subject: [PATCH 1/3] recur is checked, which is the reason to prefer it over tail calls MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit There is no TCO here and recur is not a cheaper substitute for one: the compiler verifies the call is in the loop body's tail position, so the mistake is a compile error where it was written rather than a stack overflow somewhere else. A loop is a let, a While whose condition is true, and two jumps — emit.ml is untouched, and the barrier question recur asks is the one labelled break already answered. Tail position is a permission that is withdrawn at the top of check, the same read-and-withdraw defer_ok does, handed back only by a block's last form, both arms of an if and a match arm. So nothing enumerates the forms that are not tails, which a pre-pass over the Ast would have had to, and would have had to keep doing. loop is also a barrier for break and continue, which is added rather than inherited: a loop answers with the value of its body and a jump out has no value to give. That is also why it takes no label. A while inside a loop keeps its own break. Two things the shape forced. A loop binding is a plain name, because destructuring would make recur's argument count unreadable off the binding vector. And in_loop's "moves a value bound outside the loop" rule had to be told about the loop's own names, or (loop [v (vec-new i32)] ...) would have been refused for doing the ordinary thing. --- BUILT.md | 80 +++++++++++++ NEXT.md | 24 ++-- lib/ast.ml | 10 ++ lib/check.ml | 242 +++++++++++++++++++++++++++++++++++---- lib/load.ml | 7 ++ lib/parse.ml | 43 ++++++- lib/tast.ml | 8 +- test/programs/recur.flan | 90 +++++++++++++++ test/test_acceptance.ml | 6 + test/test_flan.ml | 45 ++++++++ 10 files changed, 521 insertions(+), 34 deletions(-) create mode 100644 test/programs/recur.flan diff --git a/BUILT.md b/BUILT.md index 8b7cad6..0e03483 100644 --- a/BUILT.md +++ b/BUILT.md @@ -3006,6 +3006,86 @@ 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. +## `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. + +`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 diff --git a/NEXT.md b/NEXT.md index 963e2b1..4bb0aee 100644 --- a/NEXT.md +++ b/NEXT.md @@ -826,7 +826,7 @@ 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) +## ~~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). @@ -857,18 +857,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 diff --git a/lib/ast.ml b/lib/ast.ml index baf9c3f..9790e56 100644 --- a/lib/ast.ml +++ b/lib/ast.ml @@ -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 diff --git a/lib/check.ml b/lib/check.ml index 2061a37..3c3ff75 100644 --- a/lib/check.ml +++ b/lib/check.ml @@ -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 @@ -763,7 +776,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 = "" } @@ -964,6 +977,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) @@ -1002,11 +1020,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 () -> @@ -1017,6 +1037,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 -> @@ -1070,7 +1096,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 @@ -1343,12 +1369,18 @@ and block ctx ?want ?(defer_ok = false) loc body = match body with | [] -> 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 @@ -1402,7 +1434,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 @@ -1478,7 +1510,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 = "" } + 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 = "" } in (* The condition crosses as a pointer, because the handler runs while the signalling frame is still alive and there is nothing to copy. @@ -1630,7 +1662,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 @@ -1647,6 +1679,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 ]))) @@ -1659,13 +1693,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. *) @@ -1705,6 +1746,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 @@ -1754,13 +1812,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 @@ -1769,7 +1966,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, @@ -1779,7 +1976,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; @@ -1928,7 +2125,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 @@ -2035,6 +2232,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; @@ -4269,7 +4469,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 = "" } 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 = "" } v).Tast.ty in let pending = ref (List.rev !untyped) in let rec settle () = @@ -4322,7 +4522,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 -> @@ -4425,7 +4625,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 = "" } 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 = "" } in match d.Ast.d with | Ast.Defvar (n, _, init) -> let ty, _ = Hashtbl.find env.globals n in @@ -4589,7 +4789,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 = "" } + 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 = "" } in let t = check ctx e in (t, Array.of_list (List.rev ctx.slot_tys), diff --git a/lib/load.ml b/lib/load.ml index a13550e..fe52b52 100644 --- a/lib/load.ml +++ b/lib/load.ml @@ -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 diff --git a/lib/parse.ml b/lib/parse.ml index 651136a..6530821 100644 --- a/lib/parse.ml +++ b/lib/parse.ml @@ -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 diff --git a/lib/tast.ml b/lib/tast.ml index 40181fe..7d6bc15 100644 --- a/lib/tast.ml +++ b/lib/tast.ml @@ -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 diff --git a/test/programs/recur.flan b/test/programs/recur.flan new file mode 100644 index 0000000..e25daf0 --- /dev/null +++ b/test/programs/recur.flan @@ -0,0 +1,90 @@ +;;;; 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 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) diff --git a/test/test_acceptance.ml b/test/test_acceptance.ml index 915a4b7..288b0f0 100644 --- a/test/test_acceptance.ml +++ b/test/test_acceptance.ml @@ -126,6 +126,12 @@ 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\n6\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 diff --git a/test/test_flan.ml b/test/test_flan.ml index 535ada9..fe24390 100644 --- a/test/test_flan.ml +++ b/test/test_flan.ml @@ -944,6 +944,51 @@ 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"; (* 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" From ca14394e0f6eb6e853c459b00ee43464046d4354 Mon Sep 17 00:00:00 2001 From: Joseph Ferano Date: Sun, 13 Sep 2026 09:27:20 +0700 Subject: [PATCH 2/3] into fuses at compile time because it is a macro, not a transducer MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit (into xs (vec-new i32) (map double) (filter even?)). The function name is syntax and never a value, so (map double) is (double x) written into the loop body: no intermediate collection, no closure, no generics, nothing to inline. Transducers would compose at run time and Rust's iterators need monomorphisation; a macro needs neither. into.flan counts the pulls, which is the assertion a unit test cannot make. The destination is in the form because the destination is the allocation, and that is what makes spec-memory.md's explicit-allocator rule true by construction rather than by convention. Which also settles the open question: reductions do not share the form. 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 source that is already a name is used as it is, not bound. A (Vec T) is move-only, so binding it would take the caller's ownership for something that only reads; 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. The wart is that an owning temporary there leaks, because the binding has a name the caller cannot reach — a call in that position should borrow, and drop is what would close it. All four of the prelude's macro limits bit and none blocked anything. The three refusals are names nothing defines, which is the only error facility a macro has. into-wrap is a defn using only special forms, so Macro.reduce does not drop it, and it is the first thing in the prelude written as a loop/recur. --- BUILT.md | 74 ++++++++++++++++++++++++ NEXT.md | 21 ++++++- lib/prelude.ml | 122 ++++++++++++++++++++++++++++++++++++++++ test/programs/into.flan | 81 ++++++++++++++++++++++++++ test/test_acceptance.ml | 6 ++ test/test_flan.ml | 12 ++++ 6 files changed, 315 insertions(+), 1 deletion(-) create mode 100644 test/programs/into.flan diff --git a/BUILT.md b/BUILT.md index 0e03483..14eeaa8 100644 --- a/BUILT.md +++ b/BUILT.md @@ -3006,6 +3006,80 @@ 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. + +### 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 diff --git a/NEXT.md b/NEXT.md index 4bb0aee..ede707f 100644 --- a/NEXT.md +++ b/NEXT.md @@ -789,7 +789,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.** @@ -826,6 +826,25 @@ 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. +**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 diff --git a/lib/prelude.ml b/lib/prelude.ml index fa56723..4184cb5 100644 --- a/lib/prelude.ml +++ b/lib/prelude.ml @@ -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 = "" diff --git a/test/programs/into.flan b/test/programs/into.flan new file mode 100644 index 0000000..3714892 --- /dev/null +++ b/test/programs/into.flan @@ -0,0 +1,81 @@ +;;;; 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 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 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) diff --git a/test/test_acceptance.ml b/test/test_acceptance.ml index 288b0f0..e00fd4f 100644 --- a/test/test_acceptance.ml +++ b/test/test_acceptance.ml @@ -132,6 +132,12 @@ let () = 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\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 \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 diff --git a/test/test_flan.ml b/test/test_flan.ml index fe24390..0bb7a3a 100644 --- a/test/test_flan.ml +++ b/test/test_flan.ml @@ -989,6 +989,18 @@ let () = "(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" From 0405666b1f4fa2237cb783acc1c9e1f4e39ffba5 Mon Sep 17 00:00:00 2001 From: Joseph Ferano Date: Sun, 13 Sep 2026 09:32:58 +0700 Subject: [PATCH 3/3] The two cases the tests did not cover, and one leak of a permission MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit A type-changing (map f) is the case into's single shadowed element name would break if the shadowing were a trick rather than the language's rule; it is not, because each stage is a fresh slot at its own type, and into.flan now runs an i32 source into a (Vec f32) to say so. A move-only accumulator carried round by recur is the shape BUILT.md pitches the form on and was untested. It works, and recur.flan now carries a Vec three times round and answers with it. block's empty-body arm returned before the loop that distributes the tail, so (do) in a tail position left ctx.tail set for whatever was checked next. Latent rather than live — every consumer sets it immediately before use, and the leaking form is always Unit-typed — but it is one line to close and the invariant is easier to state closed. Also the PORTING.md line listing loop/recur among the things with no customer: it was built, and the half of that finding that still stands is tail calls, which were not. --- BUILT.md | 7 ++++++- NEXT.md | 4 +++- lib/check.ml | 4 +++- test/programs/into.flan | 13 +++++++++++++ test/programs/recur.flan | 12 ++++++++++++ test/test_acceptance.ml | 4 ++-- 6 files changed, 39 insertions(+), 5 deletions(-) diff --git a/BUILT.md b/BUILT.md index 14eeaa8..a1e79bf 100644 --- a/BUILT.md +++ b/BUILT.md @@ -3058,7 +3058,9 @@ is. So `into` collects, and a reducing macro of the same shape is a separate for 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. + 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 @@ -3111,6 +3113,9 @@ it: the machinery was already there, and the question `recur` asks — *may this - **`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` diff --git a/NEXT.md b/NEXT.md index ede707f..52b0df8 100644 --- a/NEXT.md +++ b/NEXT.md @@ -115,7 +115,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. diff --git a/lib/check.ml b/lib/check.ml index 3c3ff75..ef3a16e 100644 --- a/lib/check.ml +++ b/lib/check.ml @@ -1367,7 +1367,9 @@ 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 diff --git a/test/programs/into.flan b/test/programs/into.flan index 3714892..3374f21 100644 --- a/test/programs/into.flan +++ b/test/programs/into.flan @@ -35,6 +35,9 @@ (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 "")) @@ -71,6 +74,16 @@ (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] diff --git a/test/programs/recur.flan b/test/programs/recur.flan index e25daf0..7bc54aa 100644 --- a/test/programs/recur.flan +++ b/test/programs/recur.flan @@ -81,6 +81,18 @@ (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) diff --git a/test/test_acceptance.ml b/test/test_acceptance.ml index e00fd4f..65b8dac 100644 --- a/test/test_acceptance.ml +++ b/test/test_acceptance.ml @@ -131,13 +131,13 @@ let () = 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\n6\n"; + "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 \n2 4 \n1\n"; + "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