A restart frame carries where its clause is written, its :report sentence and whether a handler-case made it up, and the break loop shows the first two and hides the third

emacs/flan-cnr.el

@@ -294,6 +294,7 @@ indexing or the division itself, so it sits directly under the headline."
 (defun flan-cnr--insert-restarts (state)
   (flan-cnr--section "Restarts (innermost first) — RET or a digit takes one:")
   (let* ((names (plist-get state :restarts))
+         (details (plist-get state :details))
          (rows (flan-cnr-annotate-restarts names
                                            (plist-get state :unreachable)
                                            (plist-get state :abandon)
@@ -306,6 +307,12 @@ indexing or the division itself, so it sits directly under the headline."
         (dolist (r rows)
           (let* ((i (nth 0 r)) (name (nth 1 r)) (owner (nth 2 r))
                  (kind (nth 3 r))
+                 (d (nth i details))
+                 (report (let ((x (plist-get d :report)))
+                           (and (stringp x) (not (string-empty-p x)) x)))
+                 (params (and (> (or (plist-get d :arity) 0) 0)
+                              (plist-get d :params)))
+                 (at (plist-get d :at))
                  (start (point)))
             ;; SBCL's bracket: it is there when the name reaches this frame and
             ;; gone when it does not.  A shadowed entry is still takeable — the
@@ -325,6 +332,10 @@ indexing or the division itself, so it sits directly under the headline."
                             (if (or owner (memq kind '(unreachable trapped)))
                                 " " "]")))
             (insert (make-string (- w (length name)) ?\s))
+            ;; What it takes, when it takes anything: taking it asks for one
+            ;; value of each of these types.
+            (when params
+              (insert (propertize params 'face 'font-lock-type-face) "  "))
             (cond
              ;; What the reader wants nine times in ten after a C-x C-e went
              ;; wrong, so it says what it does *and* what it does not: nothing
@@ -352,9 +363,19 @@ indexing or the division itself, so it sits directly under the headline."
               (insert (propertize
                        (format "same name as %d; taken by its number" owner)
                        'face 'shadow))))
+            ;; The clause's own sentence, SBCL's `:report'; after a refusal's
+            ;; words when there are any, because those say whether it can be
+            ;; taken at all.  The name is the report when the clause wrote
+            ;; none, as in SBCL, so nothing is added then.
+            (when (and report (not (eq kind 'abandon)))
+              (when (or owner (memq kind '(unreachable trapped))) (insert "  "))
+              (insert report))
+            (when at
+              (insert (propertize (format "  (%s)" at) 'face 'shadow)))
             (insert "\n")
             (add-text-properties start (point)
                                  (list 'flan-cnr-restart name
+                                       'flan-cnr-restart-loc at
                                        'flan-cnr-shadowed owner
                                        'flan-cnr-kind kind
                                        'flan-cnr-index i
@@ -604,13 +625,21 @@ puts the likely culprit on top."
 A frame's location is where its function is written; the stop's is the
 expression that stopped."
   (interactive)
-  (let ((loc (get-text-property (point) 'flan-cnr-loc)))
+  (let ((loc (get-text-property (point) 'flan-cnr-loc))
-    (unless loc
+        (rloc (get-text-property (point) 'flan-cnr-restart-loc)))
+    (cond
+     (loc (flan-visit-loc loc (flan-cnr--loc-subject (point))))
+     ;; A restart's clause, which `v' reaches and RET does not: RET takes it.
+     (rloc (flan-visit-loc rloc (format "restart %s"
+                                        (get-text-property (point)
+                                                           'flan-cnr-restart))))
+     ((get-text-property (point) 'flan-cnr-restart)
+      (user-error "flan: this restart was established from C and has no source"))
+     (t
       (user-error
        (if (get-text-property (point) 'flan-cnr-frame)
            "flan: this frame has no location; the program did not report one"
-         "flan: point is not on a frame or on the stop")))
+         "flan: point is not on a frame, a restart or the stop"))))))
-    (flan-visit-loc loc (flan-cnr--loc-subject (point)))))
 
 (defun flan-cnr-toggle-prelude ()
   "Show or hide the prelude's frames in the stack section."
@@ -873,6 +902,10 @@ Takes the layout rather than fetching it, so this stays a function from data to
 data and the fixture-driven tests can drive it without a socket."
   (list :condition (plist-get reply :condition)
         :restarts (plist-get reply :restarts)
+        ;; Beside each name and in the same order: a plist of its `:report'
+        ;; sentence, where the clause is written (`:at'), and the types it
+        ;; takes (`:arity', `:params').
+        :details (plist-get reply :details)
         ;; The two facts about that list nothing here could work out.  A
         ;; position is on `:unreachable' when the program will refuse it, and
         ;; `:abandon' is the position that drops the evaluation this break is

emacs/test-flan-cider.el

@@ -1044,6 +1044,37 @@ would be overwritten. Look again and re-do the edit")
   (test-flan--check "and the keys are shown" (and (string-match-p "TAB fold" text)
                                                     (string-match-p "P prelude frames" text))))
 
+;; What a restart says beside its name: its `:report' sentence, the types it
+;; takes, and where its clause is written — and `v' on the row visits that.
+(let* ((buf (test-flan--cnr
+             (list :condition "FileError"
+                   :restarts '("retry" "use-value" "plain")
+                   :details '((:report "Try the file operation again"
+                               :at "/src/files.flan:12:3" :arity 0 :params "()")
+                              (:report "Try again with another path"
+                               :at "/src/files.flan:12:3" :arity 1
+                               :params "(string)")
+                              (:report "" :at nil :arity 0 :params "()")))))
+       (text (with-current-buffer buf (buffer-string))))
+  (test-flan--check "a restart's report is beside its name"
+                    (string-match-p "\\[retry\\] +Try the file operation again" text))
+  (test-flan--check "and where its clause is written"
+                    (string-match-p "again  (/src/files.flan:12:3)" text))
+  (test-flan--check "a restart taking values shows their types"
+                    (string-match-p "\\[use-value\\] +(string)  Try again with another path"
+                                    text))
+  (test-flan--check "one with no report and no source shows its name alone"
+                    (string-match-p " 2: \\[plain\\] *\n" text))
+  (let ((visited nil))
+    (cl-letf (((symbol-function 'flan-visit-loc)
+               (lambda (loc subject) (setq visited (list loc subject)))))
+      (with-current-buffer buf
+        (goto-char (point-min))
+        (search-forward " 1: ")
+        (flan-cnr-visit)))
+    (test-flan--check "v on a restart visits its clause"
+                      (equal visited '("/src/files.flan:12:3" "restart use-value")))))
+
 ;; 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.

lib/ast.ml

@@ -167,9 +167,14 @@ and hclause = { hty : texpr; hname : string; hbody : expr list; hloc : Loc.t }
 (* [rparams] are §3's inline annotations, the same name/type pairs a [defn]
    takes. They are bound in the clause body and filled in by whatever invoked
    the restart, which is why their count and types are checked at run time
-   (§3): a restart is found by name on a dynamic stack. *)
+   (§3): a restart is found by name on a dynamic stack.
+
+   [rreport] is the sentence a break loop shows beside the name, written
+   [(name [p T] :report "..." body ...)] — Common Lisp's [:report], string
+   form only. *)
 and rclause =
-  { rname : string; rparams : field list; rbody : expr list; rloc : Loc.t }
+  { rname : string; rparams : field list; rreport : string option;
+    rbody : expr list; rloc : Loc.t }
 
 (* Inline name/type pairs, as in [defn], [let] and [defstruct]. Here because a
    restart clause's parameters are one, and a clause is part of an expression. *)

lib/check.ml

@@ -4391,7 +4391,8 @@ and check_restart_case ctx ?want loc body clauses =
    been checked. Separate from the form above because [handler-case] supplies
    its own body — a [handler-bind] it built — and has to name itself in the
    refusals rather than naming the machinery it is made of. *)
-and restart_clauses ctx ?want ~what loc (tbody : Tast.expr) clauses =
+and restart_clauses ctx ?want ?(hidden = false) ~what loc (tbody : Tast.expr)
+    clauses =
   (* 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
      which case the first clause that does decides. *)
@@ -4445,7 +4446,10 @@ and restart_clauses ctx ?want ~what loc (tbody : Tast.expr) clauses =
          if !ty = None && b.Tast.ty <> Types.Never then ty := Some b.Tast.ty;
          let sg = restart_sig (List.map snd params) in
          { Tast.rname_id = type_id c.Ast.rname; rname = c.Ast.rname;
-           rparams = params; rsig = sg; rsig_id = type_id sg; rbody = [ b ] })
+           rparams = params; rsig = sg; rsig_id = type_id sg; rbody = [ b ];
+           rloc = c.Ast.rloc;
+           rreport = Option.value c.Ast.rreport ~default:"";
+           rhidden = hidden })
       clauses
   in
   let ty = match !ty with Some t -> t | None -> Types.Never in
@@ -4558,11 +4562,13 @@ and check_handler_case ctx ?want loc body clauses =
            rparams =
              [ { Ast.fname = c.Ast.hname; fty = c.Ast.hty;
                  floc = c.Ast.hloc } ];
-           rbody = c.Ast.hbody; rloc = c.Ast.hloc })
+           rreport = None; rbody = c.Ast.hbody; rloc = c.Ast.hloc })
       clauses rnames
   in
   let tbody = check_handler_bind ctx ?want ~what loc handlers [ body ] in
-  restart_clauses ctx ?want ~what loc tbody landings
+  (* Hidden: the landing is reached only through the handler above, and a break
+     loop under this form would otherwise list it as if someone could mean it. *)
+  restart_clauses ctx ?want ~hidden:true ~what loc tbody landings
 
 (* The forms of a [defer], checked in place and hung on the function. What is
    left where it stands is one store: this defer's number into the counter
@@ -6630,7 +6636,8 @@ and alloc_guard ctx loc (attempt : Tast.expr) =
        an [invoke-restart] cannot tell them apart. *)
     let sg = restart_sig [] in
     { Tast.rname_id = type_id "retry"; rname = "retry"; rparams = [];
-      rsig = sg; rsig_id = type_id sg; rbody = [ unit_at loc ] }
+      rsig = sg; rsig_id = type_id sg; rbody = [ unit_at loc ];
+      rloc = loc; rreport = "Try the allocation again"; rhidden = false }
   in
   let body =
     mk loc Types.Unit (Tast.RestartCase ([ clause ], attempt_then_signal))
