From 18db822095089e457d51750faaa12fb96212bdb2 Mon Sep 17 00:00:00 2001 From: Joseph Ferano Date: Fri, 11 Sep 2026 09:10:59 +0700 Subject: [PATCH] error, which is the signal a handler has to answer MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit spec-conditions.md §2. The same lookup as signal, and the difference is entirely what happens when the walk ends: signal returns Unit and the signalling function carries on, error has type Never and the program stops. Only a transfer gets past it, so emit puts a guard after the call and then unreachable - and flan_error cannot be marked noreturn for the same reason, it does return, on exactly one path. Being Never is what lets it stand where a value was expected, which is the fall-through shape §1's load-texture example needs and the reason it is worth having before the break loop rather than after. An unhandled one names the condition on stderr and dies the way every other trap does; flan_error is where the dev-build break loop will go. The two spellings share one AST and IR node with a kind beside them, the same shape Ast.unwrap already uses for some and try, because they differ in one decision and nothing else. test/programs/error.flan is the unhandled case, asserted on the exit code and the reason rather than through the outputs table, which only has room for a program that exits 0. --- NEXT.md | 15 +++++++++++++++ lib/ast.ml | 7 ++++++- lib/check.ml | 12 ++++++++++-- lib/emit.ml | 21 ++++++++++++++++++++- lib/load.ml | 2 +- lib/parse.ml | 18 +++++++++++------- lib/tast.ml | 6 +++++- runtime/flan_rt.c | 17 +++++++++++++++++ test/programs/error.flan | 14 ++++++++++++++ test/programs/restarts.flan | 15 +++++++++++++++ test/test_acceptance.ml | 16 +++++++++++++++- test/test_flan.ml | 13 ++++++++++++- 12 files changed, 141 insertions(+), 15 deletions(-) create mode 100644 test/programs/error.flan diff --git a/NEXT.md b/NEXT.md index 336a1ff..cda7a40 100644 --- a/NEXT.md +++ b/NEXT.md @@ -8,6 +8,11 @@ The dev loop works end to end: `flan dev program.flan`, then `C-c C-c`, `C-x C-e` and `C-c C-r` in Emacs against the running process. Conditions are two steps in of four. +`(error c)` is in — §2's diverging variant, same lookup, type `Never`. A +handler that returns normally has not answered it, so only a transfer gets +past; with nothing transferring the program stops and names the condition. +`flan_error` is where the break loop goes. + **The next task is the dev-build break loop, `spec-conditions.md` §2** — where an unhandled `error` stops and talks to the daemon instead of `rt_die()`, and where **"a crash kills the program"** finally gets fixed. The transfer it needs @@ -1011,6 +1016,16 @@ Scope, each piece refused by name with its reason and a test on the reason: and located, rather than an unwind past everything. There is nowhere to resume, so there is nothing else to do. +**`(error c)`, §2.** The same walk as `signal`, and the difference is entirely +what happens when the walk ends: `signal` returns `Unit` and the signalling +function carries on, `error` has type `Never` and stops. So only a transfer +gets past it, which is why `emit` puts a guard after the call and then +`unreachable` — and why `flan_error` cannot be marked `noreturn`, since it does +return, on exactly one path. Being `Never` is also what lets it stand as a +`restart-case` body's fall-through, which is the shape §1's `load-texture` +example needs. `test/programs/error.flan` is the unhandled case: it cannot be +an `outputs` row, because it does not exit 0. + `flan_transfer_fail` covers the ordinary return path as well as the unwind one: a defer that reaches an `invoke-restart` through a call traps either way, and the message names the rule rather than the path, since the rule is the same. diff --git a/lib/ast.ml b/lib/ast.ml index a641c56..c7d9b47 100644 --- a/lib/ast.ml +++ b/lib/ast.ml @@ -56,12 +56,17 @@ and expr_kind = (* (handler-bind [(Type [c] body ...) ...] body ...) — spec-conditions.md. A clause binds a name for the condition, so this cannot be a call. *) | HandlerBind of hclause list * expr list - | Signal of expr (* (signal c) : Unit *) + | Signal of sigkind * expr (* (signal c) / (error c) *) (* (restart-case body (name [] body ...) ...) and (invoke-restart 'name). Both alter control flow, so neither can be a call. *) | RestartCase of expr * rclause list | InvokeRestart of string +(* Two ways to signal, because they are two different things — §1 and §2. + [signal] returns Unit whatever it finds; [error] has type Never and, with + nothing transferring, the program stops. *) +and sigkind = Ssignal | Serror + and hclause = { hty : texpr; hname : string; hbody : expr list; hloc : Loc.t } and rclause = { rname : string; rbody : expr list; rloc : Loc.t } diff --git a/lib/check.ml b/lib/check.ml index 209e152..6ac6aa3 100644 --- a/lib/check.ml +++ b/lib/check.ml @@ -411,7 +411,7 @@ let rec check ctx ?want (e : Ast.expr) : Tast.expr = matching this is a no-op, so nothing about it alters control flow. That is what makes it checkable here rather than needing the transfer machinery restart-case will want. *) - | Ast.Signal c -> + | Ast.Signal (kind, c) -> let c = check ctx c in let name = match c.Tast.ty with @@ -422,7 +422,15 @@ let rec check ctx ?want (e : Ast.expr) : Tast.expr = no condition hierarchy" (Types.to_string t) in - mk loc Types.Unit (Tast.Signal (type_id name, c)) + (* §1 and §2. [signal] is Unit whatever it finds; [error] is Never, + because the only way past it is a handler that transfers — one that + returns normally has not answered it, and the program stops. *) + let ty, kind = + match kind with + | Ast.Ssignal -> (Types.Unit, Tast.Ssignal) + | Ast.Serror -> (Types.Never, Tast.Serror) + in + expect loc ~want (mk loc ty (Tast.Signal (kind, type_id name, c))) | Ast.HandlerBind (clauses, body) -> check_handler_bind ctx ?want loc clauses body diff --git a/lib/emit.ml b/lib/emit.ml index 4571ce6..bd31149 100644 --- a/lib/emit.ml +++ b/lib/emit.ml @@ -70,6 +70,11 @@ let cellname n = "@" ^ quoted ("flan.cell." ^ n) written only by the guards this file emits. *) let xfer_param = "%xfer" +(* The condition's own name, for the message an unhandled [error] prints. The + checker has already refused anything that is not a struct. *) +let struct_name_of (t : Types.t) = + match t with Types.Named n -> n | _ -> "a condition" + let cellptr n = "@" ^ quoted ("flan.cellp." ^ n) let globalptr n = "@" ^ quoted ("flan.gp." ^ n) @@ -328,11 +333,24 @@ let rec value f (e : Tast.expr) : string = | Tast.UnwrapSome v -> emit_unwrap f e.Tast.ty v (* The condition crosses as a pointer: a handler runs while the signalling frame is still alive, so there is nothing to copy and nothing to own. *) - | Tast.Signal (id, c) -> + | Tast.Signal (Tast.Ssignal, id, c) -> let p = addr f c in ins f "call void @flan_signal(i32 %d, ptr %s, ptr %s)" id p xfer_param; guard f; "zeroinitializer" + (* §2's diverging variant. [flan_error] does not return unless a handler + transferred, so the guard is the only way out and the fall-through is + unreachable. It cannot be marked noreturn for that reason — it does + return, on exactly one path. *) + | Tast.Signal (Tast.Serror, id, c) -> + let p = addr f c in + let name = struct_name_of c.Tast.ty in + let nid, nn = string_bytes f.md name in + ins f "call void @flan_error(i32 %d, ptr %s, ptr %s, ptr %s, i64 %d)" + id p xfer_param nid nn; + guard f; + term f "unreachable"; + "zeroinitializer" | Tast.Handled (frames, body) -> emit_handled f frames body | Tast.RestartCase (clauses, body) -> emit_restart_case f e.Tast.ty clauses body (* §4's lookup, then the transfer itself: the frame that was found goes into @@ -1129,6 +1147,7 @@ declare void @flan_i64_to_bytes(i64, ptr) declare void @flan_handler_push(ptr) declare void @flan_handler_pop(ptr) declare void @flan_signal(i32, ptr, ptr) +declare void @flan_error(i32, ptr, ptr, ptr, i64) declare void @flan_restart_push(ptr) declare void @flan_restart_pop(ptr) declare ptr @flan_find_restart(i32) diff --git a/lib/load.ml b/lib/load.ml index 8e39528..b576e9b 100644 --- a/lib/load.ml +++ b/lib/load.ml @@ -174,7 +174,7 @@ let rec rename_expr owned alias bound (e : Ast.expr) : Ast.expr = Ast.Dotimes (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 c -> Ast.Signal (go c) + | Ast.Signal (k, c) -> Ast.Signal (k, go c) (* A restart name is not a top-level name — it is looked up on the restart stack, not in the environment — so an import does not qualify it. Only the bodies are rewritten. *) diff --git a/lib/parse.ml b/lib/parse.ml index 0f35d96..baa0065 100644 --- a/lib/parse.ml +++ b/lib/parse.ml @@ -193,10 +193,14 @@ and form f mk (head : Form.t) (args : Form.t list) : Ast.expr = (* (signal c) : Unit, always. When every applicable handler returns normally the signalling function simply carries on, and with no handler at all it is a no-op — spec-conditions.md §1 and §2. *) - | Sym "signal" -> + (* And (error c) : Never — §2's diverging variant. Same lookup, but a + handler that returns normally does not answer it: with nothing + transferring the program stops. *) + | Sym (("signal" | "error") as how) -> + let kind = if how = "signal" then Ast.Ssignal else Ast.Serror in (match args with - | [ c ] -> mk (Ast.Signal (expr c)) - | _ -> fail f "signal is (signal condition)") + | [ c ] -> mk (Ast.Signal (kind, expr c)) + | _ -> fail f "%s is (%s condition)" how how) (* (handler-bind [(Type [c] body ...) ...] body ...) @@ -266,10 +270,10 @@ and form f mk (head : Form.t) (args : Form.t list) : Ast.expr = through to Call, where they would parse and mean nothing. *) | Sym ("handler-case" (* Named in the spec and not written yet, so each says so rather than - falling through to Call and coming back as an unknown name: [error] - is §2's diverging signal, and [find-restart] and [compute-restarts] - are §4's two ways to look at the stack without committing. *) - | "error" | "find-restart" | "compute-restarts" + falling through to Call and coming back as an unknown name: + [find-restart] and [compute-restarts] are §4's two ways to look at + the restart stack without committing to one. *) + | "find-restart" | "compute-restarts" | "errdefer" | "with-allocator" | "loop" | "recur" | "defmacro" | "await" as name) -> fail f "%s is not implemented yet (see the build sequence in plan.org)" name diff --git a/lib/tast.ml b/lib/tast.ml index feb3af1..43b8d2e 100644 --- a/lib/tast.ml +++ b/lib/tast.ml @@ -67,7 +67,7 @@ and expr_kind = nothing here alters control flow. [HandlerBind] pushes one frame per clause, runs its body, and pops them; each clause was lifted into its own function by the checker, so what is left is the frame and the call. *) - | Signal of int * expr (* type id, the condition value *) + | Signal of sigkind * int * expr (* how, the type id, the condition *) | Handled of hframe list * expr list (* The transfer, spec-conditions.md §3–§6. [RestartCase] pushes one frame per clause, runs its body, and pops them; if a transfer arrives naming one of @@ -78,6 +78,10 @@ and expr_kind = | RestartCase of rclause list * expr | InvokeRestart of int * string * Loc.t (* name id, name, where *) +(* [Serror] is §2's diverging variant: the same lookup, type Never, and with + nothing transferring the program stops rather than carrying on. *) +and sigkind = Ssignal | Serror + and place = | Plocal of int | Pglobal of string diff --git a/runtime/flan_rt.c b/runtime/flan_rt.c index 78c00f5..01e8397 100644 --- a/runtime/flan_rt.c +++ b/runtime/flan_rt.c @@ -196,6 +196,23 @@ _Noreturn void flan_bounds_fail(const uint8_t *loc, int64_t loclen, rt_die(); } +/* §2's diverging variant: the same walk, but a handler that returns normally + * has not answered it. Only a transfer gets past here — the caller's guard + * sees the channel and forwards it — so with nothing transferring the program + * stops. In a dev build this is where the break loop will go; until it exists, + * stopping is all there is, and it says which condition it was. + * + * [flan_signal] is not reused with a flag because the two differ in what they + * do when the walk ends, which is the whole of §1 against §2. */ +void flan_error(uint32_t type_id, void *condition, void *xfer, + const uint8_t *name, int64_t namelen) { + flan_signal(type_id, condition, xfer); + if (*(void **)xfer != NULL) return; + fflush(stdout); + fprintf(stderr, "unhandled %.*s\n", (int)namelen, (const char *)name); + rt_die(); +} + /* Nothing on the restart stack offers the name. It is reported where the * invoke was, because that is the only place that knows what was asked for; * there is nowhere to resume, so there is nothing else to do. */ diff --git a/test/programs/error.flan b/test/programs/error.flan new file mode 100644 index 0000000..e10bcdc --- /dev/null +++ b/test/programs/error.flan @@ -0,0 +1,14 @@ +;;;; An unhandled (error c) — spec-conditions.md §2. +;;;; +;;;; Its argument is the whole of the difference from signal: a handler that +;;;; returns normally has not answered an error, so with nothing transferring +;;;; the program stops and says which condition it was. In a dev build this is +;;;; where the break loop will go. +(defstruct AssetMissing [id i32]) + +(defn main [] i32 + ;; A handler that returns normally. It runs — signal's lookup is the same — + ;; and it still does not answer the error. + (handler-bind [(AssetMissing [c] (print-line "handler ran"))] + (error (AssetMissing {:id 1}))) + 0) diff --git a/test/programs/restarts.flan b/test/programs/restarts.flan index 2d923d6..3a9f534 100644 --- a/test/programs/restarts.flan +++ b/test/programs/restarts.flan @@ -36,6 +36,16 @@ 1000) (use-placeholder [] 20))) +;;; §2's diverging variant. Same lookup, but a handler that returns normally +;;; has not answered it: only a transfer gets past, so the fall-through the +;;; signalling version needs does not exist here. +(defn strict [n i32] i32 + (restart-case + (do (error (AssetMissing {:id n})) + ;; unreachable — error is Never, so nothing after it runs + 0) + (use-placeholder [] -2))) + (defn main [] i32 ;; Nothing handles it, so signal is a no-op and the body's own value stands. (print-i64 (i64 (fetch 1))) (newline) ; 101 @@ -62,4 +72,9 @@ ;; The handler runs at the signal, which is inside the call the defer ;; belongs to, so its +100 lands before that defer's +1. (print-i64 log) (newline) ; 4 + 100 + 1 = 105 + + ;; error, answered by a transfer. Unanswered it stops the program, which is + ;; the trap case in the acceptance table rather than a line here. + (handler-bind [(AssetMissing [c] (invoke-restart 'use-placeholder))] + (print-i64 (i64 (strict 6))) (newline)) ; -2 0) diff --git a/test/test_acceptance.ml b/test/test_acceptance.ml index d806a62..3670c0c 100644 --- a/test/test_acceptance.ml +++ b/test/test_acceptance.ml @@ -123,10 +123,24 @@ let () = normally still transferring nothing. At -O0 as well, because the guard after every call is control flow the optimiser would otherwise launder; and as a dev build, where every one of those calls goes through a cell. *) - let restarts_out = "101\n1\n-1\n2\n7\n1010\n101\n105\n" in + let restarts_out = "101\n1\n-1\n2\n7\n1010\n101\n105\n-2\n" in outputs "restarts" "programs/restarts.flan" restarts_out; outputs ~opt:"-O0" "restarts, -O0" "programs/restarts.flan" restarts_out; outputs ~dev:true "restarts, dev" "programs/restarts.flan" restarts_out; + (* §2's other half, which cannot be an [outputs] case because it does not + exit 0: a handler runs, returns normally, and has still not answered the + error, so the program stops and names the condition. *) + let exe = compile "programs/error.flan" in + let code, text = run exe None in + if code <> 134 || not (contains text "handler ran") + || not (contains text "unhandled AssetMissing") + then begin + incr failures; + Printf.printf + "FAIL an unhandled error stops the program\n\ + \ got: %S (exit %d)\n wanted: exit 134, naming the condition\n" + text code + end; (* The raylib FFI, headless. GetColor and the enums need no window, so the whole boundary is exercised without a display: a struct returned through diff --git a/test/test_flan.ml b/test/test_flan.ml index 76277c4..3f9f334 100644 --- a/test/test_flan.ml +++ b/test/test_flan.ml @@ -635,6 +635,18 @@ let () = struct — an integer would have nothing to match against. *) rejects_check "signalling a non-struct" "(defn f [] (signal 1))" ~needle:"a condition is a struct"; + rejects_check "erroring with a non-struct" + "(defn f [] (error 1))" ~needle:"a condition is a struct"; + (* §2: error is Never, so it unifies with anything — including the position + where a value of some other type was expected. That is what makes it + usable as a restart-case body's fall-through. *) + accepts "error in value position" + "(defstruct C [id i32])\n\ + (defn f [] i32 (error (C {:id 1})))"; + (* And signal is not: it is Unit, whatever it finds. *) + rejects_check "signal in value position" + "(defstruct C [id i32])\n\ + (defn f [] i32 (signal (C {:id 1})))" ~needle:"expected i32"; (* A handler is lifted into a function of its own, so the establishing function's locals are not there. Capturing them is a closure, which is milestone 5 — until then it is refused for the reason it is refused for @@ -699,7 +711,6 @@ let () = rejects_check (name ^ " is still unimplemented") src ~needle:"not implemented yet") [ "handler-case", "(defn f [] (handler-case 1))"; - "error", "(defn f [] (error 1))"; "find-restart", "(defn f [] (find-restart 'skip))"; "compute-restarts", "(defn f [] (compute-restarts))" ];