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))" ];