@@ -6696,16 +6703,18 @@ and file_guard ctx loc ~path_slot ~op mk_steps =
                         mk loc Types.Bool (Tast.Prim (Tast.Ne, [ attempt; i8 0L ]))));
            mk loc Types.Unit (Tast.If (notok (), signal (), unit_at loc)) ])
   in
-  let clause name params =
+  let clause name report params =
     let sg = restart_sig (List.map snd params) in
     { Tast.rname_id = type_id name; rname = name; rparams = params;
-      rsig = sg; rsig_id = type_id sg; rbody = [ unit_at loc ] }
+      rsig = sg; rsig_id = type_id sg; rbody = [ unit_at loc ];
+      rloc = loc; rreport = report; rhidden = false }
   in
   let body =
     mk loc Types.Unit
       (Tast.RestartCase
-         ([ clause "retry" [];
+         ([ clause "retry" "Try the file operation again" [];
-            clause "use-value" [ (path_slot, Types.String) ] ],
+            clause "use-value" "Try again with another path"
+              [ (path_slot, Types.String) ] ],
           mk loc Types.Unit (Tast.Do (mk_steps try_))))
   in
   mk loc Types.Unit

lib/dev.ml

@@ -378,6 +378,15 @@ type restart_flag =
 
 let takeable = function Takeable | Boundary -> true | Below -> false
 
+(* One row. After the name, tab-separated, the agent sends what a listing
+   shows beside it: how many parameters the clause takes, how their types are
+   spelled, where it is written ([None] for a frame pushed from C) and its
+   :report sentence, [""] when it wrote none. A row without them — an older
+   agent — reads as a clause of no parameters with nothing to show. *)
+type restart_row =
+  { ridx : int; rflag : restart_flag; rname : string; rarity : int;
+    rsig : string; rat : string option; rreport : string }
+
 (* The rows, and whether the break they came from was taken by a trap. *)
 let restarts t =
   match ask t "restarts" with
@@ -398,17 +407,31 @@ let restarts t =
              let rest = String.sub line (i + 1) (String.length line - i - 1) in
              if String.length rest < 2 then None
              else
+               let tail = String.sub rest 2 (String.length rest - 2) in
+               let name, arity, sg, at, report =
+                 match String.split_on_char '\t' tail with
+                 | name :: arity :: sg :: at :: report ->
+                   ( name,
+                     Option.value (int_of_string_opt arity) ~default:0,
+                     sg,
+                     (if at = "-" || at = "" then None else Some at),
+                     String.concat " " report )
+                 | name :: _ -> (name, 0, "()", None, "")
+                 | [] -> (tail, 0, "()", None, "")
+               in
                Some
-                 ( idx,
+                 { ridx = idx;
                    (* An unknown character is read as [Below] rather than as
                       takeable: a flag this end does not recognise is a program
                       newer than the daemon, and refusing a restart that could
                       have been taken is the survivable half of that. *)
-                   (match rest.[0] with
+                   rflag =
-                    | '+' -> Takeable
+                     (match rest.[0] with
-                    | '*' -> Boundary
+                      | '+' -> Takeable
-                    | _ -> Below),
+                      | '*' -> Boundary
-                   String.sub rest 2 (String.length rest - 2) ))
+                      | _ -> Below);
+                   rname = name; rarity = arity; rsig = sg; rat = at;
+                   rreport = report })
       in
       Ok
         ( List.filter_map parse
@@ -1797,11 +1820,26 @@ let break t =
             rather than filtered, because a client that quietly dropped them
             would leave someone asking where their restart went. *)
          ok
