From 9f4a59c56fed21117b81c9a59821766f3c50892e Mon Sep 17 00:00:00 2001 From: Joseph Ferano Date: Sat, 12 Sep 2026 21:48:08 +0700 Subject: [PATCH 1/3] A let binding has no type slot, so (array 4 T) is how you say it MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit [4 T] is the type syntax and is unchanged; it already works in a defvar, a parameter, a field and a return. A let binding is the one position with no type slot, and there the brackets are an array literal of two elements whose second is a type name — which came back as "unknown name rl/Vector2" and cost 32 hand-written Vector2s in one raylib example. (array COUNT TYPE) is a parser form rather than a builtin call, because the second argument is a type and the parser's callers have none. Parse assembles the Tarray itself, so the count takes a constant's name for free and a value in the type position is refused by the type reader's own message. The checker resolves it to Tast.Zero — no new backend node and no new type. (zeroed [4 T]) was proposed first and rejected: the parser can tell, a person cannot. zeroed keeps its job of being inferred; array is the one that is told. --- BUILT.md | 24 +++++++++++++++++++ NEXT.md | 2 +- lib/ast.ml | 7 ++++++ lib/check.ml | 6 +++++ lib/load.ml | 2 ++ lib/parse.ml | 18 +++++++++++++++ test/programs/array-ctor.flan | 43 +++++++++++++++++++++++++++++++++++ test/test_acceptance.ml | 3 +++ test/test_flan.ml | 14 ++++++++++++ 9 files changed, 118 insertions(+), 1 deletion(-) create mode 100644 test/programs/array-ctor.flan diff --git a/BUILT.md b/BUILT.md index b29fc07..9b6d984 100644 --- a/BUILT.md +++ b/BUILT.md @@ -2435,6 +2435,30 @@ reason `-linkall` is not optional. Say plainly what that coverage is not: nothin before this landed, so `macro-unless.flan` is a test written after the feature. The corpus written before it is `sand.flan` and `web/examples/control.flan`, and both compile unchanged. +## `(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 +points [4 rl/Vector2])`, `(defn draw [pts [4 rl/Vector2]] ...)`, a `defstruct` field, a return. A **`let` binding is +the single position with no type slot**, and there the brackets are read as what they are in expression position: an +array *literal* of two elements, whose second element is a type name nothing declares. So `(let [pts [4 rl/Vector2]] +...)` failed with *unknown name rl/Vector2*, which describes the symptom and not the mistake. It cost 32 hand-written +`Vector2`s in one raylib example. + +`(array COUNT TYPE)` is the answer: a zeroed fixed array, told its count and its element type as plain arguments. +`(array 4 rl/Vector2)` and the type `[4 rl/Vector2]` denote the same type, so the constructor is assignable to a +declaration written the other way and either spelling can be the parameter — `array-ctor.flan` asserts exactly that. + +It is a parser form and not a builtin call, because the second argument is a *type* and there are no types in the +parser's callers. `Parse` assembles the whole `Tarray (len COUNT, TYPE)` itself, which is why the count takes a +constant's name for free — `len` is the same function `[n T]` goes through — and why a non-type second argument is +refused by the type reader's own message rather than as an unknown name. The checker resolves it and hands back +`Tast.Zero`, the same node a declaration with no initialiser gets. There is no new backend node and no new type. + +**`(zeroed)` was the first proposal and was rejected on how it reads.** `(zeroed [4 rl/Vector2])` is unambiguous to the +*parser* — a bracket in argument position could be a type there — but to a person it still looks like a two-element +vector, which is the exact confusion being fixed. `zeroed` keeps its existing job: the empty value of whatever type the +destination wants, inferred and never written. `array` is the one that is told. + ## `defer` may be written in a `let` The whole of this project's resource-cleanup answer, and NEXT.md records `drop` and a `with-cleanup` form as both diff --git a/NEXT.md b/NEXT.md index ca0bea9..9439b8c 100644 --- a/NEXT.md +++ b/NEXT.md @@ -685,7 +685,7 @@ debug tracking allocator, which is the leak safety net and a good candidate when ## Decided in discussion — the array constructor and the module system -**`(array 4 rl/Vector2)` makes a fixed array; `[4 T]` stays the type syntax.** The problem this solves: a `let` +**`(array 4 rl/Vector2)` makes a fixed array; `[4 T]` stays the type syntax. Built** — see BUILT.md, "`(array 4 rl/Vector2)`, and the one position with no type slot". The problem it solved: a `let` binding takes no type, so `(let [pts [4 rl/Vector2]] ...)` reads `[4 rl/Vector2]` as a two-element array *literal* and fails with *unknown name rl/Vector2*. It cost 32 hand-written `Vector2`s in one raylib example. diff --git a/lib/ast.ml b/lib/ast.ml index 9485081..e147eef 100644 --- a/lib/ast.ml +++ b/lib/ast.ml @@ -48,6 +48,13 @@ and expr_kind = | Match of expr * arm list | Struct of string * (string * expr) list (* (Cursor {.src s}) *) | Arr of expr list (* [0xE6B800FF ...] — a fixed array value *) + (* (array 4 rl/Vector2) — a zeroed fixed array, given its count and its + element type. [n T] is the ordinary *type* syntax and already works + everywhere a type is expected; a [let] binding is the one position with no + type slot, so there [4 rl/Vector2] reads as a two-element [Arr] literal and + fails on an unknown name. This is that position's answer, and it says what + it does rather than looking like a vector of two things. *) + | ArrayOf of texpr (* the whole array type, built by Parse *) (* These bind names or alter control flow, so none of them can be a call. *) | Fn of string list * expr list (* (fn [x y] ...) — non-escaping *) | Dotimes of string * expr * expr list (* (dotimes [i n] ...) *) diff --git a/lib/check.ml b/lib/check.ml index a593571..8835f99 100644 --- a/lib/check.ml +++ b/lib/check.ml @@ -920,6 +920,12 @@ let rec check ctx ?want (e : Ast.expr) : Tast.expr = expect loc ~want (mk loc fty (Tast.Field (target, i)))) | Ast.Struct (name, kvs) -> check_struct ctx ~want loc name kvs | Ast.Arr items -> check_arr ctx ~want loc items + (* (array 4 rl/Vector2). Parse already assembled the whole array type, so + there is nothing to infer: resolve it and hand back its all-bytes-zero + value, which is what a declared array with no initialiser gets. *) + | 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.Call (head, args) -> check_call ctx ~want loc head args | Ast.Unwrap (Ast.Usome, v) -> diff --git a/lib/load.ml b/lib/load.ml index f02584d..574ad77 100644 --- a/lib/load.ml +++ b/lib/load.ml @@ -201,6 +201,7 @@ let rec rename_expr owned alias bound (e : Ast.expr) : Ast.expr = | Ast.Struct (n, kvs) -> Ast.Struct (name n, List.map (fun (k, v) -> (k, go v)) kvs) | Ast.Arr items -> Ast.Arr (gos items) + | Ast.ArrayOf t -> Ast.ArrayOf (rename_texpr owned alias t) | Ast.Fn (ps, body) -> Ast.Fn (ps, List.map (rename_expr owned alias (ps @ bound)) body) | Ast.Dotimes (i, n, body) -> @@ -382,6 +383,7 @@ let rec expr_uses acc (e : Ast.expr) = acc := (n, e.Ast.loc) :: !acc; List.iter (fun (_, v) -> go v) kvs | Ast.Arr items -> gos items + | Ast.ArrayOf t -> texpr_uses acc t | Ast.Fn (_, body) -> gos body | Ast.Dotimes (_, n, body) -> go n; gos body | Ast.Defer body -> gos body diff --git a/lib/parse.ml b/lib/parse.ml index 33b737b..864957c 100644 --- a/lib/parse.ml +++ b/lib/parse.ml @@ -177,6 +177,24 @@ and form f mk (head : Form.t) (args : Form.t list) : Ast.expr = | [ target; value ] -> mk (Ast.Set (place target, expr value)) | _ -> fail f "set is (set place value)") + (* ── (array 4 rl/Vector2) ─────────────────────────────────────────── + A zeroed fixed array, told its count and its element type. The type + spelling [4 rl/Vector2] is unchanged and still works everywhere a type is + expected; what it cannot do is appear in a [let] binding, which has no + type slot, because there the brackets are an array *literal* of two + elements and the second of them is a name nothing declares. So the count + and the type arrive as plain arguments and Parse assembles the type + itself. [(zeroed)] keeps its own job — the empty value of whatever the + destination wants — and this is the one that is told. *) + | Sym "array" -> + (match args with + | [ n; t ] -> + mk (Ast.ArrayOf { Ast.t = Ast.Tarray (len n, texpr t); tloc = f.loc }) + | _ -> + fail f + "array is (array COUNT TYPE), as in (array 4 rl/Vector2) — a zeroed \ + fixed array of COUNT of them") + | Sym "match" -> (match args with | scrutinee :: rest -> mk (Ast.Match (expr scrutinee, arms f rest)) diff --git a/test/programs/array-ctor.flan b/test/programs/array-ctor.flan new file mode 100644 index 0000000..9010b3c --- /dev/null +++ b/test/programs/array-ctor.flan @@ -0,0 +1,43 @@ +;;;; (array COUNT TYPE) — the zeroed fixed array a [let] binding could not ask +;;;; for. A let has no type slot, so [4 V2] there is an array *literal* of two +;;;; elements and the second of them is a type name, which is an unknown name +;;;; and not a helpful error. The type spelling is untouched: `points` below is +;;;; still declared [3 V2], and the two are the same type, which is the point — +;;;; the constructor is assignable to the declaration. +(defstruct V2 [x f32 y f32]) + +(defconst n 3) +(defvar points [3 V2]) + +(defn sumx [ps [3 V2]] i32 + (let [t (f32 0.0)] + (dotimes [i 3] + (set t (+ t (.x (at ps i))))) + (i32 t))) + +(defn main [] i32 + ;; The case that cost 32 hand-written Vector2s: a local array of structs. + (let [pts (array 3 V2)] + (set (.x (at pts 0)) 1.5) + (set (.x (at pts 2)) 2.5) + (print (sumx pts)) (println "")) ; 4 + + ;; Zeroed, not uninitialised: every element reads as the all-zero value. + (let [z (array 4 i32)] + (print (at z 3)) (println "")) ; 0 + + ;; The count takes a constant's name, exactly as [n V2] does. + (let [c (array n V2)] + (set (.y (at c 1)) 7.0) + (print (i32 (.y (at c 1)))) (println "")) ; 7 + + ;; Element types nest, and the result is assignable to a declaration written + ;; the other way round — same type, two spellings. + (let [g (array 2 [2 i32])] + (set (at (at g 1) 1) 9) + (print (at (at g 1) 1)) (println "")) ; 9 + + (set points (array 3 V2)) + (set (.x (at points 0)) 4.0) + (print (sumx points)) (println "") ; 4 + 0) diff --git a/test/test_acceptance.ml b/test/test_acceptance.ml index 37db25f..bb08748 100644 --- a/test/test_acceptance.ml +++ b/test/test_acceptance.ml @@ -117,6 +117,9 @@ let () = outputs "value semantics" "programs/values.flan" values_out; outputs "machine surface" "programs/machine.flan" machine_out; outputs "unit main exits 0" "programs/unit-main.flan" "ok\n"; + (* (array COUNT TYPE). Every line of it is a [let] binding, which is the + one position with no type slot and the whole reason the form exists. *) + outputs "array constructor" "programs/array-ctor.flan" "4\n0\n7\n9\n4\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 3afb524..3362325 100644 --- a/test/test_flan.ml +++ b/test/test_flan.ml @@ -462,6 +462,12 @@ let () = parse_rejects "odd field pairs" "(defstruct S [a])"; parse_rejects "cond without body" "(cond a)"; parse_rejects "unknown top form" "(nope x)"; + parse_rejects "array with no type" "(defn f [] (array 4))" + ~needle:"array is (array COUNT TYPE)"; + parse_rejects "array given a value, not a type" "(defn f [] (array 4 5))" + ~needle:"expected a type"; + parse_rejects "array with a non-constant count" "(defn f [] (array (+ 1 1) f32))" + ~needle:"an array length is an integer or a constant's name"; (* ── The corpus parses ─────────────────────────────────────────── *) List.iter @@ -612,6 +618,14 @@ let () = infers "cast" "(f64 3)" "f64"; infers "array literal" "[1 2 3]" "[3 i32]"; infers "nested array" "[[1 2] [3 4]]" "[2 [2 i32]]"; + (* (array COUNT TYPE): the constructor a [let] binding needs, because a let + has no type slot and [4 P] there is a two-element literal whose second + element is a name nothing declares. The type spelling is unchanged — the + two [infers] above still hold — and this is the position that had no way + to say it. *) + infers "array constructor" "(array 4 f32)" "[4 f32]"; + infers "array of a struct" "(array 2 i32)" "[2 i32]"; + infers "array of an array" "(array 2 [3 u8])" "[2 [3 u8]]"; infers "bytes of a string" "(bytes \"hi\")" "[u8]"; infers "len is i32" "(len (bytes \"hi\"))" "i32"; infers "slice of a slice" "(slice (bytes \"hi\") 0 1)" "[u8]"; From 008165335d67eb6e232d4f2838f080b15fbb3cc7 Mon Sep 17 00:00:00 2001 From: Joseph Ferano Date: Sat, 12 Sep 2026 21:58:53 +0700 Subject: [PATCH 2/3] break crosses only sometimes, so the refusal is relative now MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit return is refused inside handler-bind and restart-case blanketly, and rightly: a return always crosses the frames they pushed. A break does not. A loop written wholly inside a restart-case body has a perfectly good local break, so the rule is a barrier on the loop stack rather than a flag — a jump is refused exactly when a barrier stands between it and the loop it names, and the message says which construct. handler-bind and restart-case bodies are barriers, so is a restart clause, so are a defer's forms; a handler clause is lifted into its own function and needs no rule at all. in_frames is untouched: a return is the special case where the target is always outside every barrier. continue wanted the other blocker. check_dotimes folded its step onto the end of the body, which a continue would jump past, so the counter would never advance and the loop would hang. Tast.While carries a latch now — condition, body, latch — the step goes there, and emit_while emits four blocks. A while's latch is empty and folds away. Labels are Odin's, in the head position: (while :outer c ...) and (break :outer). A keyword there is unambiguous because a loop condition is never one, so one label function serves while, until, dotimes, break and continue. It is not a goto — the checker resolves a label against the loops the form is lexically inside, so control can only leave a loop it is already in. Break and Continue carry a relative depth rather than a name, because that is what a backend already has: emit keeps one entry per While the way it keeps one pad per frame, and indexes it. Nothing in the prelude wants either. Every early exit there is a return from the function, which break cannot replace; the sentinel-flag loop break exists to remove does not appear in it. The two the compiler emits are that shape and are the one place it cannot help — their sentinel is set inside a restart-case. reach.ml and render.ml take the While arity change and nothing else. --- BUILT.md | 68 +++++++++++++++++ NEXT.md | 23 ++++-- lib/ast.ml | 13 +++- lib/check.ml | 161 ++++++++++++++++++++++++++++++++++----- lib/emit.ml | 37 ++++++++- lib/load.ml | 15 ++-- lib/parse.ml | 56 ++++++++++---- lib/reach.ml | 3 +- lib/render.ml | 2 +- lib/tast.ml | 18 ++++- test/programs/loops.flan | 85 +++++++++++++++++++++ test/test_acceptance.ml | 6 ++ test/test_flan.ml | 55 ++++++++++++- 13 files changed, 485 insertions(+), 57 deletions(-) create mode 100644 test/programs/loops.flan diff --git a/BUILT.md b/BUILT.md index 9b6d984..72ed093 100644 --- a/BUILT.md +++ b/BUILT.md @@ -2435,6 +2435,74 @@ reason `-linkall` is not optional. Say plainly what that coverage is not: nothin before this landed, so `macro-unless.flan` is a test written after the feature. The corpus written before it is `sand.flan` and `web/examples/control.flan`, and both compile unchanged. +## `break` and `continue`, and the rule that replaced a blanket refusal + +Declined once deliberately; NEXT.md's *`break`, and why it was not built* records what was settled then and still +holds — `dotimes` gets it free because it desugars to a `While`, `defer` is a non-question because it is +function-scoped and a break does not leave the function, and both are typed `Never` as `exit` and `return` already +are. What stopped it was two things, and both are answered here. + +**Labels are Odin's, in the head position.** `(while :outer (< i n) ...)`, and `(break :outer)`. A keyword there is +unambiguous because a loop condition is never one, so one small `label` function in `parse.ml` serves `while`, +`until`, `dotimes`, `break` and `continue` and no form has to count its arguments. `until` and `dotimes` were not +asked for and cost a line each: `until` is a `While` by the time the parser is done with it, and a nested `dotimes` +scanning a grid is the case the label exists for. + +**It is not a goto.** A label names one of the loops the form is *lexically inside* — the checker resolves it against +exactly those and refuses anything else by name — so control can only leave a loop it is already in. That is Odin's +restriction and it is what keeps the feature small: there is no arbitrary target, no forward jump, and nothing to say +about scopes being entered. + +### The `in_frames` question, ruled on + +`return` is refused inside a `handler-bind` or a `restart-case` because those forms push frames and pop them on the +way out, and a return that leaves would strand them on the stack pointing into a frame that is gone. That refusal is +**blanket**, and correctly so: a return *always* crosses. + +A break crosses only sometimes. A loop written wholly inside a `restart-case` body has a perfectly good local break, +and refusing it would be refusing the common case for the sake of the uncommon one. So the rule here is **relative**, +and it is one list rather than a flag: `ctx.loops` holds the loops this form is inside, innermost first, with a +**barrier** entry pushed by every construct a jump may not cross. A break resolves by walking outwards; a barrier +reached before the target loop is a refusal that **names the construct** — *break :outer would leave a restart-case, +which it may not*. A loop nested inside the construct sits below the barrier and is never affected. + +The barriers, and why each is one: + +- **`handler-bind` and `restart-case` bodies** — the frames they pushed are popped on the way out, and a `br` past + the pop leaves a dangling frame. The same reason `return` is refused, scoped to crossings instead of to everything. +- **A `restart-case` clause body** — it runs after a transfer landed, with the form's frames still to be popped. +- **A `defer`'s forms** — they are *copied* into the function's exit paths, where the loop they were written beside + is not running. (Unreachable today, because `defer` is already refused in a loop body for its own reason. Written + anyway: the rule is about what the forms mean, not about which other refusal happens to fire first.) + +A **handler clause** is not on the list at all. It is lifted into a function of its own with a fresh `ctx`, so its +loop stack starts empty and nothing in it can name a loop outside it — the refusal falls out of the lifting. + +The two rules agree where they overlap, which is the check that the relative one is not weaker: a `return` is a jump +whose target is always outside every barrier, so the blanket refusal is the special case of this one. `in_frames` is +left exactly as it was. + +### `continue` and the latch + +`Tast.While` is now `expr * expr list * expr list` — condition, body, and a **latch** that runs after the body and +before the test. `check_dotimes` folded its increment onto the end of the body, and a `continue` branching at the +header would have jumped straight past it: the counter would never advance and the loop would hang. So the step is +the latch, `continue` branches to the latch block rather than to the header, and a `while` has an empty latch that +every optimiser folds away. `emit_while` emits four blocks instead of three. + +`Tast.Break` and `Tast.Continue` carry a **relative depth** — how many loops out the target is, innermost first — +rather than a name or an id, because that is exactly what a backend already has. `emit` keeps one entry per `While` +it is inside, the same shape and for the same reason as `pads`, and indexes it. The invariant this rests on: the +checker mints a depth only from its own loop stack, and the two stacks are pushed once per `While` each. A `While` +the checker *invents* — `alloc_guard`'s retry and the file-failure retry — is built directly and contains no jump, so +its emit entry matches nothing. + +**Nothing in `lib/prelude.ml` wants either.** Every early exit there is a `return` from the function — `bytes=?`, +`index-of-byte`, `index-of-bytes`, `valid-utf8?`, `bytes->i64` — and a break cannot replace one: it leaves the loop +and the function still has to answer. The loop-with-a-sentinel-flag shape that break exists to remove does not appear +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. + ## `(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 9439b8c..c750b49 100644 --- a/NEXT.md +++ b/NEXT.md @@ -613,8 +613,9 @@ run one lane at a time; item 4 is disjoint and runs alongside any of them. resolving to whatever reused the slot. Wanted on its own terms for entities referred to across frames, and it is the real gate on classes. Buildable now that the allocator exists. -7. **`break` and `continue`, with loop labels.** Declined once deliberately — see "`break`, and why it was not built" - — but a game loop wants it and the author has asked for it. Two things settled in conversation: +7. ~~**`break` and `continue`, with loop labels.**~~ **Built.** Labels are Odin's in the head position, both blockers + are answered, and the refusals name the construct they refuse for. See BUILT.md, "`break` and `continue`, and the + rule that replaced a blanket refusal". What was settled in conversation before it was built, kept: **Labels, Odin-style but in the head position.** A keyword names a loop and `break` takes it: @@ -837,8 +838,15 @@ Ranked by how often they were hit, top two first because they are walls rather t function's return type. They are in it now under a key of their own, admitted as a bare symbol and never as a list head — because `(Key n)` is a *value* now, and putting `Key` in `types` would make a body starting with one be eaten as a return type. -3. **`break` is not implemented.** Declined deliberately rather than built — see below. -4. **A `let` binding takes no type annotation**, so a fixed array is either a top-level `defvar` or a literal with +3. ~~**`break` is not implemented.**~~ **Built, with `continue` and loop labels.** Both blockers are answered: the + `in_frames` rule became a relative one rather than a blanket one, and `Tast.While` grew a latch. See BUILT.md, + "`break` and `continue`, and the rule that replaced a blanket refusal". +4. ~~**A `let` binding takes no type annotation**~~ — still true, and **no longer the blocker it was**: `(array 4 + rl/Vector2)` is built and is the answer to the case that raised it. The reasoning below is kept because it is what + chose between the three surfaces, and the first of them is not what was taken — see BUILT.md, "`(array 4 + rl/Vector2)`, and the one position with no type slot". The original entry: + + A fixed array is either a top-level `defvar` or a literal with every element spelled out. `(let [pts [4 rl/Vector2]] …)` parses as a two-element array literal and fails with *unknown name rl/Vector2*. Cost: 32 hand-written `Vector2`s in one example. **Looked at and stopped — it is a grammar question, not a missing feature.** Everything under the surface is already there: `Ast.binding` carries a @@ -953,7 +961,12 @@ the web target are untried. And a **wasi** build that reaches raylib now fails o missing `-l:libraylib.so.550`, because that line is tagged `@native` — the same error one step later, and a worse message. -### `break`, and why it was not built +### `break`, and why it was not built — **it is built now** + +Kept as written, because everything in it held and the two blockers at the end are the two things the build had to +rule on. Both are ruled on in BUILT.md, "`break` and `continue`, and the rule that replaced a blanket refusal": +the `in_frames` precedent was replaced by a barrier on the loop stack, which refuses a *crossing* rather than +everything, and `Tast.While` grew the latch. The original note: Settled, so the next attempt is cheap rather than a rediscovery: diff --git a/lib/ast.ml b/lib/ast.ml index e147eef..2d2c93f 100644 --- a/lib/ast.ml +++ b/lib/ast.ml @@ -40,8 +40,17 @@ and expr_kind = | Do of expr list | Let of binding list * expr list | If of expr * expr * expr option - | While of expr * expr list + (* 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 | 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 + goto: the checker resolves the name against the loops this form is + lexically inside, so control can only leave a loop it is already in — + Odin's restriction, and what keeps it safe. *) + | Break of string option + | Continue of string option | Set of place * expr | Field of expr * string (* (.pos c) — auto-derefs one level *) | Call of expr * expr list @@ -57,7 +66,7 @@ and expr_kind = | ArrayOf of texpr (* the whole array type, built by Parse *) (* These bind names or alter control flow, so none of them can be a call. *) | Fn of string list * expr list (* (fn [x y] ...) — non-escaping *) - | Dotimes of string * expr * expr list (* (dotimes [i n] ...) *) + | Dotimes of string option * string * expr * expr list (* (dotimes :o [i n] ...) *) | Defer of expr list (* runs on scope exit *) | Unwrap of unwrap * expr (* (some x) / (try x) *) (* (handler-bind [(Type [c] body ...) ...] body ...) — spec-conditions.md. diff --git a/lib/check.ml b/lib/check.ml index 8835f99..2bf97d3 100644 --- a/lib/check.ml +++ b/lib/check.ml @@ -89,6 +89,35 @@ let new_env () = { lifted = []; } +(* What a [break] or a [continue] may be talking about, innermost first. + + [Lloop] is a loop it is lexically inside, carrying its label if it was given + one. [Lbarrier] is something a jump may not cross, named so the refusal can + say which — and the barriers are the whole of the answer to the question + [return]'s [in_frames] rule could not answer. + + [return] is refused inside a [handler-bind] or a [restart-case] blanketly, + because a return *always* crosses the frames established there and leaves + them on the stack pointing into a frame that has gone. A break crosses only + sometimes: a loop written wholly inside a [restart-case] body has a + perfectly good local break, and refusing it would be refusing the common + case for the uncommon one. So the rule here is relative rather than blanket + — a jump is refused exactly when a barrier stands between it and the loop it + names — and the two rules agree on the case they share, because a [return] + is a jump whose target is always outside every barrier. + + A [defer]'s forms are a barrier for a different reason with the same shape: + they are copied into the function's exit paths, where the loop they were + written next to no longer exists. A loop *inside* the defer is fine, which + is again the relative rule and not a blanket one. + + A handler clause is not on this list at all: it is lifted into a function of + its own and gets a fresh [ctx], so its loops start empty and nothing inside + it can name a loop outside it. *) +type lentry = + | Lloop of string option + | Lbarrier of string + (* Per-function state. Slots are never reused, so [slots] is also the frame size — the interpreter allocates one array of this length per call. *) type ctx = { @@ -140,6 +169,11 @@ type ctx = { that has gone, so it is refused — the same rule as [defer] inside a block. *) mutable in_frames : string option; + (* The loops and the barriers this form is inside, innermost first. See + [lentry]: it is what [break] and [continue] resolve against, and the whole + 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 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 @@ -595,6 +629,18 @@ let expect loc ~want (got : Tast.expr) = fail loc "expected %s, found %s" (Types.to_string w) (Types.to_string got.Tast.ty) +(* Something a [break] may not jump out of, named so the refusal can say which. + See [lentry]: it is a barrier and not a blanket refusal, so a loop written + wholly inside one keeps its own perfectly good local break. Outside the + recursive group below because its callers hand it bodies of two shapes — one + expression and a list of them — and inside it would be monomorphic. *) +let barrier ctx what f = + let loops = ctx.loops in + ctx.loops <- Lbarrier what :: loops; + let r = f () in + ctx.loops <- loops; + r + (* ── Expressions ───────────────────────────────────────────────────── *) (* ── (Map K V): the key's hash and equality pair ──────────────────────── @@ -631,7 +677,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 = []; in_handler = false; in_frames = None; + defers = []; outer = []; in_handler = false; in_frames = None; loops = []; in_defer = false; defer_ok = false; defer_block = "a nested form"; dead = []; borrow = false; owner = "" } @@ -873,12 +919,20 @@ let rec check ctx ?want (e : Ast.expr) : Tast.expr = 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' - | Ast.While (c, body) -> + | Ast.While (label, c, body) -> let c = check ctx ~want:Types.Bool c in - let body = in_loop ctx (fun () -> + let body = in_loop ctx ?label (fun () -> scoped ctx (fun () -> map_lr (fun b -> check ctx b) body)) in - expect loc ~want (mk loc Types.Unit (Tast.While (c, body))) + (* No latch: a [while] has nothing to run between the body and the test, so + a [continue] can branch straight at the condition. *) + 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. *) + | Ast.Break label -> + mk loc Types.Never (Tast.Break (loop_target ctx loc "break" label)) + | Ast.Continue label -> + mk loc Types.Never (Tast.Continue (loop_target ctx loc "continue" label)) | Ast.Return v when ctx.in_frames <> None -> ignore v; (* The frames are pushed and popped around the body, so an early exit would @@ -945,7 +999,8 @@ let rec check ctx ?want (e : Ast.expr) : Tast.expr = Option; this one returns %s" (Types.to_string other)) | Ast.Unwrap (Ast.Utry, _) -> unimplemented loc "try (Result)" 6 | Ast.Fn _ -> unimplemented loc "fn values" 5 - | Ast.Dotimes (name, count, body) -> check_dotimes ctx ~want loc name count body + | Ast.Dotimes (label, name, count, body) -> + check_dotimes ctx ~want loc label name count body (* (signal c) : Unit, always — spec-conditions.md §1. A handler that returns normally leaves the signalling function to carry on, and with nothing matching this is a no-op, so nothing about it alters control flow. That is @@ -1223,7 +1278,7 @@ and check_handler_bind ctx ?want loc clauses body = the enclosing one. *) let hctx = { env = ctx.env; ret = Types.Unit; slots = 0; slot_tys = []; slot_names = []; - scope = []; defers = []; outer = ctx.scope; in_handler = true; in_frames = None; in_defer = false; defer_ok = false; defer_block = "a nested form"; dead = []; borrow = false; owner = "" } + scope = []; defers = []; outer = ctx.scope; in_handler = true; in_frames = None; loops = []; 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. @@ -1270,7 +1325,9 @@ and check_handler_bind ctx ?want loc clauses body = collide. *) let saved = ctx.in_frames in ctx.in_frames <- Some "handler-bind"; - let body = map_lr (fun e -> check ctx e) body in + let body = + barrier ctx "a handler-bind" (fun () -> map_lr (fun e -> check ctx e) body) + in ctx.in_frames <- saved; mk loc Types.Unit (Tast.Handled (frames, body)) @@ -1289,7 +1346,7 @@ and check_handler_bind ctx ?want loc clauses body = and check_restart_case ctx ?want loc body clauses = let saved = ctx.in_frames in ctx.in_frames <- Some "restart-case"; - let tbody = check ctx ?want body in + let tbody = barrier ctx "a restart-case" (fun () -> check ctx ?want body) in ctx.in_frames <- saved; (* With no expectation from outside, the body's own type is the expectation the clauses are checked against — unless it produced no value at all, in @@ -1334,7 +1391,12 @@ and check_restart_case ctx ?want loc body clauses = a clause that disagrees fails where it is written. The first one to produce a value is what settles it when nothing outside did. *) - (params, block ctx ?want:!ty c.Ast.rloc c.Ast.rbody)) + (params, + (* The same barrier the body gets, and for the same reason: a + clause runs after a transfer landed at this restart-case, with + its frames still to be popped. *) + barrier ctx "a restart-case" + (fun () -> block ctx ?want:!ty c.Ast.rloc c.Ast.rbody))) in if !ty = None && b.Tast.ty <> Types.Never then ty := Some b.Tast.ty; let sg = restart_sig (List.map snd params) in @@ -1349,7 +1411,13 @@ and check_restart_case ctx ?want loc body clauses = nothing where it stands, so what is left behind is [unit]. *) and register_defer ctx loc forms = ctx.in_defer <- true; - let forms = map_lr (fun d -> check ctx d) forms in + (* A barrier, for the reason [defer] itself exists: these forms are *copied* + into every exit path of the function, where the loop they were written + beside is not running. A loop written inside the defer is below the + barrier and breaks out of itself perfectly well. *) + let forms = + barrier ctx "a defer" (fun () -> map_lr (fun d -> check ctx d) forms) + in ctx.in_defer <- false; ctx.defers <- mk loc Types.Unit (Tast.Do forms) :: ctx.defers; unit_at loc @@ -1386,9 +1454,13 @@ 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 f = +and in_loop ctx ?label f = let outer_slots = 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; (* 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. *) @@ -1396,6 +1468,7 @@ and in_loop ctx f = ctx.defer_block <- "a loop body"; let r = f () in ctx.defer_block <- blocker; + ctx.loops <- loops; List.iter (fun (slot, where) -> if (not (List.mem_assoc slot before)) && List.mem slot outer_slots then @@ -1406,12 +1479,56 @@ and in_loop ctx f = ctx.dead; r -and check_dotimes ctx ~want loc name count body = +(* Which loop a [break] or a [continue] means, as a count of loops outwards + from the innermost — which is what [Tast.Break] carries and what [emit] + indexes. Refuses three things, each by its own reason: nothing to break out + of, a label naming no loop this form is inside, and a jump that would cross + a barrier. *) +and loop_target ctx loc verb label = + let rec go depth = function + | [] -> + (match label with + | None -> + fail loc "%s is only allowed inside a loop" verb + | Some l -> + fail loc + "no loop named :%s encloses this %s. A label names one of the loops \ + this form is written inside — it is not a goto, so it cannot name a \ + loop somewhere else" l verb) + | Lloop name :: rest -> + (match label with + | None -> depth + | Some l when name = Some l -> depth + | Some _ -> go (depth + 1) rest) + | 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 + to a loop that is not there on the path the forms were copied into. + A loop nested inside the construct is below this entry and is never + reached here, which is the whole point of the rule being relative. *) + ignore rest; + (match label with + | None -> + fail loc + "%s is not allowed here: the nearest loop is outside %s, and leaving \ + it that way would skip what %s does on the way out. Write the loop \ + inside it, or leave with a value and test that after" + verb what what + | Some l -> + fail loc + "%s :%s would leave %s, which it may not: whatever %s does on the way \ + out would be skipped. A break may only leave loops that are inside \ + the same %s it is" + verb l what what what) + in + go 0 ctx.loops + +and check_dotimes ctx ~want loc label name count body = let count = check ctx ~want:index_ty count in scoped ctx (fun () -> let i = bind ctx name index_ty ~assignable:false in let limit = fresh_slot ctx index_ty in - let body = in_loop ctx (fun () -> map_lr (fun b -> check ctx b) body) in + let body = in_loop ctx ?label (fun () -> map_lr (fun b -> check ctx b) body) in let iv = mk loc index_ty (Tast.Local i) in let one = mk loc index_ty (Tast.Int (1L, Types.I32)) in let cond = @@ -1424,7 +1541,11 @@ and check_dotimes ctx ~want loc name count body = mk loc index_ty (Tast.Prim (Tast.Add, [ iv; one ])))) in let zero = mk loc index_ty (Tast.Int (0L, Types.I32)) in - let loop = mk loc Types.Unit (Tast.While (cond, body @ [ step ])) in + (* The step is the *latch* and not the last form of the body. Folded onto + the body it would be skipped by a [continue], which branches past the + rest of the body — so [i] would never advance and the loop would hang. + That is the whole reason [Tast.While] carries a third list. *) + let loop = mk loc Types.Unit (Tast.While (cond, body, [ step ])) in expect loc ~want (mk loc Types.Unit (Tast.Let ([ (i, zero); (limit, count) ], [ loop ])))) @@ -2004,7 +2125,7 @@ and alloc_guard ctx loc (attempt : Tast.expr) = in mk loc Types.Unit (Tast.Let ([ (ok, mk loc Types.Bool (Tast.Bool false)) ], - [ mk loc Types.Unit (Tast.While (notok (), [ body ])) ])) + [ mk loc Types.Unit (Tast.While (notok (), [ body ], [])) ])) (* ── File failure, decisions 2 and 5 ─────────────────────────────────── The same shape [alloc_guard] has, for the same reason and out of the same @@ -2077,7 +2198,7 @@ and file_guard ctx loc ~path_slot ~op mk_steps = in mk loc Types.Unit (Tast.Let ([ (ok, mk loc Types.Bool (Tast.Bool false)) ], - [ mk loc Types.Unit (Tast.While (notok (), [ body ])) ])) + [ mk loc Types.Unit (Tast.While (notok (), [ body ], [])) ])) (* Is this bare symbol the name of a type? Every table [resolve_name] will look in, and the union table is one of them: a union is [Named] exactly as a @@ -3541,7 +3662,7 @@ let collect env (decls : Ast.decl list) = run without swallowing it. *) let infer (_, v) = (check { env; ret = Types.Unit; slots = 0; slot_tys = []; slot_names = []; scope = []; defers = []; - outer = []; in_handler = false; in_frames = None; in_defer = false; defer_ok = false; defer_block = "a nested form"; dead = []; borrow = false; owner = "" } v).Tast.ty + outer = []; in_handler = false; in_frames = None; loops = []; 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 () = @@ -3594,7 +3715,7 @@ let check_finite env = let check_fn env (fn : Ast.fn) : Tast.fn = let params, ret = Hashtbl.find env.fns fn.Ast.name in let ctx = { env; ret; slots = 0; slot_tys = []; slot_names = []; scope = []; defers = []; - outer = []; in_handler = false; in_frames = None; in_defer = false; defer_ok = false; defer_block = "a nested form"; dead = []; borrow = false; + outer = []; in_handler = false; in_frames = None; loops = []; 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 -> @@ -3683,7 +3804,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 = []; in_handler = false; in_frames = None; in_defer = false; defer_ok = false; defer_block = "a nested form"; dead = []; borrow = false; owner = "" } in + outer = []; in_handler = false; in_frames = None; loops = []; 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 @@ -3815,7 +3936,7 @@ let expression env (e : Ast.expr) : Tast.expr * Types.t array * string option array = let ctx = { env; ret = Types.Unit; slots = 0; slot_tys = []; slot_names = []; scope = []; defers = []; - outer = []; in_handler = false; in_frames = None; in_defer = false; defer_ok = false; defer_block = "a nested form"; dead = []; borrow = false; owner = "" } + outer = []; in_handler = false; in_frames = None; loops = []; 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/emit.ml b/lib/emit.ml index 579998a..27f34cf 100644 --- a/lib/emit.ml +++ b/lib/emit.ml @@ -479,6 +479,12 @@ type f = { through [unwind], which runs its defers (§5) and returns early. The flag says the block was branched to, so an unused one is not emitted. *) mutable pads : (string * bool ref) list; + (* The loops being emitted, innermost first: for each, the label a [break] + branches to and the label a [continue] branches to. Exactly the shape + [pads] has, and for the same reason — a jump names its target by how far + out it is, so the stack is the lookup. [Tast.Break] carries that distance + already, so this is indexed and never searched. *) + mutable loops : (string * string) list; unwind : string; mutable unwound : bool; defers : Tast.expr list; @@ -807,7 +813,16 @@ and value_at f (e : Tast.expr) : string = bs; block f body | Tast.If (c, t, e') -> emit_if f e.Tast.ty c t e' - | Tast.While (c, body) -> emit_while f c body; "zeroinitializer" + | Tast.While (c, body, latch) -> emit_while f c body latch; "zeroinitializer" + (* A plain branch, and then the block is dead — [term] closes it and [ins] + drops whatever the checker still had to walk past. The checker proved the + target exists and is one this jump may reach; here it is an index. *) + | Tast.Break n -> + term f "br label %%%s" (fst (List.nth f.loops n)); + "zeroinitializer" + | Tast.Continue n -> + term f "br label %%%s" (snd (List.nth f.loops n)); + "zeroinitializer" | Tast.Return v -> (match v with | None -> ret f "zeroinitializer" @@ -1446,15 +1461,28 @@ and emit_if f ty c t e = match result with Some r -> load f r ty | None -> "zeroinitializer" end -and emit_while f c body = +(* Four blocks, not three: the *latch* between the body and the test is what a + [continue] branches to, and it is where [dotimes] puts its increment. Folded + onto the end of the body instead, a continue would jump past it and the loop + would never advance. A [while] has an empty latch and the block is one + branch, which every optimiser folds away. *) +and emit_while f c body latch = let lc = fresh_label f "loop" and lb = fresh_label f "body" - and le = fresh_label f "endloop" in + and ll = fresh_label f "latch" and le = fresh_label f "endloop" in term f "br label %%%s" lc; label f lc; let cv = value f c in term f "br i1 %s, label %%%s, label %%%s" cv lb le; label f lb; + (* Pushed around the body only: the condition and the latch are not inside + the loop as far as a jump is concerned, and nothing in either is ever a + break in any case. *) + f.loops <- (le, ll) :: f.loops; List.iter (fun e -> ignore (value f e)) body; + f.loops <- List.tl f.loops; + term f "br label %%%s" ll; + label f ll; + List.iter (fun e -> ignore (value f e)) latch; term f "br label %%%s" lc; label f le @@ -1894,7 +1922,8 @@ let emit_fn m ?(hidden = false) ?(pnames = []) (fn : Tast.fn) = ret = fn.Tast.ret; slots = Array.init n (fun i -> Printf.sprintf "%%s%d" i); slot_tys = fn.Tast.slots; - pads = []; unwind = "unwind"; unwound = false; defers = fn.Tast.fdefers; + pads = []; loops = []; unwind = "unwind"; unwound = false; + defers = fn.Tast.fdefers; frame = None; slotv = None; snames = fn.Tast.snames; dsub; dline = (if fn.Tast.floc.Loc.line = 0 then 1 else fn.Tast.floc.Loc.line); diff --git a/lib/load.ml b/lib/load.ml index 574ad77..4ed981e 100644 --- a/lib/load.ml +++ b/lib/load.ml @@ -183,7 +183,10 @@ let rec rename_expr owned alias bound (e : Ast.expr) : Ast.expr = in 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 (c, body) -> Ast.While (go c, gos body) + | Ast.While (l, c, body) -> Ast.While (l, go c, gos body) + (* 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 | Ast.Return v -> Ast.Return (Option.map go v) | Ast.Set (p, v) -> Ast.Set (rename_place owned alias bound p, go v) | Ast.Field (t, f) -> Ast.Field (go t, f) @@ -204,8 +207,9 @@ let rec rename_expr owned alias bound (e : Ast.expr) : Ast.expr = | Ast.ArrayOf t -> Ast.ArrayOf (rename_texpr owned alias t) | Ast.Fn (ps, body) -> Ast.Fn (ps, List.map (rename_expr owned alias (ps @ bound)) body) - | Ast.Dotimes (i, n, body) -> - Ast.Dotimes (i, go n, List.map (rename_expr owned alias (i :: bound)) body) + | Ast.Dotimes (l, i, n, body) -> + Ast.Dotimes (l, i, go n, + List.map (rename_expr owned alias (i :: bound)) body) | Ast.Defer body -> Ast.Defer (gos body) | Ast.Unwrap (u, v) -> Ast.Unwrap (u, go v) | Ast.Signal (k, c) -> Ast.Signal (k, go c) @@ -372,7 +376,8 @@ let rec expr_uses acc (e : Ast.expr) = bs; gos body | Ast.If (c, t, e') -> go c; go t; Option.iter go e' - | Ast.While (c, body) -> go c; gos body + | Ast.While (_, c, body) -> go c; gos body + | Ast.Break _ | Ast.Continue _ -> () | Ast.Return v -> Option.iter go v | Ast.Set (p, v) -> place_uses acc e.Ast.loc p; go v | Ast.Field (t, _) -> go t @@ -385,7 +390,7 @@ let rec expr_uses acc (e : Ast.expr) = | Ast.Arr items -> gos items | Ast.ArrayOf t -> texpr_uses acc t | Ast.Fn (_, body) -> gos body - | Ast.Dotimes (_, n, body) -> go n; gos body + | Ast.Dotimes (_, _, n, body) -> go n; gos body | Ast.Defer body -> gos body | Ast.Unwrap (_, v) -> go v | Ast.Signal (_, c) -> go c diff --git a/lib/parse.ml b/lib/parse.ml index 864957c..30b0263 100644 --- a/lib/parse.ml +++ b/lib/parse.ml @@ -152,18 +152,38 @@ and form f mk (head : Form.t) (args : Form.t list) : Ast.expr = | Sym "or" -> shortcircuit f args ~is_and:false (* ── loops ─────────────────────────────────────────────────────── *) + (* An optional label comes first: [(while :outer (< i n) ...)]. A keyword in + the head position is unambiguous because a loop condition is never one and + a [dotimes] binding vector is never one either, so [label] peels it off + whatever follows the form's name. *) | Sym "while" -> - (match args with - | c :: body -> mk (Ast.While (expr c, body_of body)) - | [] -> fail f "while is (while test body ...)") + (match label args with + | lbl, c :: body -> mk (Ast.While (lbl, expr c, body_of body)) + | _, [] -> + fail f "while is (while test body ...), or (while :label test body ...)") | Sym "until" -> - (match args with - | c :: body -> + (match label args with + | lbl, c :: body -> let neg = { Ast.e = Ast.Call ({ Ast.e = Ast.Var "not"; loc = head.loc }, [ expr c ]); loc = f.loc } in - mk (Ast.While (neg, body_of body)) - | [] -> fail f "until is (until test body ...)") + mk (Ast.While (lbl, neg, body_of body)) + | _, [] -> + fail f "until is (until test body ...), or (until :label test body ...)") + + (* Break and continue. Not a goto: the label names one of the loops this form + is lexically inside, and the checker resolves it against exactly those, so + control can only leave a loop it is already in — the same restriction + Odin's labelled break has. Bare, each means the innermost loop. *) + | Sym "break" -> + (match label args with + | lbl, [] -> mk (Ast.Break lbl) + | _ -> fail f "break is (break) or (break :label)") + + | Sym "continue" -> + (match label args with + | lbl, [] -> mk (Ast.Continue lbl) + | _ -> fail f "continue is (continue) or (continue :label)") (* ── control ───────────────────────────────────────────────────── *) | Sym "return" -> @@ -211,10 +231,10 @@ and form f mk (head : Form.t) (args : Form.t list) : Ast.expr = | _ -> fail f "fn is (fn [param ...] body ...)") | Sym "dotimes" -> - (match args with - | { v = Vec [ n; count ]; _ } :: body -> + (match label args with + | lbl, ({ v = Vec [ n; count ]; _ } :: body) -> no_pattern n; - mk (Ast.Dotimes (sym n, expr count, body_of body)) + mk (Ast.Dotimes (lbl, sym n, expr count, body_of body)) | _ -> fail f "dotimes is (dotimes [name count] body ...)") | Sym "defer" -> @@ -335,12 +355,6 @@ and form f mk (head : Form.t) (args : Form.t list) : Ast.expr = the restart stack without committing to one. *) | "find-restart" | "compute-restarts" | "errdefer" | "loop" | "recur" - (* plan.org's loop story is settled as imperative while/for with these - two and [return]. Neither exists, and both *alter control flow* — - the first thing the house rule says must be recognised explicitly. - Falling through to Call answered "unknown function break", which - reads as a typo rather than as a missing feature. *) - | "break" | "continue" | "await" as name) -> fail f "%s is not implemented yet (see the build sequence in plan.org)" name @@ -364,6 +378,16 @@ and is_map (f : Form.t) = match f.v with Map _ -> true | _ -> false and body_of (items : Form.t list) : Ast.expr list = List.map expr items +(* A loop label, or a [break]'s target: a leading keyword, peeled off. Nothing + else in any of these positions is a keyword — a loop condition is not, a + [dotimes] binding vector is not, and [break] takes nothing else at all — so + one function serves all four forms and no form has to say which arguments it + has counted. *) +and label (items : Form.t list) : string option * Form.t list = + match items with + | { v = Kw k; _ } :: rest -> (Some k, rest) + | _ -> (None, items) + 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/reach.ml b/lib/reach.ml index 074d357..1a59826 100644 --- a/lib/reach.ml +++ b/lib/reach.ml @@ -50,7 +50,8 @@ let rec expr_refs f (e : Tast.expr) = | Tast.Do es -> gos es | Tast.Let (bs, body) -> List.iter (fun (_, v) -> go v) bs; gos body | Tast.If (c, t, e') -> go c; go t; go e' - | Tast.While (c, body) -> go c; gos body + | Tast.While (c, body, latch) -> go c; gos body; gos latch + | Tast.Break _ | Tast.Continue _ -> () | Tast.Return v -> Option.iter go v | Tast.Set (p, v) -> place_refs f p; go v | Tast.Field (t, _) -> go t diff --git a/lib/render.ml b/lib/render.ml index 0333943..43344bf 100644 --- a/lib/render.ml +++ b/lib/render.ml @@ -265,7 +265,7 @@ let rec render c depth (e : Tast.expr) : Tast.expr list = [ lit "["; unit_ (Tast.While - (cond, (lit " " :: render c (depth + 1) elem) @ [ step ])); + (cond, lit " " :: render c (depth + 1) elem, [ step ])); lit "]" ])) ] | t -> fail loc "no printer for %s" (Types.to_string t) diff --git a/lib/tast.ml b/lib/tast.ml index 7c05b67..a350965 100644 --- a/lib/tast.ml +++ b/lib/tast.ml @@ -86,8 +86,24 @@ and expr_kind = | Do of expr list | Let of (int * expr) list * expr list | If of expr * expr * expr - | While of expr * expr list + (* condition, body, and the *latch*: forms that run after the body and before + the condition is tested again. [dotimes] folds its increment in there + rather than onto the end of the body, because a [continue] branches to the + latch and a step written in the body would be skipped — the loop would + never advance and would hang. A [while] has an empty latch. *) + | While of expr * expr list * expr list | Return of expr option + (* Leaving a loop, and jumping to its latch. The int is how many loops out + the target is, innermost first: 0 is the loop this is directly inside. + A *relative* depth rather than a name or an id because it is exactly what + each backend already has — [emit] keeps one entry per [While] it is inside + and indexes it. The invariant that makes it sound: the checker mints these + 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. *) + | Break of int + | Continue of int | Set of place * expr | Field of expr * int (* target is already a struct value *) | Addr of place diff --git a/test/programs/loops.flan b/test/programs/loops.flan new file mode 100644 index 0000000..db7831f --- /dev/null +++ b/test/programs/loops.flan @@ -0,0 +1,85 @@ +;;;; break and continue, with loop labels. +;;;; +;;;; The two things worth asserting here rather than in a unit test, because +;;;; they are about the code that comes out and not about the checker: +;;;; +;;;; 1. A (continue) in a dotimes still advances the counter. The step is the +;;;; loop's *latch* and not the last form of the body — folded onto the body +;;;; it would be jumped over and the program would hang, which is a test +;;;; that fails by never finishing rather than by printing the wrong thing. +;;;; The watchdog is what turns that back into a failure. +;;;; +;;;; 2. A labelled break leaves the loop it names and no other. + +(defstruct Hit [n i32]) + +(defn main [] i32 + ;; break, unlabelled: the innermost loop. + (let [i 0] + (while (< i 100) + (set i (+ i 1)) + (when (= i 4) (break))) + (print i) (println "")) ; 4 + + ;; continue in a while. The advance is written before it, because a while + ;; has no latch of its own — that is the loop's own business and not the + ;; compiler's. + (let [j 0 seen 0] + (while (< j 6) + (set j (+ j 1)) + (when (= (% j 2) 0) (continue)) + (set seen (+ seen j))) + (print seen) (println "")) ; 1 + 3 + 5 = 9 + + ;; continue in a dotimes, which is the one the latch exists for: the counter + ;; must advance on the skipped iteration too, or this never returns. + (let [sum 0] + (dotimes [k 5] + (when (= k 2) (continue)) + (set sum (+ sum k))) + (print sum) (println "")) ; 0 + 1 + 3 + 4 = 8 + + ;; A labelled break leaves the named loop. Without the label it would leave + ;; the inner one and the outer would run all three times: 0 1 0 1 0 1. + (dotimes :outer [a 3] + (dotimes [b 3] + (when (= b 2) (break :outer)) + (print b) (println ""))) ; 0 1 + + ;; A labelled continue starts the *outer* loop's next iteration, so the rest + ;; of the outer body is skipped as well as the rest of the inner one. + (dotimes :rows [r 3] + (dotimes [c 3] + (when (= c 1) (continue :rows)) + (print c) (println "")) + (println "tail")) ; 0 0 0, and no tail + + ;; until takes a label on the same rule, being a while with a negated test. + (let [n 0] + (until :count (> n 10) + (set n (+ n 1)) + (when (= n 3) (break :count))) + (print n) (println "")) ; 3 + + ;; A loop wholly inside a restart-case body has a perfectly good local + ;; break: nothing the restart-case established is crossed by leaving a loop + ;; that is inside it. This is the case the blanket refusal on return would + ;; have caught and the relative rule does not. + (let [t 0] + (restart-case + (while true + (set t (+ t 1)) + (when (> t 5) (break))) + (carry-on [] (println "not reached"))) + (print t) (println "")) ; 6 + + ;; The same the other way round: a handler-bind written inside the loop body + ;; is entered and left before the break runs, so the break crosses nothing. + (let [u 0] + (while true + (handler-bind [(Hit [c] (println "hit"))] + (signal (Hit {.n 1}))) + (set u (+ u 1)) + (when (= u 2) (break))) + (print u) (println "")) ; hit hit 2 + 0) diff --git a/test/test_acceptance.ml b/test/test_acceptance.ml index bb08748..e54bb09 100644 --- a/test/test_acceptance.ml +++ b/test/test_acceptance.ml @@ -120,6 +120,12 @@ let () = (* (array COUNT TYPE). Every line of it is a [let] binding, which is the one position with no type slot and the whole reason the form exists. *) outputs "array constructor" "programs/array-ctor.flan" "4\n0\n7\n9\n4\n"; + (* break and continue. The dotimes/continue case is the one that fails by + hanging rather than by printing the wrong thing — the step is the loop's + latch, and folded onto the body a continue would jump past it — so the + watchdog above is what turns that failure back into a report. *) + outputs "break and continue" "programs/loops.flan" + "4\n9\n8\n0\n1\n0\n0\n0\n3\n6\nhit\nhit\n2\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 3362325..01d3862 100644 --- a/test/test_flan.ml +++ b/test/test_flan.ml @@ -295,8 +295,23 @@ let () = be now -- test/programs/macro-unless.flan, through a compiler that has to run the macro to get there. *) + (* The label is peeled off the head, and [break] carries the name it was + given rather than anything resolved — resolving it is the checker's job, + which is what makes it not a goto. *) + (match (parse1 "(while :outer c a)").e with + | While (Some "outer", _, [ _ ]) -> () + | _ -> check "while takes a label" false); + + (match (parse1 "(break :outer)").e with + | Break (Some "outer") -> () + | _ -> check "break takes a label" false); + + (match (parse1 "(continue)").e with + | Continue None -> () + | _ -> check "bare continue" false); + (match (parse1 "(until c a)").e with - | While ({ e = Call ({ e = Var "not"; _ }, [ _ ]); _ }, [ _ ]) -> () + | While (None, { e = Call ({ e = Var "not"; _ }, [ _ ]); _ }, [ _ ]) -> () | _ -> check "until -> while(not)" false); (match (parse1 "(cond a 1 b 2 :else 3)").e with @@ -315,7 +330,7 @@ let () = (* This is the class that silently misparses: it reads fine as a call and means something entirely different. *) (match (parse1 "(dotimes [i 10] (f i))").e with - | Dotimes ("i", { e = Int 10L; _ }, [ _ ]) -> () + | Dotimes (None, "i", { e = Int 10L; _ }, [ _ ]) -> () | _ -> check "dotimes binds" false); (match (parse1 "(fn [x y] x)").e with | Fn ([ "x"; "y" ], [ _ ]) -> () @@ -462,6 +477,12 @@ let () = parse_rejects "odd field pairs" "(defstruct S [a])"; parse_rejects "cond without body" "(cond a)"; parse_rejects "unknown top form" "(nope x)"; + parse_rejects "break takes only a label" "(defn f [] (break 1))" + ~needle:"break is (break) or (break :label)"; + parse_rejects "continue takes only a label" "(defn f [] (continue x))" + ~needle:"continue is (continue) or (continue :label)"; + parse_rejects "a labelled while still needs a test" "(defn f [] (while :o))" + ~needle:"(while :label test body ...)"; parse_rejects "array with no type" "(defn f [] (array 4))" ~needle:"array is (array COUNT TYPE)"; parse_rejects "array given a value, not a type" "(defn f [] (array 4 5))" @@ -807,6 +828,36 @@ let () = rejects_check "defer is refused in a branch" "(defn g [] 0) (defn f [] (if true (defer (g)) 0))" ~needle:"a branch"; + (* break and continue. The interesting half is the *relative* rule: a jump + may not cross a construct that has work to do on the way out, and the + refusal names which construct. That is what replaced the blanket refusal + [return] still carries, and the accepting cases below are the ones a + blanket rule would have got wrong. *) + accepts "break leaves the innermost loop" + "(defn f [] (while true (break)))"; + accepts "a labelled break leaves the named loop" + "(defn f [] (while :o true (while true (break :o))))"; + accepts "continue in a dotimes" + "(defn f [] (dotimes [i 3] (continue)))"; + rejects_check "break outside a loop" + "(defn f [] (break))" ~needle:"only allowed inside a loop"; + rejects_check "continue outside a loop" + "(defn f [] (continue))" ~needle:"only allowed inside a loop"; + rejects_check "a label naming no enclosing loop" + "(defn f [] (while true (break :nope)))" ~needle:"no loop named :nope"; + (* The rule the blanket one could not express, both ways round. A loop + wholly inside a restart-case body keeps its local break; a break that + would *leave* the restart-case is refused, and says so. *) + accepts "a loop inside a restart-case may break out of itself" + "(defn f [] (restart-case (while true (break)) (go [] (println \"\"))))"; + rejects_check "break may not leave a restart-case" + "(defn f [] (while true (restart-case (break) (go [] (println \"\")))))" + ~needle:"a restart-case"; + accepts "a loop inside a handler-bind may break out of itself" + "(defstruct C [n i32]) (defn f [] (handler-bind [(C [c] 0)] (while true (break))))"; + 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"; (* 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 3f097de52232abfabcffc736d8674000c9a0cfdb Mon Sep 17 00:00:00 2001 From: Joseph Ferano Date: Sat, 12 Sep 2026 22:00:13 +0700 Subject: [PATCH 3/3] Pin the latch to the continue path, and the clause barrier to its reason A dotimes whose every iteration continues still counts to its trip count. The existing case fails by hanging if the latch is wrong; this one fails by counting wrong, which is the off-by-one the four-block layout could have. A restart-case clause was made a barrier on reasoning alone and nothing observed it. Now something does. And say what a labelled continue means, which is the half that is not obvious: it advances the named loop's counter and skips the rest of its body, not just the rest of the innermost one. --- BUILT.md | 5 +++++ test/programs/loops.flan | 9 +++++++++ test/test_acceptance.ml | 2 +- test/test_flan.ml | 5 +++++ 4 files changed, 20 insertions(+), 1 deletion(-) diff --git a/BUILT.md b/BUILT.md index 72ed093..05f9da1 100644 --- a/BUILT.md +++ b/BUILT.md @@ -2490,6 +2490,11 @@ header would have jumped straight past it: the counter would never advance and t the latch, `continue` branches to the latch block rather than to the header, and a `while` has an empty latch that every optimiser folds away. `emit_while` emits four blocks instead of three. +A **labelled** `continue` is the half worth stating outright: `(continue :rows)` branches to the *named* loop's latch, +so that loop's counter advances and the rest of its body is skipped along with the rest of every loop inside it. It is +"start the next iteration of `:rows`", not "skip the rest of this innermost body". `loops.flan` asserts exactly that — +an outer `dotimes` whose tail never prints while its counter still runs out. + `Tast.Break` and `Tast.Continue` carry a **relative depth** — how many loops out the target is, innermost first — rather than a name or an id, because that is exactly what a backend already has. `emit` keeps one entry per `While` it is inside, the same shape and for the same reason as `pads`, and indexes it. The invariant this rests on: the diff --git a/test/programs/loops.flan b/test/programs/loops.flan index db7831f..dfe5678 100644 --- a/test/programs/loops.flan +++ b/test/programs/loops.flan @@ -39,6 +39,15 @@ (set sum (+ sum k))) (print sum) (println "")) ; 0 + 1 + 3 + 4 = 8 + ;; Every iteration continues, and the count is still the trip count: the + ;; latch is on the continue path and not merely reachable from the body. The + ;; case above would hang if it were not; this one would count wrong. + (let [c 0] + (dotimes [m 3] + (set c (+ c 1)) + (continue)) + (print c) (println "")) ; 3 + ;; A labelled break leaves the named loop. Without the label it would leave ;; the inner one and the outer would run all three times: 0 1 0 1 0 1. (dotimes :outer [a 3] diff --git a/test/test_acceptance.ml b/test/test_acceptance.ml index e54bb09..da3ca8a 100644 --- a/test/test_acceptance.ml +++ b/test/test_acceptance.ml @@ -125,7 +125,7 @@ let () = latch, and folded onto the body a continue would jump past it — so the watchdog above is what turns that failure back into a report. *) outputs "break and continue" "programs/loops.flan" - "4\n9\n8\n0\n1\n0\n0\n0\n3\n6\nhit\nhit\n2\n"; + "4\n9\n8\n3\n0\n1\n0\n0\n0\n3\n6\nhit\nhit\n2\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 01d3862..06025e1 100644 --- a/test/test_flan.ml +++ b/test/test_flan.ml @@ -853,6 +853,11 @@ let () = rejects_check "break may not leave a restart-case" "(defn f [] (while true (restart-case (break) (go [] (println \"\")))))" ~needle:"a restart-case"; + (* A clause is a barrier for the same reason the body is: it runs after a + transfer landed, with the form's frames still to be popped. *) + rejects_check "break may not leave a restart-case from a clause" + "(defn f [] (while true (restart-case (println \"\") (go [] (break)))))" + ~needle:"a restart-case"; accepts "a loop inside a handler-bind may break out of itself" "(defstruct C [n i32]) (defn f [] (handler-bind [(C [c] 0)] (while true (break))))"; rejects_check "break may not leave a handler-bind"