diff --git a/BUILT.md b/BUILT.md index c325219..e3b35c2 100644 --- a/BUILT.md +++ b/BUILT.md @@ -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 diff --git a/NEXT.md b/NEXT.md index aa4fe6f..540ec54 100644 --- a/NEXT.md +++ b/NEXT.md @@ -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 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 3fd3066..30b2326 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 @@ -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 = "" } @@ -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 = "" } + 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. @@ -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 = "" } 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 () = @@ -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 = "" } 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 @@ -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 = "" } + 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/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/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/into.flan b/test/programs/into.flan new file mode 100644 index 0000000..3374f21 --- /dev/null +++ b/test/programs/into.flan @@ -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) diff --git a/test/programs/recur.flan b/test/programs/recur.flan new file mode 100644 index 0000000..7bc54aa --- /dev/null +++ b/test/programs/recur.flan @@ -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) diff --git a/test/test_acceptance.ml b/test/test_acceptance.ml index 6d197bb..1f3b52b 100644 --- a/test/test_acceptance.ml +++ b/test/test_acceptance.ml @@ -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 diff --git a/test/test_flan.ml b/test/test_flan.ml index 535ada9..0bb7a3a 100644 --- a/test/test_flan.ml +++ b/test/test_flan.ml @@ -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"