-           ([ ":restarts " ^ Wire.strings (List.map (fun (_, _, n) -> n) rs);
+           ([ ":restarts " ^ Wire.strings (List.map (fun r -> r.rname) rs);
+              (* Beside each name and in the same order: its :report sentence,
+                 where the clause is written, and the types it takes. *)
+              ":details "
+              ^ Wire.list
+                  (List.map
+                     (fun r ->
+                        Wire.list
+                          [ ":report"; Wire.quote r.rreport;
+                            ":at";
+                            (match r.rat with
+                             | Some a -> Wire.quote a
+                             | None -> "nil");
+                            ":arity"; string_of_int r.rarity;
+                            ":params"; Wire.quote r.rsig ])
+                     rs);
               ":unreachable "
               ^ Wire.ints
                   (List.filter_map
-                     (fun (i, f, _) -> if takeable f then None else Some i)
+                     (fun r -> if takeable r.rflag then None else Some r.ridx)
                      rs);
               (* Which position abandons the evaluation this break is inside,
                  and [nil] when it is not inside one. A position and not the
@@ -1811,8 +1849,8 @@ let break t =
                  the name would offer the program's restart as the way out of
                  an evaluation. *)
               ":abandon "
-              ^ (match List.find_opt (fun (_, f, _) -> f = Boundary) rs with
+              ^ (match List.find_opt (fun r -> r.rflag = Boundary) rs with
-                 | Some (i, _, _) -> string_of_int i
+                 | Some r -> string_of_int r.ridx
                  | None -> "nil");
               (* Why those positions are refused, which is not the same
                  question as which they are. A break taken by a trap has no

lib/emit.ml

@@ -163,15 +163,20 @@ module Rt = struct
     { sname = "handler";
       fields = [ "prev", Ptr; "type", I32; "fn", Ptr; "env", Ptr ] }
 
-  (* A restart frame. The first four fields are what the runtime's own
+  (* A restart frame, field for field the runtime's [flan_restart]. The first
-     [flan_restart] declares and their offsets do not move; the rest are §3's
+     four are the lookup; [args] to [siglen] are §3's parameter passing,
-     parameter passing, described where the type is written into the header. *)
+     described where the type is written into the header; the last five are
+     for a break loop and nothing reads them on the way to a transfer: where
+     the clause is written, its [:report] sentence, and [flags], whose bit 0
+     says the checker made the clause up (a [handler-case]'s landing). *)
   let restart =
     { sname = "restart";
       fields =
         [ "prev", Ptr; "name_id", I32; "name", Ptr; "namelen", I64;
           "args", Ptr; "arity", I32; "sig_id", I32; "armed", I32;
-          "sig", Ptr; "siglen", I64 ] }
+          "sig", Ptr; "siglen", I64;
+          "loc", Ptr; "loclen", I64; "report", Ptr; "reportlen", I64;
+          "flags", I32 ] }
 
   (* The static description of a function, and the shadow-stack frame that
      points at one. Dev builds only (runtime/flan_dev.c). *)
@@ -2922,6 +2927,14 @@ and emit_restart_case f ty clauses body =
          let gid, glen = string_bytes f.md c.Tast.rsig in
          ins f "store ptr %s, ptr %s" gid (restart_field f slot "sig");
          ins f "store i64 %d, ptr %s" glen (restart_field f slot "siglen");
+         let lid, llen = string_bytes f.md (Loc.to_string c.Tast.rloc) in
+         ins f "store ptr %s, ptr %s" lid (restart_field f slot "loc");
+         ins f "store i64 %d, ptr %s" llen (restart_field f slot "loclen");
+         let rid, rlen = string_bytes f.md c.Tast.rreport in
+         ins f "store ptr %s, ptr %s" rid (restart_field f slot "report");
+         ins f "store i64 %d, ptr %s" rlen (restart_field f slot "reportlen");
+         ins f "store i32 %d, ptr %s" (if c.Tast.rhidden then 1 else 0)
+           (restart_field f slot "flags");
          let args =
            if c.Tast.rparams = [] then None
            else begin
@@ -4298,8 +4311,9 @@ let header = {|; Generated by flan. The layout is C's: no object headers anywher
 ; restart-case, because the invoker's frame is gone by the time a clause runs —
 ; how many there are, the hash of how they are spelled, whether anything has
 ; filled the buffer in, and that spelling itself for the message when the two
-; ends disagree. The first four fields are what the runtime's own
+; ends disagree. Then, for a break loop only, where the clause is written, its
-; [flan_restart] declares and their offsets do not move.
+; :report sentence, and flags (bit 0: a handler-case's own landing). The C
+; [flan_restart] declares every one of these, in this order.
 |} ^ Rt.ll_type Rt.restart ^ {|
 ; A shadow-stack frame and the static description of the function that pushed
 ; it (runtime/flan_dev.c). Dev builds only: [emit_fn] pushes one on entry and

lib/parse.ml

@@ -675,11 +675,28 @@ and form f mk (head : Form.t) (args : Form.t list) : Ast.expr =
     in
     let clause (c : Form.t) =
       match c.Form.v with
+      (* [:report "..."] after the parameters is what a break loop shows
+         beside the name — SBCL's placement, and its string form only. *)
+      | Form.List
+          ({ v = Form.Sym n; _ } :: { v = Form.Vec ps; _ }
+           :: { v = Form.Kw "report"; _ } :: { v = Form.Str r; _ } :: cbody)
+        when cbody <> [] ->
+        { Ast.rname = n; rparams = fields c ps; rreport = Some r;
+          rbody = List.map expr cbody; rloc = c.Form.loc }
+      | Form.List
+          ({ v = Form.Sym _; _ } :: { v = Form.Vec _; _ }
+           :: ({ v = Form.Kw "report"; _ } as k) :: _) ->
+        fail k
+          "a restart's :report is a string followed by the clause body, as in \
+           (retry [] :report \"Try again\" (do))"
       | Form.List ({ v = Form.Sym n; _ } :: { v = Form.Vec ps; _ } :: cbody)
         when cbody <> [] ->
-        { Ast.rname = n; rparams = fields c ps;
+        { Ast.rname = n; rparams = fields c ps; rreport = None;
           rbody = List.map expr cbody; rloc = c.Form.loc }
-      | _ -> fail c "a restart-case clause is (name [p T] body ...)"
+      | _ ->
+        fail c
+          "a restart-case clause is (name [p T] body ...), or (name [p T] \
+           :report \"...\" body ...)"
     in
     mk (Ast.RestartCase (expr body, List.map clause clauses))
 

lib/tast.ml

@@ -300,10 +300,16 @@ and hframe = { htype : int; hfn : string; henv : expr option }
    [rparams] are the slots §3's parameters are bound to, in order, with their
    types; the invoker stores into a buffer this frame owns and the clause loads
    them from it. [rsig] is how those types are spelled and [rsig_id] its hash:
-   what the two ends compare, since neither can see the other. *)
+   what the two ends compare, since neither can see the other.
+
+   [rloc], [rreport] and [rhidden] are for a break loop and nothing else: where
+   the clause is written, the sentence it shows beside its name ([""] when it
+   wrote none), and whether it is one the checker made up — a [handler-case]'s
+   own landing, which no one at a break loop could mean to take. *)
 and rclause =
   { rname_id : int; rname : string; rparams : (int * Types.t) list;
-    rsig : string; rsig_id : int; rbody : expr list }
+    rsig : string; rsig_id : int; rbody : expr list;
+    rloc : Loc.t; rreport : string; rhidden : bool }
 
 (* [binds] are the slots the pattern's fields are bound to, in field order. *)
 and arm = { acase : string option; binds : int list; abody : expr list }

lib/x86.ml

@@ -2118,6 +2118,14 @@ and emit_restart_case f clauses body dst t =
        str_args f ~preg:rax ~nreg:rcx c.Tast.rsig;
        store_int f.b ~src:rax ~mm:(Frame (slot + r_sig)) ~size:8;
        store_int f.b ~src:rcx ~mm:(Frame (slot + r_siglen)) ~size:8;
+       str_args f ~preg:rax ~nreg:rcx (Loc.to_string c.Tast.rloc);
+       store_int f.b ~src:rax ~mm:(Frame (slot + r_field "loc")) ~size:8;
+       store_int f.b ~src:rcx ~mm:(Frame (slot + r_field "loclen")) ~size:8;
+       str_args f ~preg:rax ~nreg:rcx c.Tast.rreport;
+       store_int f.b ~src:rax ~mm:(Frame (slot + r_field "report")) ~size:8;
+       store_int f.b ~src:rcx ~mm:(Frame (slot + r_field "reportlen")) ~size:8;
+       imm_into f ~reg:rax (if c.Tast.rhidden then 1L else 0L);
+       store_int f.b ~src:rax ~mm:(Frame (slot + r_field "flags")) ~size:4;
        (match args with
         | None -> ()
         | Some (buf, _) ->

runtime/flan_rt.c

@@ -87,6 +87,8 @@ void flan_signal(uint32_t type_id, void *condition, void *xfer) {
  * against every re-entry of the same restart-case. §4's "innermost frame
  * offering the name" is then just the order of the walk. */
 
+/* Field for field Emit.Rt.restart, which both backends lay out from one list;
+ * a field added there is added here, in the same place. */
 typedef struct flan_restart {
   struct flan_restart *prev;
   uint32_t             name_id;
@@ -95,8 +97,29 @@ typedef struct flan_restart {
    * and nothing at run time can turn a hash back into a name. */
   const uint8_t       *name;
   int64_t              namelen;
+  /* §3's parameters: the buffer the clause reads them from, how many, the
+   * hash of their spelling, whether an invoke filled the buffer in, and the
+   * spelling itself. */
+  void                *args;
+  int32_t              arity;
+  uint32_t             sig_id;
+  int32_t              armed;
+  const uint8_t       *sig;
+  int64_t              siglen;
+  /* For a break loop only: where the clause is written, its :report sentence
+   * (empty when it wrote none), and [flags]. */
+  const uint8_t       *loc;
+  int64_t              loclen;
+  const uint8_t       *report;
+  int64_t              reportlen;
+  int32_t              flags;
 } flan_restart;
 
+/* A clause the checker made up rather than one anybody wrote: a
+ * handler-case's landing, which is reached through its own handler and which
+ * a break loop does not offer. */
+#define FLAN_RESTART_HIDDEN 1
+
 static flan_restart *restarts;
 
 /* The frames a C caller pushes; see [flan_restart_push_c] below, which is
@@ -152,6 +175,35 @@ void *flan_restart_frame(int32_t i) {
   return NULL;
 }
 
+/* What a break loop shows about a frame [flan_restart_frame] handed out, read
+ * off the frame rather than walked for, so a snapshot taking all of them is one
+ * pass. The strings are the frame's own and live as long as the program. */
+const uint8_t *flan_restart_frame_loc(const void *frame, int64_t *len) {
+  const flan_restart *r = (const flan_restart *)frame;
+  *len = r->loclen;
+  return r->loc;
+}
+
+const uint8_t *flan_restart_frame_report(const void *frame, int64_t *len) {
+  const flan_restart *r = (const flan_restart *)frame;
+  *len = r->reportlen;
+  return r->report;
+}
+
+const uint8_t *flan_restart_frame_sig(const void *frame, int64_t *len) {
+  const flan_restart *r = (const flan_restart *)frame;
+  *len = r->siglen;
+  return r->sig;
+}
+
+int32_t flan_restart_frame_arity(const void *frame) {
+  return ((const flan_restart *)frame)->arity;
+}
+
+int32_t flan_restart_frame_hidden(const void *frame) {
+  return (((const flan_restart *)frame)->flags & FLAN_RESTART_HIDDEN) != 0;
+}
+
 /* 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. */
@@ -676,12 +728,23 @@ static uint32_t flan_name_id(const uint8_t *s, int64_t n) {
  * NULL when there is no room, and then the caller simply has no restart to
  * offer — an evaluation that cannot be abandoned is worse than one that can,
  * and better than a scribble past the end of this array. */
-void *flan_restart_push_c(const uint8_t *name, int64_t namelen) {
+void *flan_restart_push_c(const uint8_t *name, int64_t namelen,
+                          const uint8_t *report, int64_t reportlen) {
   if (c_restart_depth >= C_RESTARTS) return NULL;
   flan_restart *r = &c_restarts[c_restart_depth++];
+  /* Every field, because the slot is reused: a frame that takes no parameters
+   * says so with the empty signature a written (name [] ...) has, and one
+   * pushed from C has no source line. */
+  memset(r, 0, sizeof *r);
   r->name_id = flan_name_id(name, namelen);
   r->name    = name;
   r->namelen = namelen;
+  r->sig     = (const uint8_t *)"()";
+  r->siglen  = 2;
+  r->sig_id  = flan_name_id(r->sig, r->siglen);
+  r->loc     = (const uint8_t *)"";
+  r->report  = report;
+  r->reportlen = reportlen;
   flan_restart_push(r);
   return r;
 }

test/agent_hooks.c

@@ -31,7 +31,8 @@ void flan_agent_request_free(char *p);
 extern void (*flan_agent_break_poll_hook)(void);
 extern void (*flan_break_hook)(const uint8_t *name, int64_t namelen,
                                void *condition, void *xfer);
-void *flan_restart_push_c(const uint8_t *name, int64_t namelen);
+void *flan_restart_push_c(const uint8_t *name, int64_t namelen,
+                          const uint8_t *report, int64_t reportlen);
 void flan_restart_pop_c(void *frame);
 
 /* The trailing ptr is the transfer channel every Flan signature carries. */
@@ -76,10 +77,14 @@ static void list_and_take(void) {
     const char *name;
     int len;
     if (nl == NULL) break;
-    /* "I F NAME" */
+    /* "I F NAME\tARITY\tSIG\tLOC\tREPORT"; the name ends at the tab. */
     name = strchr(p, ' ');
     name = name ? strchr(name + 1, ' ') : NULL;
-    len = name ? (int)(nl - name - 1) : -1;
+    if (name != NULL) {
+      const char *tab = memchr(name + 1, '\t', (size_t)(nl - name - 1));
+      len = (int)((tab != NULL ? tab : nl) - name - 1);
+    } else
+      len = -1;
     if (len > longest) longest = len;
     if (len < shortest) shortest = len;
     listed++;
@@ -140,7 +145,7 @@ static void stale_hook(void) {
     if (outer_turns == 1) {
       void *xin = NULL;
       printf("outer choice %s", ask("restart-at 1 outer-a"));
-      inner = flan_restart_push_c((const uint8_t *)"inner", 5);
+      inner = flan_restart_push_c((const uint8_t *)"inner", 5, NULL, 0);
       level = 2;
       flan_break_hook((const uint8_t *)"Inner", 5, NULL, &xin);
       level = 1;
@@ -169,8 +174,8 @@ static void stale_hook(void) {
 
 static int stale(void) {
   void *xout = NULL;
-  outer_a = flan_restart_push_c((const uint8_t *)"outer-a", 7);
+  outer_a = flan_restart_push_c((const uint8_t *)"outer-a", 7, NULL, 0);
-  outer_b = flan_restart_push_c((const uint8_t *)"outer-b", 7);
+  outer_b = flan_restart_push_c((const uint8_t *)"outer-b", 7, NULL, 0);
   level = 1;
   flan_agent_break_poll_hook = stale_hook;
   flan_break_hook((const uint8_t *)"Outer", 5, NULL, &xout);

test/programs/break.flan

@@ -11,7 +11,7 @@
 (defn fetch [n i32] i32
   (restart-case
     (do (error (Missing {.id n})) 0)
-    (use-placeholder [] -1)
+    (use-placeholder [] :report "Answer -1 for the missing value" -1)
     (retry           [] 7)))
 
 ;;; Two frames offering the same name, which §4 says resolves to the inner one
@@ -26,9 +26,21 @@
        100)
     (retry [] 900)))
 
+(defstruct Other [])
+
+;;; A handler-case establishes a restart of its own, under a name nobody wrote,
+;;; and a break loop inside it must not offer that one: it is reached through
+;;; the form's handler, which carries the condition in. Only [keep] is listed.
+(defn caught [n i32] i32
+  (restart-case
+    (handler-case (do (error (Missing {.id n})) 0)
+      [(Other [_o] 5)])
+    (keep [] :report "Answer 42" 42)))
+
 (defn main [] i32
   (agent/start "/tmp/flan-break.sock")
   (print (fetch 1)) (println "")
   (print (fetch 2)) (println "")
   (print (shadowed 3)) (println "")
+  (print (caught 4)) (println "")
   0)

test/programs/dev-break.flan

@@ -15,7 +15,7 @@
 (defn fetch [n i32] i32
   (restart-case
     (do (error (Missing {.id n})) 0)
-    (use-placeholder [] -1)
+    (use-placeholder [] :report "Answer -1" -1)
     (retry           [] 7)))
 
 (defonce ticks i64)

test/test_agent.ml

@@ -32,6 +32,17 @@ let fail fmt = Test_support.fail fmt
 let tmp name = Test_support.tmp "flan-agent-" name
 let await ?(ms = 3000) f = Test_support.await ~ms f
 
+(* A [restarts] reply with each row cut at its first tab: the index, the flag
+   and the name, which is what most checks below are about. *)
+let names_only reply =
+  String.concat "\n"
+    (List.map
+       (fun l ->
+          match String.index_opt l '\t' with
+          | Some i -> String.sub l 0 i
+          | None -> l)
+       (String.split_on_char '\n' reply))
+
 let send path line =
   let s = Test_support.connect ~ms:2000 path in
   let msg = line ^ "\n" in
@@ -421,9 +432,17 @@ let () =
       then fail "the program never reached the break loop: %S" !listed
       else begin
         (* Innermost first, and both on offer. *)
-        if !listed <> "0 + retry\n1 + use-placeholder\n.\n" then
+        (* After each name, tab-separated: the parameter count, their
+           spelling, where the clause is written, and its :report sentence —
+           empty for [retry], which wrote none. *)
+        let want =
+          "0 + retry\t0\t()\tprograms/break.flan:15:5\t\n\
+           1 + use-placeholder\t0\t()\tprograms/break.flan:14:5\t\
+           Answer -1 for the missing value\n.\n"
+        in
+        if !listed <> want then
           fail "restarts on offer\n        got: %S\n     wanted: %S" !listed
-            "0 + retry\n1 + use-placeholder\n.\n";
+            want;
         (* A name nothing offers is refused *here*, before the reply. Answering
            ok and discovering it on the game thread would report success for
            something that cannot happen. *)
@@ -443,7 +462,7 @@ let () =
         in
         if not (await printed) then
           fail "the first restart never produced its value"
-        else if not (await (fun () -> send bsock "restarts"
+        else if not (await (fun () -> names_only (send bsock "restarts")
                                       = "0 + retry\n1 + use-placeholder\n.\n"))
         then fail "the program never stopped a second time"
         else begin
@@ -462,7 +481,7 @@ let () =
           in
           if not (await printed2) then
             fail "the second restart never produced its value"
-          else if not (await (fun () -> send bsock "restarts"
+          else if not (await (fun () -> names_only (send bsock "restarts")
                                         = "0 + retry\n1 + retry\n.\n"))
           then fail "the program never stopped on the shadowed pair"
           else begin
@@ -476,7 +495,13 @@ let () =
             let drift = send bsock "restart-at 1 use-placeholder" in
             if not (String.length drift >= 3 && String.sub drift 0 3 = "err")
             then fail "an index whose name had drifted was accepted: %S" drift;
-            ignore (send bsock "restart-at 1 retry")
+            ignore (send bsock "restart-at 1 retry");
+            if not (await (fun () ->
+                      names_only (send bsock "restarts") = "0 + keep\n.\n"))
+            then
+              fail "a handler-case's own restart was listed: %S"
+                (send bsock "restarts")
+            else ignore (send bsock "restart-at 0 keep")
           end
         end
       end
@@ -494,7 +519,7 @@ let () =
     end
     else begin
       let text = In_channel.with_open_bin bout In_channel.input_all in
-      let want = "7\n-1\n900\n" in
+      let want = "7\n-1\n900\n42\n" in
       let got =
         String.concat "\n"
           (List.filter

test/test_dev.ml

@@ -925,6 +925,19 @@ let () =
            if names <> [ "retry"; "use-placeholder" ] then
              fail "restarts on offer: %s" (String.concat ", " names)
          | _ -> fail "break did not list the restarts");
+        (* Beside each name, in the same order: its :report sentence and
+           where its clause is written. [retry] wrote no report. *)
+        (match Wire.field r "details" with
+         | Some { Form.v = Form.List [ d0; d1 ]; _ } ->
+           let str = Wire.string_field in
+           if str d0 "report" <> Some "" || str d1 "report" <> Some "Answer -1"
+           then fail "the restarts' reports did not arrive";
+           (match str d1 "at" with
+            | Some at when contains_sub at "dev-break.flan:18:" -> ()
+            | at ->
+              fail "use-placeholder's clause is at %s"
+                (Option.value at ~default:"nowhere"))
+         | _ -> fail "break did not carry a detail per restart");
 
         (* Where it is, which is the other half of what a stopped program can
            be asked. The shadow stack is dev-only and the daemon owns the

test/test_flan.ml

@@ -3307,6 +3307,14 @@ let () =
   (* 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. *)
+  (* SBCL's placement for a clause's report: after the parameters. *)
+  accepts "a restart clause may carry a :report sentence"
+    "(defn f [] i64 (restart-case 1 (retry [] :report \"Try again\" (do) 2)))";
+  accepts "the suggested :report spelling compiles"
+    "(defn f [] () (restart-case (do) (retry [] :report \"Try again\" (do))))";
+  parse_rejects "a :report that is not a string is refused"
+    "(defn f [] i64 (restart-case 1 (retry [] :report 5 2)))"
+    ~needle:"a restart's :report is a string";
   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"

vendor/agent/flan_agent.c

@@ -334,7 +334,15 @@ extern int64_t        flan_break_site_len;
 /* A restart frame with no Flan function under it, which is what the boundary
  * below is made of. The storage belongs to flan_rt.c for the reason the
  * shadow-stack frame's shape does: the struct is declared in one file. */
-extern void *flan_restart_push_c(const uint8_t *name, int64_t namelen);
+extern void *flan_restart_push_c(const uint8_t *name, int64_t namelen,
+                                 const uint8_t *report, int64_t reportlen);
+/* What a break loop shows about a restart beyond its name, read off a frame
+ * [flan_restart_frame] handed out. */
+extern const uint8_t *flan_restart_frame_loc(const void *frame, int64_t *len);
+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_pop_c(void *frame);
 
 /* -- How far down a transfer can actually land ----------------------- */
@@ -401,6 +409,8 @@ static int32_t frame_floor = -1;
  * around the call like the floors, so nesting names the innermost. */
 static void *eval_boundary;
 static const uint8_t abandon_name[] = "abandon-evaluation";
+static const uint8_t abandon_report[] =
+  "Stop running the expression; the program carries on";
 
 /* The three of them, dropped between two runs of [main]. The counterpart of
  * flan_rt.c's [flan_condition_stacks_reset] and flan_dev.c's
@@ -472,6 +482,8 @@ static _Atomic int aborting;
  * comes from here and nothing re-reads the live stack. */
 #define SNAP_MAX   64                      /* restarts offered at one break */
 #define SNAP_NAMES 4096                    /* bytes of names behind them */
+#define SNAP_TEXT  16384                   /* and of what a listing shows
+                                            * beside each name */
 #define FRAME_MAX  64                      /* frames listed in a backtrace */
 #define FRAME_TEXT 8192                    /* bytes of names and locations */
 
@@ -505,6 +517,17 @@ typedef struct {
   int32_t boundary;
   int32_t used;
   char    names[SNAP_NAMES];
+  /* Beside each name: how many parameters the clause takes, how their types
+   * are spelled, where the clause is written and its :report sentence. Copied
+   * for the reason the names are — the frame they are read from can be popped
+   * while this break is still being asked about. Tabs and newlines in them are
+   * spaces here, because a tab is what separates them on the wire. */
+  int32_t arity[SNAP_MAX];
+  int32_t sigoff[SNAP_MAX], siglen[SNAP_MAX];
+  int32_t locoff[SNAP_MAX], loclen[SNAP_MAX];
+  int32_t repoff[SNAP_MAX], replen[SNAP_MAX];
+  int32_t tused;
+  char    text[SNAP_TEXT];
   /* Where the stopped thread is, taken at the same moment and for the same
    * reason: the chain is the game thread's, and it is holding still only
    * because it is parked in this loop. [fframe] is kept as well as the text,
@@ -588,6 +611,36 @@ static snapshot *snap_top(void) {
   return d <= 0 ? NULL : &snaps[d - 1];
 }
 
+/* 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. */
+static void snap_text(snapshot *s, const uint8_t *p, int64_t n, int32_t *off,
+                      int32_t *len) {
+  *off = s->tused;
+  *len = 0;
+  if (p == NULL || n <= 0 || (int64_t)s->tused + n + 1 > SNAP_TEXT) return;
+  for (int64_t i = 0; i < n; i++) {
+    char c = (char)p[i];
+    s->text[s->tused + i] = (c == '\t' || c == '\n' || c == '\r') ? ' ' : c;
+  }
+  s->tused += (int32_t)n;
+  s->text[s->tused++] = 0;
+  *len = (int32_t)n;
+}
+
+/* The four facts about entry [k] beside its name, off its frame. */
+static void snap_detail(snapshot *s, int32_t k, const void *fr) {
+  int64_t        n;
+  const uint8_t *p;
+  s->arity[k] = flan_restart_frame_arity(fr);
+  p = flan_restart_frame_sig(fr, &n);
+  snap_text(s, p, n, &s->sigoff[k], &s->siglen[k]);
+  p = flan_restart_frame_loc(fr, &n);
+  snap_text(s, p, n, &s->locoff[k], &s->loclen[k]);
+  p = flan_restart_frame_report(fr, &n);
+  snap_text(s, p, n, &s->repoff[k], &s->replen[k]);
+}
+
 /* Called on the game thread with the stack held still. 0 if there is no room
  * to nest, which the caller reports rather than serving a stale one. */
 static int32_t snap_gen;                   /* monotone; 0 is "no snapshot" */
@@ -621,6 +674,7 @@ static int snap_push(int resumable, void *cond) {
   }
   s->total = n;
   s->used  = 0;
+  s->tused = 0;
   s->n     = 0;
   s->boundary = -1;
   /* One slot and one name's worth of bytes kept back for the boundary, and the
@@ -643,6 +697,12 @@ static int snap_push(int resumable, void *cond) {
     const uint8_t *nm  = flan_restart_name(i, &len);
     void          *fr  = flan_restart_frame(i);
     if (nm == NULL || fr == NULL) continue;
+    /* A handler-case's own landing is left off. It is reached through the
+     * handler the form installed, carries the condition that handler copies
+     * in, and has nothing to offer a person at a break loop — taking it by
+     * hand is refused at the clause for want of that condition. Dropped from
+     * the count as well, so "and N more" counts only what could be listed. */
+    if (flan_restart_frame_hidden(fr)) { s->total--; continue; }
     if (len < 0) len = 0;
     if ((int64_t)s->used + len + 1 > SNAP_NAMES - held_bytes) break;
     s->frame[s->n] = fr;
@@ -651,6 +711,7 @@ static int snap_push(int resumable, void *cond) {
     /* The outermost [restart_floor] frames are below the thunk boundary. */
     s->reachable[s->n] = (i < n - restart_floor);
     if (fr == eval_boundary && eval_boundary != NULL) s->boundary = s->n;
+    snap_detail(s, s->n, fr);
     memcpy(s->names + s->used, nm, (size_t)len);
     s->used += (int32_t)len;
     s->names[s->used++] = 0;
@@ -672,6 +733,7 @@ static int snap_push(int resumable, void *cond) {
      * is what [reachable] is measured against. */
     s->reachable[s->n] = 1;
     s->boundary = s->n;
+    snap_detail(s, s->n, eval_boundary);
     memcpy(s->names + s->used, abandon_name, (size_t)len);
     s->used += len;
     s->names[s->used++] = 0;
@@ -860,7 +922,11 @@ static void break_loop_at(const uint8_t *name, int64_t namelen, void *condition,
        * not takeable - a restart below the thunk boundary is shown rather
        * than hidden, since "why can I not have that one" is a fair question
        * and silence is how this went wrong the first time. */
-      fprintf(stderr, "  %2d. restart: %s%s\n", i, s->names + s->off[i],
+      fprintf(stderr, "  %2d. restart: %s%s%s%s\n", i, s->names + s->off[i],
+              /* Not for the boundary, whose own words follow. */
+              s->replen[i] > 0 && i != s->boundary ? " — " : "",
+              s->replen[i] > 0 && i != s->boundary ? s->text + s->repoff[i]
+                                                   : "",
               !s->resumable   ? "   (cannot be taken from this trap)"
               : i == s->boundary
                 ? "   (stop running the expression; the program carries on)"
@@ -1041,7 +1107,9 @@ int32_t flan_agent_poll(void) {
       /* After the floor is read and not before: the floor counts the frames
        * that were there when the thunk started, and this one is the thunk's.
        * Pushed first it would be below its own boundary and refused. */
-      eval_boundary = flan_restart_push_c(abandon_name, sizeof abandon_name - 1);
+      eval_boundary = flan_restart_push_c(abandon_name, sizeof abandon_name - 1,
+                                          abandon_report,
+                                          sizeof abandon_report - 1);
       j.call();
       /* Popped whichever way the thunk left — returning with a value, or
        * unwinding past this frame because someone abandoned it. */
@@ -1234,7 +1302,14 @@ static void handle_line(char *line, sink *o) {
    * for whether it can be taken at all, and the name. The index leads
    * because it is the identity - two frames can offer [retry] and only one
    * of them is the one meant, which is the whole reason this is not a list
-   * of names any more. Read from the snapshot, never from the live stack. */
+   * of names any more. Read from the snapshot, never from the live stack.
+   *
+   * After the name, each behind a tab: how many parameters the clause takes,
+   * how their types are spelled, where it is written ([-] for a frame pushed
+   * from C) and its :report sentence, which may be empty and may contain
+   * spaces, so it is last. A tab because a name has no space in it and a
+   * report does; the snapshot has already turned any tab in them to a
+   * space. */
   if (strcmp(line, "restarts") == 0) {
     if (!(atomic_load(&depth) > 0)) { reply(o, "err not stopped\n"); return; }
     snapshot *s = snap_top();
@@ -1273,6 +1348,14 @@ static void handle_line(char *line, sink *o) {
                                                            : '+');
       if (k > 0) emit(o, hdr, (size_t)k);
       emit(o, s->names + s->off[i], (size_t)s->len[i]);
+      k = snprintf(hdr, sizeof hdr, "\t%d\t", s->arity[i]);
+      if (k > 0) emit(o, hdr, (size_t)k);
+      emit(o, s->text + s->sigoff[i], (size_t)s->siglen[i]);
+      reply(o, "\t");
+      if (s->loclen[i] > 0) emit(o, s->text + s->locoff[i], (size_t)s->loclen[i]);
+      else reply(o, "-");
+      reply(o, "\t");
+      emit(o, s->text + s->repoff[i], (size_t)s->replen[i]);
       reply(o, "\n");
     }
     reply(o, ".\n");