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

break crosses only sometimes, so the refusal is relative now

Browse Source 
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.
This commit is contained in:
Joseph Ferano 2026-09-12 21:58:53 +07:00
parent 9f4a59c56f
commit 008165335d
13 changed files with 485 additions and 57 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

68
BUILT.md
View File

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

23
NEXT.md
View File

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

13
lib/ast.ml
View File

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

161
lib/check.ml
View File

@ -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 = "<none>" }
@ -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 = "<none>" }
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 = "<none>" }
in
(* The condition crosses as a pointer, because the handler runs while
the signalling frame is still alive and there is nothing to copy.
@ -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 = "<none>" } 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 = "<none>" } 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 = "<none>" } in
outer = []; in_handler = false; in_frames = None; loops = []; in_defer = false; defer_ok = false; defer_block = "a nested form"; dead = []; borrow = false; owner = "<none>" } in
match d.Ast.d with
| Ast.Defvar (n, _, init) ->
let ty, _ = Hashtbl.find env.globals n in
@ -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 = "<none>" }
outer = []; in_handler = false; in_frames = None; loops = []; in_defer = false; defer_ok = false; defer_block = "a nested form"; dead = []; borrow = false; owner = "<none>" }
in
let t = check ctx e in
(t, Array.of_list (List.rev ctx.slot_tys),

37
lib/emit.ml
View File

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

15
lib/load.ml
View File

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

56
lib/parse.ml
View File

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

3
lib/reach.ml
View File

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

2
lib/render.ml
View File

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

18
lib/tast.ml
View File

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

85
test/programs/loops.flan Normal file
View File

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

6
test/test_acceptance.ml
View File

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

55
test/test_flan.ml
View File

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