From 1fb4b371250cea9eac06ead1ffa31b314313b415 Mon Sep 17 00:00:00 2001 From: Joseph Ferano Date: Fri, 25 Sep 2026 12:46:23 +0700 Subject: [PATCH] A restart that takes values can be taken from the break loop, which asks for one per parameter and stores them into the frame as an invoke-restart would --- emacs/flan-cnr.el | 39 +++++++++-- emacs/flan.el | 16 +++-- emacs/test-flan-cider.el | 22 ++++++ lib/dev.ml | 76 ++++++++++++++++++-- lib/session.ml | 130 +++++++++++++++++++++++++++++++++++ runtime/flan_rt.c | 13 ++++ test/programs/dev-break.flan | 6 +- test/test_dev.ml | 76 +++++++++++++++++++- vendor/agent/flan_agent.c | 46 +++++++++++++ 9 files changed, 408 insertions(+), 16 deletions(-) diff --git a/emacs/flan-cnr.el b/emacs/flan-cnr.el index 86391aca..78c1435f 100644 --- a/emacs/flan-cnr.el +++ b/emacs/flan-cnr.el @@ -385,6 +385,7 @@ indexing or the division itself, so it sits directly under the headline." (add-text-properties start (point) (list 'flan-cnr-restart name 'flan-cnr-restart-loc at + 'flan-cnr-params params 'flan-cnr-shadowed owner 'flan-cnr-kind kind 'flan-cnr-index i @@ -612,8 +613,10 @@ puts the likely culprit on top." "flan: restart %d is below the evaluation this break is inside, so a transfer to it has nowhere to land. Take one offered above it, or abandon the evaluation" (get-text-property (point) 'flan-cnr-index))) ((get-text-property (point) 'flan-cnr-restart) - (flan-cnr--invoke (get-text-property (point) 'flan-cnr-index) - (get-text-property (point) 'flan-cnr-restart))) + (let ((name (get-text-property (point) 'flan-cnr-restart))) + (flan-cnr--invoke (get-text-property (point) 'flan-cnr-index) name + (flan-cnr--read-args + name (get-text-property (point) 'flan-cnr-params))))) ((get-text-property (point) 'flan-cnr-hidden) (flan-cnr-toggle-prelude)) ((or (get-text-property (point) 'flan-cnr-frame) (get-text-property (point) 'flan-cnr-loc)) @@ -698,15 +701,41 @@ visits the source of the one it lands on." (when (eq next-error-last-buffer (current-buffer)) (setq next-error-last-buffer nil))) -(defun flan-cnr--invoke (index name) - "Take restart INDEX, named NAME. +(defun flan-cnr-param-types (params) + "The types in PARAMS, a restart's parameters as the program spells them. +PARAMS is a parenthesised list such as \"(i64 (Option string))\"; the result +is one string per type, or nil when it takes none or cannot be read." + (let ((form (and (stringp params) + (condition-case nil (car (read-from-string params)) + (error nil))))) + (when (listp form) + (mapcar (lambda (ty) (format "%S" ty)) form)))) + +(defun flan-cnr--read-args (name params) + "One value for each of restart NAME's PARAMS, read in the minibuffer. +Each is Flan source, checked by the daemon against its parameter's type, as an +`invoke-restart' passing it would have been. Nil when it takes none." + (let* ((types (flan-cnr-param-types params)) + (n (length types)) + (i 0)) + (mapcar (lambda (ty) + (setq i (1+ i)) + (read-string (if (= n 1) + (format "%s, a value of type %s: " name ty) + (format "%s, value %d of %d, of type %s: " name i n ty)))) + types))) + +(defun flan-cnr--invoke (index name &optional args) + "Take restart INDEX, named NAME, passing ARGS when it takes values. +ARGS is one Flan expression per parameter, as strings. By index, because the index is the identity — two frames can offer `retry' and only one of them is the one on this line. The name rides along as a receipt: the daemon checks it against what the program has at that index and refuses if the two have drifted apart, so a stale buffer cannot take a different restart than the one it showed." (let ((r (funcall flan-cnr-request-function - (list :op "restart-at" :index index :name name)))) + (append (list :op "restart-at" :index index :name name) + (and args (list :args args)))))) (if (equal (plist-get r :status) "ok") ;; Accepted, not resumed — the choice is validated against the stopped ;; stack and taken when that thread next comes round its loop. So the diff --git a/emacs/flan.el b/emacs/flan.el index 8fc6d3f5..094d7da8 100644 --- a/emacs/flan.el +++ b/emacs/flan.el @@ -378,6 +378,7 @@ open, above its prompt, which is where whoever is typing there is looking." ;; so requiring it here would be a cycle, and it is wanted only at the moment ;; a program stops. (autoload 'flan-cnr-show "flan-cnr" nil t) +(autoload 'flan-cnr--read-args "flan-cnr") ;;; Opening the break buffer when the program stops @@ -1161,12 +1162,14 @@ identity: two entries may read the same and mean different frames." i)) restarts))) -(defun flan-restart-at (index name) +(defun flan-restart-at (index name &optional args) "Resume the stopped program at the restart at position INDEX. NAME is sent with it and is not the lookup: the program checks it against the name it holds at that position and refuses if the two have drifted -apart, so a prompt cannot take a different restart than the one it showed." - (let ((r (flan--request (list :op "restart-at" :index index :name name)))) +apart, so a prompt cannot take a different restart than the one it showed. +ARGS is one Flan expression per parameter, for a restart that takes values." + (let ((r (flan--request (append (list :op "restart-at" :index index :name name) + (and args (list :args args)))))) (if (equal (plist-get r :status) "ok") (progn ;; Accepted, not resumed — see `flan-restart'. @@ -1285,7 +1288,12 @@ than being told so." ;; not something a person can type — but deriving the table wrongly ;; should say so rather than put nil on the wire as an index. ((null index) (user-error "flan: %s is not on the list" choice)) - (t (flan-restart-at index (nth index restarts))))))) + (t (let ((name (nth index restarts))) + ;; A restart that takes values asks for them, one per parameter. + (flan-restart-at + index name + (flan-cnr--read-args + name (plist-get (nth index (plist-get r :details)) :params))))))))) (defun flan-describe () "Report what the running program currently defines." diff --git a/emacs/test-flan-cider.el b/emacs/test-flan-cider.el index ffc7442a..4f0e379b 100644 --- a/emacs/test-flan-cider.el +++ b/emacs/test-flan-cider.el @@ -1097,6 +1097,28 @@ would be overwritten. Look again and re-do the edit") (test-flan--check "v on a restart visits its clause" (equal visited '("/src/files.flan:12:3" "restart use-value"))))) +;; A restart that takes values asks for one per parameter and sends them. +(test-flan--check "a restart's parameter types are read from their spelling" + (equal (flan-cnr-param-types "(i64 (Option string))") + '("i64" "(Option string)"))) +(let ((sent nil) (asked nil)) + (let ((flan-cnr-request-function + (lambda (form) (setq sent form) (list :status "ok" :note "accepted")))) + (cl-letf (((symbol-function 'read-string) + (lambda (prompt &rest _) (push prompt asked) "(+ 40 2)"))) + (with-current-buffer + (test-flan--cnr + (list :condition "ArithError" :restarts '("use-value") + :details '((:report "" :at nil :arity 1 :params "(i64)")))) + (goto-char (point-min)) + (search-forward " 0: ") + (save-window-excursion (flan-cnr-take))))) + (test-flan--check "taking a typed restart asks for its value by type" + (equal asked '("use-value, a value of type i64: "))) + (test-flan--check "and sends it as :args" + (equal sent '(:op "restart-at" :index 0 :name "use-value" + :args ("(+ 40 2)"))))) + ;; A stopped program with nothing on offer between the error and the top. It ;; is a real state — spec-conditions §2's `error' with no `restart-case' above ;; it — and it must not look like a bug in the buffer. diff --git a/lib/dev.ml b/lib/dev.ml index c2cb8a24..f4b45c5f 100644 --- a/lib/dev.ml +++ b/lib/dev.ml @@ -3209,7 +3209,55 @@ let accepted reply = | "ok abandon" -> Some true | _ -> None -let choose_at t ~index ~name = +(* A restart that takes values gets them before it is taken: [:args] is one + expression per parameter, which [Session.arm_restart] checks against the + parameter's own type and a thunk stores into the frame's buffer, as an + [invoke-restart] would have. Only then is the choice sent, and the agent + refuses a restart that takes values and was not given them. [Ok ""] when + nothing was given, without a round trip: most restarts take nothing, and + the agent says so when one that takes values was sent none. *) +let arm_restart t ~index ~name ~args = + if args = [] then Ok "" else + match restarts t with + | Error m -> Error ("the program refused to list its restarts: " ^ m) + | Ok (rows, _) -> + (match List.find_opt (fun r -> r.ridx = index) rows with + | None -> Error "there is no restart at that index; list the restarts again" + | Some r -> + (match name with + | Some n when not (String.equal n r.rname) -> + Error + ("that index is now " ^ r.rname + ^ ", not what you named; list the restarts again") + | _ -> + let given = List.length args in + if given <> r.rarity then + Error + (Printf.sprintf "restart %s takes %s, %d %s, and was given %d" + r.rname r.rsig r.rarity + (if r.rarity = 1 then "value" else "values") + given) + else + (match Session.restart_params t.session r.rsig with + | Error m -> Error m + | Ok params -> + (match stop_gen t with + | None | Some 0 -> + Error "the program resumed while this was being asked" + | Some gen -> + let held = Session.held t.session in + let refused m = Session.restore t.session held; Error m in + (match + Session.arm_restart t.session ~index ~params ~codes:args + with + | exception Loc.Error { Loc.dmsg = why; _ } -> refused why + | Error why -> refused why + | Ok (c, _) -> + (match run_render_thunk ~at_stop:gen t ~tag:"r" ~c with + | Error m -> refused m + | Ok v -> Ok v)))))) + +let choose_at ?(args = []) t ~index ~name = match liveness t with | Gone -> error gone | Parked when not (parked_break t) -> @@ -3229,6 +3277,9 @@ let choose_at t ~index ~name = | None -> false then error "a restart name cannot contain a control character" else + match arm_restart t ~index ~name ~args with + | Error m -> error m + | Ok given -> let verb = "restart-at " ^ string_of_int index ^ match name with Some n -> " " ^ n | None -> "" @@ -3236,9 +3287,12 @@ let choose_at t ~index ~name = match ask t verb with | reply when accepted reply <> None -> ok - [ ":index " ^ string_of_int index; - ":note " - ^ taken_note ~abandoned:(accepted reply = Some true) ] + ([ ":index " ^ string_of_int index; + ":note " + ^ taken_note ~abandoned:(accepted reply = Some true) ] + (* The values the clause will bind, as the program now holds them. *) + @ (if given = "" then [] + else [ ":values " ^ Wire.strings (String.split_on_char '\n' given) ])) | reply -> error (String.trim reply) | exception Unix.Unix_error (e, _, _) -> error (unreachable t e) @@ -4191,7 +4245,19 @@ let handle t req = showed. *) | Some "restart-at" -> (match Wire.int_field req "index" with - | Some index -> choose_at t ~index ~name:(Wire.string_field req "name") + | Some index -> + (* [:args] is one expression per parameter, for a restart that takes + values; see [arm_restart]. *) + let args = + match Wire.field req "args" with + | Some { Form.v = Form.List l; _ } -> + List.filter_map + (fun (f : Form.t) -> + match f.Form.v with Form.Str s -> Some s | _ -> None) + l + | _ -> [] + in + choose_at ~args t ~index ~name:(Wire.string_field req "name") | None -> error "restart-at needs :index") | Some "abort" -> abort t (* No fields: the only thing it could take is which function to run, and the diff --git a/lib/session.ml b/lib/session.ml index 00a4c241..d6aebe0f 100644 --- a/lib/session.ml +++ b/lib/session.ml @@ -1104,6 +1104,15 @@ let externs : Tast.extern list = { Tast.ename = "flan/dev-cond"; esym = "flan_agent_condition"; eparams = []; eret = Types.Ptr (Types.Int Types.U8); eloc = Loc.unknown }; + (* A typed restart's parameter, by the restart's index in the snapshot on + top and a byte offset into its buffer, and the flag that says the + buffer was written. See [arm_restart]. *) + { Tast.ename = "flan/dev-restart-arg"; esym = "flan_agent_restart_arg"; + eparams = [ Types.Int Types.I64; Types.Int Types.I64 ]; + eret = Types.Ptr (Types.Int Types.U8); eloc = Loc.unknown }; + { Tast.ename = "flan/dev-restart-arm"; esym = "flan_agent_restart_arm"; + eparams = [ Types.Int Types.I64 ]; eret = Types.Unit; + eloc = Loc.unknown }; (* The character beside a rendered byte. See [Render.pointers]. *) { Tast.ename = "flan/dev-emit-u8-char"; esym = "flan_dev_emit_u8_char"; eparams = [ Types.Int Types.I64 ]; eret = Types.Unit; @@ -2019,6 +2028,127 @@ let write_slot ?(origin = "") t ~frame ~(fn : Tast.fn) ~slot ~path ({ ir; x86 = t.x86; names = []; fns = []; installs = true }, where, Types.to_string shown.Tast.ty)))) +(* ── A typed restart, taken from the break loop ──────────────────────── *) + +(* The types a restart takes, read back from how its frame spells them — + [Check.restart_sig], a parenthesised list of [Types.to_string]s, which the + reader reads as one list of type forms. *) +let restart_params t sg = + match Reader.read_all ~file:"" sg with + | [ { Form.v = Form.List forms; _ } ] -> + (match List.map (fun f -> Check.resolve t.env (Parse.texpr f)) forms with + | tys -> Ok tys + | exception Loc.Error { Loc.dmsg = why; _ } -> + Error ("the restart takes " ^ sg ^ ", and " ^ why)) + | _ -> Error ("the restart's parameters are spelled " ^ sg ^ ", which is not a list of types") + +(* What [invoke-restart] does to a frame before it aims the channel, done by a + thunk instead: each value, checked against the parameter's own type, stored + at its offset in the buffer the frame owns, and the flag set that says the + buffer was written. The offsets are [Emit.lay_fields] over the parameter + types, which is how both backends lay out that buffer and how the invoker + and the clause agree on it. + + The values are expressions, checked in the session like any evaluated one, + so the refusal for a value that does not fit is the checker's own sentence. + The thunk renders the stored values back, which is what the program holds + now rather than what was asked for. *) +let arm_restart ?(origin = "") t ~index ~(params : Types.t list) + ~(codes : string list) : (change * string list, string) result = + let loc = Loc.unknown in + let md = X86.layout_ctx ~checks:false ~dev:true t.program in + let _, _, offs = Emit.lay_fields md params in + let mark = Check.instance_mark t.env in + let wanted = + List.map2 + (fun ty code -> + let form = + match Reader.read_all ~file:origin code with + | [ f ] -> f + | [] -> fail loc "a value for a %s is empty" (Types.to_string ty) + | _ :: f :: _ -> fail f.Form.loc "one value for each parameter" + in + (Some ty, Parse.with_imported t.macros (fun () -> Parse.expr form))) + params codes + in + let values, base, bnames = Check.expressions t.env wanted in + let fresh = Check.instances_since t.env mark in + let i64 n = + { Tast.e = Tast.Int (Int64.of_int n, Types.I64); ty = Types.Int Types.I64; loc } + in + let at ty off = + let raw = + { Tast.e = Tast.Call ("flan/dev-restart-arg", [ i64 index; i64 off ]); + ty = Types.Ptr (Types.Int Types.U8); loc } + in + { Tast.e = Tast.Prim (Tast.Cast (Types.Ptr ty), [ raw ]); ty = Types.Ptr ty; loc } + in + let stores = + List.map2 + (fun (ty, off) (v : Tast.expr) -> + { Tast.e = Tast.Set (Tast.Pderef (at ty off), v); ty = Types.Unit; loc }) + (List.combine params offs) values + in + let arm = + { Tast.e = Tast.Call ("flan/dev-restart-arm", [ i64 index ]); ty = Types.Unit; loc } + in + let extra = ref [] and nslots = ref (Array.length base) in + let c = + { Render.structs = t.program.Tast.structs; + datas = t.program.Tast.datas; + unions = t.program.Tast.unions; + enums = Hashtbl.fold (fun k v acc -> (k, v) :: acc) t.env.Check.enums []; + emit = dev_emitter; + ptrs = Some dev_pointers; + alloc = (fun ty -> + let i = !nslots in + incr nslots; + extra := ty :: !extra; + i) } + in + let bytes_of str = + { Tast.e = + Tast.Prim (Tast.Bytes, [ { Tast.e = Tast.Str str; ty = Types.String; loc } ]); + ty = Types.Slice (Types.Int Types.U8); loc } + in + let lit str = c.Render.emit.Render.ebytes (bytes_of str) in + match + List.concat + (List.map2 + (fun (ty, off) k -> + (if k > 0 then [ lit "\n" ] else []) + @ Render.render c 0 { Tast.e = Tast.Deref (at ty off); ty; loc }) + (List.combine params offs) + (List.init (List.length params) Fun.id)) + with + | exception Loc.Error { Loc.dmsg = why; _ } -> Error why + | shown -> + let nullary n = { Tast.e = Tast.Call (n, []); ty = Types.Unit; loc } in + t.thunks <- t.thunks + 1; + let tname = Printf.sprintf "restart/%d" t.thunks in + let thunk : Tast.fn = + { Tast.name = tname; params = []; ret = Types.Unit; + body = + stores @ [ arm ] @ (nullary "flan/dev-begin" :: shown) + @ [ nullary "flan/dev-end" ]; + fdefers = []; fenv = None; fparent = None; floc = loc; + slots = Array.append base (Array.of_list (List.rev !extra)); + snames = Array.append bnames (Array.make (List.length !extra) None) } + in + let program = + { t.program with + Tast.fns = t.program.Tast.fns @ fresh @ [ thunk ]; + externs = t.program.Tast.externs @ externs } + in + let ir = + redefinition t ~call:tname program + ~fns:(List.map (fun (f : Tast.fn) -> f.Tast.name) fresh @ [ tname ]) + in + t.program <- { t.program with Tast.fns = t.program.Tast.fns @ fresh }; + Ok + ({ ir; x86 = t.x86; names = []; fns = []; installs = true }, + List.map Types.to_string params) + (* ── The globals a stopped stack reaches ───────────────────────────── *) (* The other half of what a break loop can show, and in this language arguably diff --git a/runtime/flan_rt.c b/runtime/flan_rt.c index 81255dc8..ad146ef8 100644 --- a/runtime/flan_rt.c +++ b/runtime/flan_rt.c @@ -247,6 +247,19 @@ int32_t flan_restart_frame_hidden(const void *frame) { return (((const flan_restart *)frame)->flags & FLAN_RESTART_HIDDEN) != 0; } +/* The other way a typed restart's buffer is filled: an invoke-restart writes + * it and sets [armed], and a break loop taking one by hand has an evaluated + * thunk do the same two things through these, before it aims the channel. */ +void *flan_restart_frame_args(const void *frame) { + return ((const flan_restart *)frame)->args; +} + +int32_t flan_restart_frame_armed(const void *frame) { + return ((const flan_restart *)frame)->armed; +} + +void flan_restart_frame_arm(void *frame) { ((flan_restart *)frame)->armed = 1; } + /* Aim the transfer channel at a frame obtained earlier. The same store an * invoke-restart makes — this only spells it without a lookup, for a caller * that did its looking up when the stack was worth reading. */ diff --git a/test/programs/dev-break.flan b/test/programs/dev-break.flan index 706b5452..05e306f7 100644 --- a/test/programs/dev-break.flan +++ b/test/programs/dev-break.flan @@ -30,10 +30,14 @@ ;;; the prelude, and the break loop's render now reads them field by field, ;;; padding and all. A layout that drifted would show the op in `lhs'. ;;; The operands are parameters so nothing constant-folds the division away. +;;; And a restart that takes a value, which the break loop has to be given. +(defonce got i64) + (defn divide [a i64 b i64] i64 (restart-case (/ a b) - (use-zero [] 0))) + (use-zero [] 0) + (use-value [v i64] :report "Answer v instead" v))) (defn main [] i32 (agent/start "/tmp/flan-dev-break-fallback.sock") diff --git a/test/test_dev.ml b/test/test_dev.ml index a6c5b4b8..30c5efd2 100644 --- a/test/test_dev.ml +++ b/test/test_dev.ml @@ -977,7 +977,7 @@ let () = if String.length floc = 0 || floc.[0] <> '/' then fail "a frame's location is not absolute: %s" floc; (* And an outer frame is at the call it is in, not at its defn. *) - if not (contains_sub mloc "dev-break.flan:40:10") then + if not (contains_sub mloc "dev-break.flan:44:10") then fail "main's frame is at %s, not at its call to fetch" mloc | fs -> fail "backtrace of a stopped program: %s" @@ -1421,6 +1421,80 @@ let () = fail "the program never resumed past a division by zero" end); + (* ── A restart that takes a value, taken from the break loop ──────── + [use-value] takes an i64. The break names what it takes; taking it + without a value is refused with that; a value of the wrong type is + refused by the checker, in its own words; and a value that fits is + stored into the frame's buffer by a thunk and the clause binds it — + so [got] is 42 afterwards, a number only the typed value can make. *) + (let r = + ask + "(:op \"eval-expr\" :code \"(set got (divide (i64 5) (i64 0)))\" \ + :file \"/tmp/buf.flan\")" + in + if status r <> "error" then + fail "a division by zero under use-value answered instead of stopping" + else if not (await (fun () -> stopped (ask "(:op \"describe\")"))) then + fail "a division by zero under use-value never stopped" + else begin + let r = ask "(:op \"break\")" in + let names = + match Wire.field r "restarts" with + | Some { Form.v = Form.List l; _ } -> + List.filter_map + (fun (n : Form.t) -> + match n.Form.v with Form.Str x -> Some x | _ -> None) + l + | _ -> [] + in + let rec index_of i = function + | [] -> -1 + | n :: rest -> if n = "use-value" then i else index_of (i + 1) rest + in + let i = index_of 0 names in + if i < 0 then fail "use-value is not on offer: %s" (String.concat ", " names) + else begin + (match Wire.field r "details" with + | Some { Form.v = Form.List ds; _ } when List.length ds > i -> + let d = List.nth ds i in + if Wire.string_field d "params" <> Some "(i64)" then + fail "use-value's parameters are not on the wire as (i64)" + | _ -> fail "break carried no details for use-value"); + let take args = + ask + (Printf.sprintf + "(:op \"restart-at\" :index %d :name \"use-value\"%s)" i + (if args = "" then "" else " :args " ^ args)) + in + let said r = Option.value ~default:"" (Wire.string_field r "message") in + let r = take "" in + if status r <> "error" || not (contains_sub (said r) "takes (i64)") then + fail "use-value taken with no value: %s" (said r); + let r = take "(\"1\" \"2\")" in + if status r <> "error" || not (contains_sub (said r) "was given 2") then + fail "use-value taken with two values: %s" (said r); + let r = take "(\"\\\"text\\\"\")" in + if status r <> "error" || not (contains_sub (said r) "i64") then + fail "use-value taken with a string: %s" (said r); + let r = take "(\"(+ 40 2)\")" in + if status r <> "ok" then fail "use-value taken with 42: %s" (said r) + else begin + (match Wire.field r "values" with + | Some { Form.v = Form.List [ { Form.v = Form.Str "42"; _ } ]; _ } -> () + | _ -> fail "the reply does not show the value the clause binds"); + if not (await (fun () -> not (stopped (ask "(:op \"describe\")")))) + then fail "the program never resumed through use-value" + else + let r = + ask "(:op \"eval-expr\" :code \"got\" :file \"/tmp/buf.flan\")" + in + if Wire.string_field r "value" <> Some "42" then + fail "use-value's clause bound %s, not 42" + (Option.value ~default:(said r) (Wire.string_field r "value")) + end + end + end); + (* ...and the other way out. Every check above is of an abort being *refused*; the accepted path is the one that must not be left as code that has never run, because it is the one that ends a program. Break diff --git a/vendor/agent/flan_agent.c b/vendor/agent/flan_agent.c index 520b308d..e53bba80 100644 --- a/vendor/agent/flan_agent.c +++ b/vendor/agent/flan_agent.c @@ -348,6 +348,9 @@ extern const uint8_t *flan_restart_frame_report(const void *frame, int64_t *len) extern const uint8_t *flan_restart_frame_sig(const void *frame, int64_t *len); extern int32_t flan_restart_frame_arity(const void *frame); extern int32_t flan_restart_frame_hidden(const void *frame); +extern void *flan_restart_frame_args(const void *frame); +extern int32_t flan_restart_frame_armed(const void *frame); +extern void flan_restart_frame_arm(void *frame); extern void flan_restart_pop_c(void *frame); /* -- How far down a transfer can actually land ----------------------- */ @@ -620,6 +623,37 @@ static snapshot *snap_top(void) { return d <= 0 ? NULL : &snaps[d - 1]; } +/* Where a restart's parameter lives, for the thunk the daemon builds to fill + * one in before taking it: restart [i] of the snapshot on top, [off] bytes + * into its buffer. The daemon lays the buffer out the way both backends do + * (Emit.lay_fields over the clause's types), so [off] is its to compute. + * NULL for an index this snapshot does not have or a restart that takes + * nothing, and the thunk is built only for one that takes something. */ +void *flan_agent_restart_arg(int64_t i, int64_t off) { + snapshot *s = snap_top(); + void *args; + if (s == NULL || i < 0 || i >= s->n || off < 0) return NULL; + if (s->arity[i] <= 0) return NULL; + args = flan_restart_frame_args(s->frame[i]); + return args == NULL ? NULL : (char *)args + off; +} + +/* And the flag an invoke-restart sets beside the values: the clause refuses a + * buffer nobody wrote, and this says somebody did. */ +void flan_agent_restart_arm(int64_t i) { + snapshot *s = snap_top(); + if (s == NULL || i < 0 || i >= s->n || s->arity[i] <= 0) return; + flan_restart_frame_arm(s->frame[i]); +} + +/* A restart that takes values and has not been given them is refused here, + * where the reason can be said, rather than taken and refused at the clause, + * which is a trap the program cannot come back from. */ +static int unarmed(snapshot *s, int32_t i) { + return s->arity[i] > 0 && !flan_restart_frame_armed(s->frame[i]); +} + + /* One string into the snapshot's text pool, with its offset and length. A * string that does not fit is recorded as empty rather than cut: an empty * report or location is a state the reader handles, and half of one is not. */ @@ -1287,6 +1321,16 @@ static const char *abi_mismatch(const char *err) { * It is held across the [dlopen], which is milliseconds. That is what the * accept loop already did to itself by serving connections inline, so no * caller waits longer than it did before. The game thread never takes it. */ +/* [unarmed]'s refusal, with what the restart takes. */ +static void reply_unarmed(sink *o, snapshot *s, int32_t i) { + reply(o, "err restart "); + reply(o, s->names + s->off[i]); + reply(o, " takes "); + emit(o, s->text + s->sigoff[i], (size_t)s->siglen[i]); + reply(o, "; give it one value of each type, which the break buffer asks for " + "when it is taken\n"); +} + static pthread_mutex_t request_lock = PTHREAD_MUTEX_INITIALIZER; static void handle_line(char *line, sink *o) { @@ -1541,6 +1585,7 @@ static void handle_line(char *line, sink *o) { "above it, or abort\n"); return; } + if (unarmed(s, (int32_t)idx)) { reply_unarmed(o, s, (int32_t)idx); return; } atomic_store(&chosen_index, (int)idx); atomic_store(&chosen_gen, s->gen); /* Published last, so the game thread never reads an index that is about @@ -1589,6 +1634,7 @@ static void handle_line(char *line, sink *o) { "above it, or abort\n"); return; } + if (unarmed(s, at)) { reply_unarmed(o, s, at); return; } atomic_store(&chosen_index, at); atomic_store(&chosen_gen, s->gen); atomic_store(&chosen_ready, 1);