From 122e17bd06d0e8f21d0393dd7c0346a980f1a87b Mon Sep 17 00:00:00 2001 From: Joseph Ferano Date: Sat, 12 Sep 2026 17:15:57 +0700 Subject: [PATCH 1/6] The inspector gets an address root, and the daemon a verb for it MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit `i' in the break buffer sent a local's *name* to be evaluated, and an expression is evaluated where the evaluator stands. On the innermost frame that is the right frame; on any other it may resolve to a global, to another binding of the same name, or to nothing, with the listing above it showing the frame's own storage and nothing saying the two disagree. The shadow stack is what makes the second rooting mode cheap: a frame's address and every slot's type are both here, so a step into a field is an address plus an offset with that field's type — the arithmetic `Render.render' already does for the listing. `Session.render_slot' is `render_locals' with a path applied to the root and one line out. The slot travels by *index*, because a name is not unique: two `v's is two slots and both are in the listing, and a refused slot is not, so the position in the list is not an identifier either. So `locals' now puts the index on each line. The frame checks are `locals'' by construction — `stopped_frame' is one function now, and an inspector with its own copy would be free to read a frame whose body was redefined since it was entered. The build-and-read tail is one function too, for the reason this file already records about the fingerprint. And `layout' said union values were milestone 6, which they have not been since today. --- lib/dev.ml | 469 ++++++++++++++++++++++++++++++------------------- lib/session.ml | 270 +++++++++++++++++++++++++++- 2 files changed, 561 insertions(+), 178 deletions(-) diff --git a/lib/dev.ml b/lib/dev.ml index 5af554d..aac36ce 100644 --- a/lib/dev.ml +++ b/lib/dev.ml @@ -628,7 +628,17 @@ let layout t ~ty = List.exists (fun (u : Tast.union) -> String.equal u.Tast.uname ty) t.session.Session.program.Tast.unions then - error (ty ^ " is a union, not a struct; union values are milestone 6") + (* Unions have landed, so "milestone 6" was stale — but what replaces it + is not a layout. This op's reply is a flat [:fields] list, and a union + is a tag and one payload per case: there is no one field list to + answer with, and flattening the cases into one would describe storage + no value ever has. So it says which kind of type this is, and where + the question it was probably asked for *is* answered — the renderer + walks a union now, so a union value prints in a frame's locals and at + `C-x C-e' with its case and that case's fields. *) + error + (ty + ^ " is a union, not a struct; a union is a tag and one payload per case, so it has no single field list for this op to answer with. Its value renders with its case and fields in a frame's locals and at C-x C-e") else let suffix = "/" ^ ty in let candidates = @@ -724,6 +734,115 @@ let backtrace_op t = Printf.sprintf ":more %d" more ] | Error m -> error ("the program refused to say where it is: " ^ m)) +(* Build a render thunk, hand it to the program, and read back what it wrote. + + The same five steps for every verb that renders something inside the + stopped program — [locals], [globals] and [inspect] — and they are here + once rather than three times because the note this file already carries + about the fingerprint applies to plumbing too: four of five hand-offs + present looks exactly like one hand-off dropping a step, and that is a bug + nobody sees until the one path that lost it is the one being used. + + [tag] only names the [.so] on disk, which is what someone reads when they + go looking at [t.dir] to find out which verb produced what. *) +let run_render_thunk t ~tag ~(c : Session.change) : (string, string) result = + let before = match result t with Some (g, _) -> g | None -> 0L in + t.n <- t.n + 1; + let out = Filename.concat t.dir (Printf.sprintf "%s%d.so" tag t.n) in + match + Build.shared + ~opts:{ Build.default with Build.dev = true; + Build.debug = t.session.Session.debug } + ~ir:c.Session.ir ~out () + with + | exception Failure m -> Error m + | _ -> + (match deliver t out with + | exception Unix.Unix_error (e, _, _) -> + Error ("cannot reach the program: " ^ Unix.error_message e) + | "ok" -> + let rec wait ms = + match result t with + | Some (g, v) when Int64.compare g before > 0 -> Some v + | _ when ms <= 0 -> None + | _ -> + ignore (Unix.select [] [] [] 0.005); + if alive t then wait (ms - 5) else None + in + (match wait 5000 with + | Some v -> Ok v + | None -> + Error + "the program did not reach a frame boundary; is it calling \ + (agent/poll)?") + | reply -> Error ("the program refused the module: " ^ reply)) + +(* The frame checks, which every verb that reads a *frame* has to make and + must make the same way. [inspect] exists precisely because the listing is + frame-accurate and the inspector was not, so it sharing this function with + [locals] rather than repeating four conditions is the point: an inspector + that sidestepped the fingerprint would read stale slots out of a frame the + listing above it is already refusing. + + [what] goes into the wording — "read slot names from" is not the sentence + [inspect] wants — and nothing else differs. *) +let stopped_frame t ~frame ~what : (string * Tast.fn, string) result = + if not (alive t) then Error "the program exited; restart flan dev" + else + match state t with + | Running -> + Error + (Printf.sprintf + "the program is running; %s is read from a stopped frame, and \ + nothing in a frame that is still executing holds still" + what) + | Unreachable m -> Error ("cannot ask the program where it is: " ^ m) + | Stopped _ -> + (match backtrace t with + | Error m -> Error ("the program refused to say where it is: " ^ m) + | Ok (frames, _) -> + (match List.nth_opt frames frame with + | None -> + Error + (Printf.sprintf "there is no frame %d; the backtrace has %d" frame + (List.length frames)) + | Some (name, _, mine, nslots, sig_, _rsig) -> + if not mine then + Error + (name + ^ " is a frame of the expression this break is inside, not of the program; its thunk is not part of the session, so there is no record of what its slots are called") + else + match find_fn t name with + | None -> + Error + (name + ^ " is not a function this session holds; a lifted handler clause has no declaration of its own to read slot names from") + | Some fn -> + (* The two body checks come first, including for a frame + with no slots. "every slot in it is one the compiler made + up" is a claim about the body this session holds, and a + zero-slot frame whose body has since been replaced by one + with slots is a frame that claim is false about. *) + if nslots <> Array.length fn.Tast.slots then + Error + (Printf.sprintf + "%s on the stack has %d slots and the %s this session holds has %d: the frame is running a body that has been redefined since, so every slot index here would be a guess" + name nslots name (Array.length fn.Tast.slots)) + else if sig_ <> Emit.slot_fingerprint fn then + (* The count matching is not the same as the body matching. + A redefinition that renames a local, or changes its type + to one of the same shape, keeps the count — and then + every name here would be the new body's read against the + old body's storage, which is the "visible rather than + correct" answer this project refuses to give. Said by + name, because a frame that is missing and a frame that + cannot be trusted are different facts. *) + Error + (Printf.sprintf + "%s on the stack was compiled from a different body than the %s this session holds: this frame's body was redefined since it was entered, so its names no longer describe its values" + name name) + else Ok (name, fn))) + (* [(:op "locals" :frame N)] — what a stopped frame's named locals hold. The half of a break loop that the author actually wanted, and the reason @@ -758,122 +877,109 @@ let backtrace_op t = 30-bit hash — but only between two differing bodies of the function whose qualified name already matched, since [find_fn] gates the comparison. *) let locals t ~frame = - if not (alive t) then error "the program exited; restart flan dev" - else - match state t with - | Running -> - error - "the program is running; locals are read from a stopped frame, and \ - nothing in a frame that is still executing holds still" - | Unreachable m -> error ("cannot ask the program for its locals: " ^ m) - | Stopped _ -> - (match backtrace t with - | Error m -> error ("the program refused to say where it is: " ^ m) - | Ok (frames, _) -> - (match List.nth_opt frames frame with - | None -> - error - (Printf.sprintf "there is no frame %d; the backtrace has %d" frame - (List.length frames)) - | Some (name, _, mine, nslots, sig_, _rsig) -> - if not mine then - error - (name - ^ " is a frame of the expression this break is inside, not of the program; its thunk is not part of the session, so there is no record of what its slots are called") - else - match find_fn t name with - | None -> - error - (name - ^ " is not a function this session holds; a lifted handler clause has no declaration of its own to read slot names from") - | Some fn -> - (* The two body checks come first, including for a frame - with no slots. "every slot in it is one the compiler made - up" is a claim about the body this session holds, and a - zero-slot frame whose body has since been replaced by one - with slots is a frame that claim is false about. *) - if nslots <> Array.length fn.Tast.slots then - error - (Printf.sprintf - "%s on the stack has %d slots and the %s this session holds has %d: the frame is running a body that has been redefined since, so every slot index here would be a guess" - name nslots name (Array.length fn.Tast.slots)) - else if sig_ <> Emit.slot_fingerprint fn then - (* The count matching is not the same as the body matching. - A redefinition that renames a local, or changes its type - to one of the same shape, keeps the count — and then - every name here would be the new body's read against the - old body's storage, which is the "visible rather than - correct" answer this project refuses to give. Said by - name, because a frame that is missing and a frame that - cannot be trusted are different facts. *) - error - (Printf.sprintf - "%s on the stack was compiled from a different body than the %s this session holds: this frame's body was redefined since it was entered, so its names no longer describe its values" - name name) - else if nslots = 0 then - ok - [ ":frame " ^ Wire.quote name; ":locals ()"; ":refused ()"; - ":note " - ^ Wire.quote - "that frame records no slots; every slot in it is one the compiler made up" ] - else - match bound_slots t ~frame with - | Error m -> error ("the program refused to say which slots are bound: " ^ m) - | Ok bound -> - let c, refused = Session.render_locals t.session ~frame ~fn ~bound in - let before = match result t with Some (g, _) -> g | None -> 0L in - t.n <- t.n + 1; - let out = Filename.concat t.dir (Printf.sprintf "l%d.so" t.n) in - (match Build.shared - ~opts:{ Build.default with Build.dev = true; - Build.debug = t.session.Session.debug } - ~ir:c.Session.ir ~out () with - | _ -> - (match deliver t out with - | "ok" -> - let rec wait ms = - match result t with - | Some (g, v) when Int64.compare g before > 0 -> Some v - | _ when ms <= 0 -> None - | _ -> - ignore (Unix.select [] [] [] 0.005); - if alive t then wait (ms - 5) else None - in - (match wait 5000 with - | Some v -> - (* One line per slot, name and type and value, - tab separated — safe because every string the - renderer emits is escaped. *) - let entries = - List.filter_map - (fun line -> - match String.split_on_char '\t' line with - | [ n; ty; value ] -> - Some - (Wire.list - [ Wire.quote n; Wire.quote ty; - Wire.quote value ]) - | _ -> None) - (String.split_on_char '\n' v) - in - ok - [ ":frame " ^ Wire.quote name; - ":locals " ^ Wire.list entries; - ":refused " - ^ Wire.list - (List.map - (fun (n, why) -> - Wire.list - [ Wire.quote n; Wire.quote why ]) - refused) ] - | None -> - error - "the program did not reach a frame boundary; is \ - it calling (agent/poll)?") - | reply -> error ("the program refused the module: " ^ reply) - | exception Unix.Unix_error (e, _, _) -> - error ("cannot reach the program: " ^ Unix.error_message e)) - | exception Failure m -> error m))) + match stopped_frame t ~frame ~what:"locals" with + | Error m -> error m + | Ok (name, fn) -> + if Array.length fn.Tast.slots = 0 then + ok + [ ":frame " ^ Wire.quote name; ":locals ()"; ":refused ()"; + ":note " + ^ Wire.quote + "that frame records no slots; every slot in it is one the compiler made up" ] + else + (match bound_slots t ~frame with + | Error m -> error ("the program refused to say which slots are bound: " ^ m) + | Ok bound -> + let c, refused = Session.render_locals t.session ~frame ~fn ~bound in + (match run_render_thunk t ~tag:"l" ~c with + | Error m -> error m + | Ok v -> + (* One line per slot — name, type, value, slot index — tab + separated, and safe because every string the renderer emits is + escaped. The index is last and it is what [i] in the break + buffer hands back to [inspect]: two slots can share a name, so + the name is not an identifier and the position in this list is + not one either, since a refused slot is not in it. *) + let entries = + List.filter_map + (fun line -> + match String.split_on_char '\t' line with + | [ n; ty; value; slot ] -> + Some + (Wire.list + [ Wire.quote n; Wire.quote ty; Wire.quote value; slot ]) + | _ -> None) + (String.split_on_char '\n' v) + in + ok + [ ":frame " ^ Wire.quote name; + ":locals " ^ Wire.list entries; + ":refused " + ^ Wire.list + (List.map + (fun (n, why) -> Wire.list [ Wire.quote n; Wire.quote why ]) + refused) ])) + +(* [(:op "inspect" :frame N :slot I :path (...))] — the inspector's second + rooting mode, and the answer to the hole [DISCUSS.md] item 1 named. + + [i] in the break buffer used to send a local's *name* to be evaluated as an + expression. On the innermost frame that happens to be right; on any other + it is evaluated wherever the evaluator stands, so it may resolve to a + global, to a different binding of the same name, or to nothing — with the + listing right above it showing the frame's own storage and nothing saying + the two disagree. + + This roots the walk where the listing roots it: a frame and a slot index, + which is the address the shadow stack knows, plus the type [Tast.fn.slots] + knows. A step into a field is then an address plus an offset with that + field's type, which is arithmetic [Render.render] already does — see + [Session.render_slot], which is [render_locals] with a path applied to the + root and one line out instead of one per slot. + + The frame checks are [locals]'s, by construction: both go through + [stopped_frame]. An inspector that made its own would be free to read a + frame whose body was redefined since it was entered, which is exactly the + stale-slot answer the listing refuses. + + The slot is named by *index* and not by name, because a name is not unique: + [check.ml]'s [fresh_slot] only ever allocates, so (let [v 22] …) inside + (let [v 11] …) is two slots both called [v], and both are in the listing. + The index travels out with each line of [locals] for exactly this. + + [:path] is a list the reader parses: a string is a field, an integer is an + element, and the symbol [some] is an option's payload. Empty means the slot + itself. *) +let inspect t ~frame ~slot ~path = + match stopped_frame t ~frame ~what:"a local" with + | Error m -> error m + | Ok (name, fn) -> + (match bound_slots t ~frame with + | Error m -> error ("the program refused to say which slots are bound: " ^ m) + | Ok bound -> + if not (List.mem slot bound) then + (* The same refusal the listing gives, and for the same reason: an + unbound slot's entry is null, and a thunk that rendered it would + fault on the game thread of a program that is already stopped. *) + error + (Printf.sprintf + "slot %d of %s was not bound yet at the point the program \ + stopped; there is nothing at that address to read" + slot name) + else + match Session.render_slot t.session ~frame ~fn ~slot ~path with + | Error why -> error why + | Ok (c, label, ty) -> + (match run_render_thunk t ~tag:"i" ~c with + | Error m -> error m + | Ok v -> + (* One value and nothing else, so the whole of what came back is + it — minus the trailing newline the renderer does not write + here, because there is no second line to separate it from. *) + ok + [ ":frame " ^ Wire.quote name; ":name " ^ Wire.quote label; + ":type " ^ Wire.quote ty; ":value " ^ Wire.quote v ])) + (* [(:op "globals")] — the globals the stopped stack reaches, in one section. @@ -1063,66 +1169,39 @@ let globals_op t = nothing here that is not already in the locals" ] else begin let c, refused = Session.render_globals t.session ~globals:ordered in - let before = match result t with Some (g, _) -> g | None -> 0L in - t.n <- t.n + 1; - let out = Filename.concat t.dir (Printf.sprintf "g%d.so" t.n) in - match Build.shared - ~opts:{ Build.default with Build.dev = true; - Build.debug = t.session.Session.debug } - ~ir:c.Session.ir ~out () with - | _ -> - (match deliver t out with - | "ok" -> - let rec wait ms = - match result t with - | Some (g, v) when Int64.compare g before > 0 -> Some v - | _ when ms <= 0 -> None - | _ -> - ignore (Unix.select [] [] [] 0.005); - if alive t then wait (ms - 5) else None - in - (match wait 5000 with - | Some v -> - (* One line per global, name and type and value, tab - separated — safe because every string the renderer emits - is escaped. The frames are added back here, from the - table above, because the thunk knows nothing about the - stack it was chosen for. *) - let by_name = Hashtbl.create 32 in - List.iter - (fun (g : Tast.global) -> - Hashtbl.replace by_name g.Tast.gname (where g)) - ordered; - let entries = - List.filter_map - (fun line -> - match String.split_on_char '\t' line with - | [ n; ty; value ] -> - Some - (Wire.list - [ Wire.quote n; Wire.quote ty; Wire.quote value; - (try Hashtbl.find by_name n - with Not_found -> Wire.list []) ]) - | _ -> None) - (String.split_on_char '\n' v) - in - ok - [ ":globals " ^ Wire.list entries; - ":refused " - ^ Wire.list - (List.map - (fun (n, why) -> - Wire.list [ Wire.quote n; Wire.quote why ]) - refused); - skipped_field ] - | None -> - error - "the program did not reach a frame boundary; is it calling \ - (agent/poll)?") - | reply -> error ("the program refused the module: " ^ reply) - | exception Unix.Unix_error (e, _, _) -> - error ("cannot reach the program: " ^ Unix.error_message e)) - | exception Failure m -> error m + match run_render_thunk t ~tag:"g" ~c with + | Error m -> error m + | Ok v -> + (* One line per global, name and type and value, tab separated — + safe because every string the renderer emits is escaped. The + frames are added back here, from the table above, because the + thunk knows nothing about the stack it was chosen for. *) + let by_name = Hashtbl.create 32 in + List.iter + (fun (g : Tast.global) -> + Hashtbl.replace by_name g.Tast.gname (where g)) + ordered; + let entries = + List.filter_map + (fun line -> + match String.split_on_char '\t' line with + | [ n; ty; value ] -> + Some + (Wire.list + [ Wire.quote n; Wire.quote ty; Wire.quote value; + (try Hashtbl.find by_name n + with Not_found -> Wire.list []) ]) + | _ -> None) + (String.split_on_char '\n' v) + in + ok + [ ":globals " ^ Wire.list entries; + ":refused " + ^ Wire.list + (List.map + (fun (n, why) -> Wire.list [ Wire.quote n; Wire.quote why ]) + refused); + skipped_field ] end) (* A choice is validated by the *program*, on its listener thread, against a @@ -1516,6 +1595,42 @@ let handle t req = | Some "backtrace" -> backtrace_op t | Some "locals" -> locals t ~frame:(match Wire.int_field req "frame" with Some n -> n | None -> 0) + (* The path is read by the language's own reader, so it arrives as a form + and is matched here rather than parsed out of a string: a string element + is a field, an integer is an element, and the symbol [some] is an + option's payload. Anything else is refused by name rather than skipped — + a path with a step silently dropped out of it would render a *different* + value and say nothing. *) + | Some "inspect" -> + (match Wire.int_field req "slot" with + | None -> error "inspect needs :slot, the index the locals listing gave" + | Some slot -> + let frame = + match Wire.int_field req "frame" with Some n -> n | None -> 0 + in + let steps = + match Wire.field req "path" with + | Some { Form.v = Form.List l; _ } -> + List.fold_left + (fun acc (e : Form.t) -> + match acc with + | Error _ -> acc + | Ok got -> + (match e.Form.v with + | Form.Str f -> Ok (Session.Sfield f :: got) + | Form.Int i -> Ok (Session.Sindex (Int64.to_int i) :: got) + | Form.Sym "some" -> Ok (Session.Ssome :: got) + | _ -> + Error + "a :path step is a string for a field, an integer for an element, or `some' for an option's payload")) + (Ok []) l + |> Result.map List.rev + | Some _ -> Error "inspect's :path is a list" + | None -> Ok [] + in + (match steps with + | Error m -> error m + | Ok path -> inspect t ~frame ~slot ~path)) (* No :frame, and that is the point: the section is the stack's, not a frame's. See [globals_op]. *) | Some "globals" -> globals_op t diff --git a/lib/session.ml b/lib/session.ml index 52618e9..1d11dea 100644 --- a/lib/session.ml +++ b/lib/session.ml @@ -496,8 +496,15 @@ let render_locals ?(origin = "") t ~frame ~(fn : Tast.fn) ~bound let v = { Tast.e = Tast.Deref typed; ty; loc } in match Render.render c 0 v with | parts -> + (* The slot *index* travels with the line, last, and it is what makes + [i] in the break buffer able to name this exact slot back to the + daemon. The name cannot: [check.ml]'s [fresh_slot] only ever + allocates, so (let [v 22] …) inside (let [v 11] …) is two slots both + called [v] and both listed here. Nor can the position in the list, + because a refused slot is not in it. See [render_slot]. *) Some - ((lit (name ^ "\t" ^ Types.to_string ty ^ "\t") :: parts) @ [ lit "\n" ]) + ((lit (name ^ "\t" ^ Types.to_string ty ^ "\t") :: parts) + @ [ lit ("\t" ^ string_of_int i ^ "\n") ]) | exception Loc.Error (_, why) -> (* A type the structural printer has no arm for — a map, a function value, a type variable. Named, with the reason, rather than left out @@ -554,6 +561,267 @@ let render_locals ?(origin = "") t ~frame ~(fn : Tast.fn) ~bound ignore origin; ({ ir; names = []; fns = []; installs = true }, List.rev !refused) +(* ── One slot of a stopped frame, walked ───────────────────────────── *) + +(* The inspector's second rooting mode, and the whole of what it needed. + + The inspector navigates by rewriting *expressions* — `(.pos b)' where the + last one was `b' — because a Flan value has no header and the thunk that + rendered it is [dlclose]d as soon as it returns, so nothing can be held on + this side the way CIDER holds a JVM object. The cost of that is the bug it + had: a name sent back to be evaluated is evaluated wherever the evaluator + stands, which on any frame but the innermost may resolve to a global, to a + different binding, or to nothing, with the listing above it still showing + the frame's own storage. + + Rooting at the slot's address alone does not fix it — an address is not an + expression, so the first step has nothing to build from. What makes this + work is that the step does not have to be an expression either. A frame's + address comes from the shadow stack and every slot's type comes from + [Tast.fn.slots], so a step into a field is an address plus an offset with + that field's type, which is *exactly* the arithmetic [Render.render] does + for the locals listing. So this is [render_locals] with a path applied to + the root before the walk, and not a second walk. + + What the path cannot do is the honest half. Every step is refused by name + with its reason rather than guessed at: a field the type does not have, an + index past the end of a fixed array, an option's payload on something that + is not an option. A pointer is still never followed — that is the + renderer's rule and not this mode's. *) + +(* A step, as the editor sends it. [Sfield] on a union carries the case as + well, because a union's payload is at an offset that depends on which case + it is, and the renderer is what told the editor which case this value + currently holds. Guessing the case from a field name that two cases share + would read one case's layout over another's payload. *) +type step = Sfield of string | Sindex of int | Ssome + +let step_text = function + | Sfield f -> "." ^ f + | Sindex i -> Printf.sprintf "[%d]" i + | Ssome -> ".some" + +let path_text path = String.concat "" (List.map step_text path) + +let step_into t (v : Tast.expr) (s : step) : (Tast.expr, string) result = + let loc = v.Tast.loc in + let ty = v.Tast.ty in + let no why = Error why in + match s with + | Ssome -> + (match ty with + | Types.Option pay -> Ok { Tast.e = Tast.Field (v, 1); ty = pay; loc } + | _ -> + no + (Printf.sprintf "%s is not an option, so it has no payload to go into" + (Types.to_string ty))) + | Sindex i -> + (match ty with + | Types.Array (n, el) -> + if i < 0 || Int64.compare (Int64.of_int i) n >= 0 then + no + (Printf.sprintf "%d is past the end of %s, which has %Ld elements" i + (Types.to_string ty) n) + else + Ok + { Tast.e = + Tast.Prim + (Tast.At, + [ v; + { Tast.e = Tast.Int (Int64.of_int i, Types.I32); + ty = Types.Int Types.I32; loc } ]); + ty = el; loc } + | Types.Slice el -> + (* A slice's length is not in its type, so this is the one step whose + range cannot be settled here. It is checked in the program, like + every other index in a dev build. *) + if i < 0 then no (Printf.sprintf "%d is not an index" i) + else + Ok + { Tast.e = + Tast.Prim + (Tast.At, + [ v; + { Tast.e = Tast.Int (Int64.of_int i, Types.I32); + ty = Types.Int Types.I32; loc } ]); + ty = el; loc } + | _ -> + no + (Printf.sprintf "%s is not an array or a slice, so it has no element %d" + (Types.to_string ty) i)) + | Sfield spec -> + (match ty with + | Types.Named n + when List.exists (fun (u : Tast.union) -> String.equal u.Tast.uname n) + t.program.Tast.unions -> + let u = + List.find (fun (u : Tast.union) -> String.equal u.Tast.uname n) + t.program.Tast.unions + in + (* The editor spells this `Union.case.field', which is the head the + renderer wrote — `(Union.case {.field …})' — with the field appended. + A bare `case.field' is taken too, since that is the same fact said + shorter. *) + (match String.rindex_opt spec '.' with + | None -> + no + (Printf.sprintf + "%s is a union: a field of it has to name the case that holds \ + it, because the payload's offset depends on which case the \ + value is in" + n) + | Some k -> + let case = String.sub spec 0 k + and fname = String.sub spec (k + 1) (String.length spec - k - 1) in + let case = + let pre = n ^ "." in + let lp = String.length pre in + if String.length case > lp && String.equal (String.sub case 0 lp) pre + then String.sub case lp (String.length case - lp) + else case + in + (match + List.find_opt + (fun (vr : Tast.variant) -> String.equal vr.Tast.vname case) + u.Tast.cases + with + | None -> + no (Printf.sprintf "%s has no case called %s" n case) + | Some vr -> + let rec idx i = function + | [] -> None + | (f : Tast.field) :: rest -> + if String.equal f.Tast.fname fname then Some (i, f.Tast.fty) + else idx (i + 1) rest + in + (match idx 0 vr.Tast.vfields with + | None -> + no + (Printf.sprintf "%s.%s has no field called %s" n case fname) + | Some (i, fty) -> + Ok + { Tast.e = Tast.CaseField (v, vr.Tast.vname, i); ty = fty; loc }))) + | Types.Named n -> + (match + List.find_opt + (fun (s : Tast.structure) -> String.equal s.Tast.sname n) + t.program.Tast.structs + with + | None -> + no + (Printf.sprintf + "%s is a type this session has no layout for, so there is no \ + field to step to" + n) + | Some st -> + let rec idx i = function + | [] -> None + | (f : Tast.field) :: rest -> + if String.equal f.Tast.fname spec then Some (i, f.Tast.fty) + else idx (i + 1) rest + in + (match idx 0 st.Tast.fields with + | None -> + no (Printf.sprintf "%s has no field called %s" n spec) + | Some (i, fty) -> Ok { Tast.e = Tast.Field (v, i); ty = fty; loc })) + | _ -> + no + (Printf.sprintf "%s has no fields, so there is no .%s in it" + (Types.to_string ty) spec)) + +(* Renders slot [slot] of frame [frame], after walking [path] into it. The + thunk is [render_locals]'s, minus the loop over every slot: one root, one + line, and the reply carries the type the path ended at so the editor can + say what it is looking at. + + The caller has already established that the frame is the body this session + holds — the slot fingerprint — and that the slot is bound. This function + does not re-derive either; it is handed the [fn] that check passed. *) +let render_slot ?(origin = "") t ~frame ~(fn : Tast.fn) ~slot ~path + : (change * string * string, string) result = + let loc = fn.Tast.floc in + let nslots_of_fn = Array.length fn.Tast.slots in + if slot < 0 || slot >= nslots_of_fn then + Error + (Printf.sprintf "there is no slot %d in %s; it has %d" slot fn.Tast.name + nslots_of_fn) + else + let sname = + if slot < Array.length fn.Tast.snames then fn.Tast.snames.(slot) else None + in + match sname with + | None -> + Error + (Printf.sprintf + "slot %d of %s is one the compiler made up; no name was written for \ + it, and it is not something the listing offers" + slot fn.Tast.name) + | Some name -> + let extra = ref [] and nslots = ref 0 in + let c = + { Render.structs = t.program.Tast.structs; + unions = t.program.Tast.unions; + enums = Hashtbl.fold (fun k v acc -> (k, v) :: acc) t.env.Check.enums []; + emit = dev_emitter; + alloc = (fun ty -> + let i = !nslots in + incr nslots; + extra := ty :: !extra; + i) } + in + let idx n = + { Tast.e = Tast.Int (Int64.of_int n, Types.I64); ty = Types.Int Types.I64; + loc } + in + let ty = fn.Tast.slots.(slot) in + let address = + { Tast.e = Tast.Call ("flan/dev-slot", [ idx frame; idx slot ]); + ty = Types.Ptr (Types.Int Types.U8); loc } + in + let typed = + { Tast.e = Tast.Prim (Tast.Cast (Types.Ptr ty), [ address ]); + ty = Types.Ptr ty; loc } + in + let root = { Tast.e = Tast.Deref typed; ty; loc } in + let rec walk v = function + | [] -> Ok v + | s :: rest -> + (match step_into t v s with + | Error why -> Error why + | Ok v' -> walk v' rest) + in + (match walk root path with + | Error why -> Error (name ^ path_text path ^ ": " ^ why) + | Ok v -> + (match Render.render c 0 v with + | exception Loc.Error (_, why) -> Error (name ^ path_text path ^ ": " ^ why) + | parts -> + let nullary n = { Tast.e = Tast.Call (n, []); ty = Types.Unit; loc } in + t.thunks <- t.thunks + 1; + let tname = Printf.sprintf "inspect/%d" t.thunks in + let thunk : Tast.fn = + { Tast.name = tname; params = []; ret = Types.Unit; + body = + (nullary "flan/dev-begin" :: parts) @ [ nullary "flan/dev-end" ]; + fdefers = []; fparent = None; floc = loc; + slots = Array.of_list (List.rev !extra); + snames = Array.make (List.length !extra) None } + in + let program = + { t.program with + Tast.fns = t.program.Tast.fns @ [ thunk ]; + externs = t.program.Tast.externs @ externs } + in + let ir = + Emit.redefinition ~dev:true ~debug:t.debug ~known:(known t) + ~call:tname program ~fns:[ tname ] + in + ignore origin; + Ok + ({ ir; names = []; fns = []; installs = true }, + name ^ path_text path, + Types.to_string v.Tast.ty))) + (* ── The globals a stopped stack reaches ───────────────────────────── *) (* The other half of what a break loop can show, and in this language arguably From 03d4460d72311fcee3fedcb28ee02171cf3ea2f5 Mon Sep 17 00:00:00 2001 From: Joseph Ferano Date: Sat, 12 Sep 2026 17:18:44 +0700 Subject: [PATCH 2/6] WIP: the inspector's address root, half wired on the Emacs side MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit OCaml side is done and builds. Emacs side is mid-edit and INCOMPLETE — see the handoff below. `dune build --root . @check` is green. `dune test --root .` was NOT run. The .el files were not byte-compiled and flan-inspect.el will not work as it stands: the state layer still speaks the old single-expression shape while the helpers above it have been rewritten for roots and paths. WHAT WORKS (daemon, lib/, in the parent commit and unchanged here) - `(:op "inspect" :frame N :slot I :path (...))` renders one value rooted at a stopped frame's slot address. `Session.render_slot` is `render_locals` with a path applied to the root before the walk and one line out instead of one per slot; no second walk was written and no backend change was needed. - A path step is a string for a struct field, an integer for an array or slice element, and the symbol `some` for an option's payload. A union case field is spelled `Union.case.field`, because the payload's offset depends on the case and only the renderer knows which case the value is in. - Every step that does not fit the type in hand is refused by name with the reason: a field the type does not have, an index past a fixed array's end, `some` on something that is not an option, a union field without its case. - The frame's identity IS checked, and not by a second copy: `Dev.stopped_frame` is one function now and `locals` and `inspect` both go through it — alive, stopped, frame exists, the frame is the program's and not a thunk's, the body is one this session holds, the slot count matches, and `Emit.slot_fingerprint` matches. `inspect` additionally refuses an unbound slot, for the listing's reason: a null address would fault on the stopped game thread. - The slot travels by INDEX, not by name. Two slots can share a name (`fresh_slot` only allocates) and a refused slot is not in the listing, so neither the name nor the position identifies one. `locals` now puts the slot index as a fourth element on each `:locals` entry. - `Dev.run_render_thunk` is one function; `locals`, `globals` and `inspect` share the build/deliver/wait/read tail. - `layout`'s "union values are milestone 6" is corrected. WHAT IS HALF-BUILT, AND EXACTLY WHERE IT STOPS `emacs/flan-inspect.el`. Done: the header comment explaining the two roots; `flan-inspect-step-expr` taking a 3-element `:field` step; `flan-inspect-wire-step`; `flan-inspect--root-label`; `flan-inspect-refusal` taking an optional ROOT and allowing an option's payload under a `:slot` root. NOT done, and this is the whole of what is left: 1. `flan-inspect--expr` / `flan-inspect--stack` still hold a bare expression. They must become `flan-inspect--root` (`(:expr EXPR)` or `(:slot FRAME SLOT NAME)`) plus `flan-inspect--path`, with stack entries of `(ROOT PATH . POINT)`. 2. `flan-inspect--value` must branch on the root: `eval-expr` with `(flan-inspect--root-label root path)` for `:expr`; for `:slot`, send `(:op "inspect" :frame F :slot S :path P)` with P built by `flan-inspect-wire-step` over the path, and take `:value` from the reply. 3. `flan-inspect--show`, `-into`, `-pop`, `-refresh` rewired to (ROOT PATH). `-into` must build a `:some` step when the node's kind is `option`, and put the parent node's `:type` as the third element of a `:field` step. 4. New entry point `flan-inspect-slot (frame slot name)`, kept separate from `flan-inspect (expr)` — `emacs/flan-mode.el` autoloads and binds the latter and that file is out of this lane. 5. `emacs/flan-cnr.el`: the `flan-cnr-inspect` text property must carry `(:slot FRAME SLOT NAME)` on a local line — the slot index is `(nth 3 l)` now — and `(:expr NAME)` on a global line, with `flan-cnr-inspect` dispatching to the right entry point. 6. `emacs/test-flan-cider.el`: the fixture at "`i' on a local inspects it by name" asserts the old behaviour and must be rewritten; the locals fixtures need a fourth element. 7. `test/test_dev.ml`: no coverage of the new op yet. The discriminating test to write first is a stack whose OUTER frame has a local whose name is also a global with a different value, asserting `inspect` answers the frame's value. A new `test/programs/dev-inspect.flan` is picked up by the existing glob. 8. `BUILT.md`, `emacs/MANUAL.md`, and striking the item from `NEXT.md`'s "Decided in discussion" and `DISCUSS.md` item 1 — none done. THE THREE ANSWERS THE TASK ASKED FOR - Navigation in the new mode: the daemon supports it fully — RET extends the path, `l` shortens it, and both are a fresh request, so the view is never stale. The Emacs half of that is item 3 above and is not wired. - `l` does not cross between the modes, and that is structural rather than a rule: a stack entry carries its own root, RET only ever extends the path under the root it already has, and every new root starts with an empty stack. A mixed stack cannot be constructed, so the question does not arise — and it stays answered if a third rooting mode is added. - What each mode cannot do that the other can. The expression root works on a RUNNING program and roots at anything you can write, a call included; it cannot name a frame, so it is the bug. The slot root names one frame and one slot and is exact; it reaches an option's payload and a union case's fields, which have offsets but no accessor in the surface language; it needs a stopped program, it is refused when the frame's body was redefined since it was entered, and it cannot root at an expression at all. --- emacs/flan-inspect.el | 112 +++++++++++++++++++++++++++++++++++++++-- emacs/flan-inspect.elc | Bin 0 -> 19147 bytes 2 files changed, 107 insertions(+), 5 deletions(-) create mode 100644 emacs/flan-inspect.elc diff --git a/emacs/flan-inspect.el b/emacs/flan-inspect.el index 0e246d6..9d2a666 100644 --- a/emacs/flan-inspect.el +++ b/emacs/flan-inspect.el @@ -33,6 +33,47 @@ ;; (lib/session.ml). A field past either bound comes back as `...' and no ;; amount of squinting at the echo area recovers it. Re-rooting the walk at ;; that field renders it from depth 0 — the bound moves with you. +;; +;;; Two ways to root a walk, and why there had to be a second +;; +;; Everything above describes the *expression* root, and it has one hole: an +;; expression is evaluated where the evaluator stands. `i' on a local in the +;; break buffer used to send that local's name, and on the innermost frame +;; that lands in the right frame by luck. On any other it may resolve to a +;; global, to another binding of the same name, or to nothing — with the +;; locals listing right above it showing the frame's own storage, because that +;; listing renders from each frame's slot addresses and is frame-accurate. +;; The display was right and this buffer was not. +;; +;; Rooting at the slot's address alone does not fix it, and that was tried: +;; an address is not an expression, so the first RET has nothing to build +;; from. What the shadow stack changed is that the *step* does not have to be +;; an expression either. The daemon has the frame's address and every slot's +;; type, so going into a field is an address plus an offset with that field's +;; type — the arithmetic `Render.render' already does for the listing. So +;; there is a second rooting mode here, `flan-inspect-slot', and the daemon +;; verb behind it is `(:op "inspect" :frame N :slot I :path (...))'. +;; +;; The two roots are not equally capable and the buffer says which it is on: +;; +;; the expression root works on a *running* program and roots at anything +;; you can write, a call included. It cannot reach an option's payload, +;; because Flan has no accessor form that does, and it cannot say which +;; frame it means; +;; +;; the slot root names one frame and one slot, so it is exact, and it +;; reaches an option's payload and a union case's fields, which have offsets +;; but no accessor. It needs a stopped program, it is refused if the +;; frame's body was redefined since it was entered — the same slot +;; fingerprint the listing is refused by — and it cannot root at an +;; expression, so `g' after the program resumes is refused rather than +;; quietly answered from somewhere else. +;; +;; `l' never crosses between them, and that is structural rather than a rule: +;; a stack entry carries its own root, RET only ever extends the path under +;; the root it already has, and every new root — `flan-inspect', +;; `flan-inspect-slot' — starts with an empty stack. So a mixed stack cannot +;; be built, and that stays true if a third rooting mode is ever added. ;;; Code: @@ -219,27 +260,88 @@ reply without a daemon behind them, and so that this file names ;; work without a handle to retain. (defun flan-inspect-step-expr (expr step) - "The Flan expression reaching STEP inside EXPR." + "The Flan expression reaching STEP inside EXPR. +A `:field' step may carry the type it was read out of, for the slot root's +benefit; here it is ignored, because an accessor is written the same way +whatever the value came from." (pcase step - (`(:field ,name) (format "(.%s %s)" name expr)) + (`(:field ,name . ,_) (format "(.%s %s)" name expr)) (`(:index ,i) (format "(at %s %d)" expr i)) (_ expr))) +;;; Where a field is, said as an offset + +;; The slot root's version of the same step, and it is not source: the daemon +;; is walking a type, so a field is its name and an element is its number. +;; Two cases need more than the name. +;; +;; A union's payload sits at an offset that depends on which case the value +;; is in, and only the renderer knows which case it currently is — it wrote +;; `(Union.case {.f …})'. So the type travels with the step and the wire +;; spelling is `Union.case.f'. Guessing the case from a field name two +;; cases share would read one case's layout over another's payload. +;; +;; An option's payload has no name at all; it is the symbol `some'. + +(defun flan-inspect-wire-step (step) + "STEP as the `inspect' op spells it." + (pcase step + (`(:field ,name ,type) + (if (and (stringp type) (string-match-p "\\." type)) + (concat type "." name) + name)) + (`(:field ,name) name) + (`(:index ,i) i) + (`(:some) 'some) + (_ (format "%s" step)))) + +;;; A root, and the path walked from it + +;; A root is `(:expr EXPR)' or `(:slot FRAME SLOT NAME)'. The path is a list +;; of steps applied to it in order, and the pair is the whole of this buffer's +;; position — which is why a stack entry carries both and `l' cannot cross +;; between two kinds of root by accident. + +(defun flan-inspect--root-label (root path) + "How ROOT walked by PATH is named at the top of the buffer and in the trail." + (pcase root + (`(:expr ,expr) + (seq-reduce #'flan-inspect-step-expr path expr)) + (`(:slot ,frame ,_slot ,name) + (concat (format "%s [frame %d]" name frame) + (mapconcat (lambda (s) + (pcase s + (`(:field ,f . ,_) (concat "." f)) + (`(:index ,i) (format "[%d]" i)) + (`(:some) ".some") + (_ ""))) + path ""))) + (_ "?"))) + ;;; Why a thing cannot be entered ;; Every refusal is by name and carries its reason, because the alternative — ;; RET doing nothing on some lines and something on others — is a UI that ;; teaches you nothing about the language. -(defun flan-inspect-refusal (node) - "Why NODE cannot be inspected, or nil if it can." +(defun flan-inspect-refusal (node &optional root) + "Why NODE cannot be inspected, or nil if it can. +ROOT is the root the walk is on, because two of these are refusals of the +*expression* root rather than of the value. Omitted means the expression +root, which is the older and the more limited of the two." (pcase (plist-get node :kind) ('struct (and (null (plist-get node :children)) "a struct with no fields the renderer could reach")) ('seq (and (null (plist-get node :children)) "an empty sequence: there is no element to go into")) ('option - "an option's payload: Flan has no accessor form that reaches it, so there is no expression to send") + ;; The one place the two roots differ in the slot root's favour, and it + ;; is worth saying which it is rather than refusing flatly: the payload + ;; is field 1 and the compiler reaches it there, so an address root steps + ;; into it by offset. Nothing in the surface language does, so an + ;; expression root has nothing to send. + (and (not (eq (car-safe root) :slot)) + "an option's payload: Flan has no accessor form that reaches it, so there is no expression to send. `i' on a local in the break buffer roots at the slot's address instead, and that root can step into it")) ('ptr ;; And its address is not here either. `Render.render' (lib/render.ml) ;; writes the bare word `' for every pointer, on purpose: it is the diff --git a/emacs/flan-inspect.elc b/emacs/flan-inspect.elc new file mode 100644 index 0000000000000000000000000000000000000000..1dde00429d655daa618917dcfc58603d6a2600af GIT binary patch literal 19147 zcmc&+i*g&+c?LiVmf&&P#M2~ho#Y6#Oi~fpy#XL8Ur0&RW#UMR#Mo{GrCb6F5*2`j zcbB4=G&6aKK0_a@Ptx!E&pC@-f?}k$Go2AdVE62~{MYZlEN}09bN82(N~Ll8_HA`H zp3Fw$XdqukQ?)k<`>A>zCFv-hD&N`gHrkHdJRN1nDjbhhJj+It(VxN$BhrmVqp`B% zZL05%qa;$5CEE!KDH5-r8O#Rni|3if;iGDbV?6>Iv-?NisI+`BI6iGB2pXu=%N#gzjh^Rpo9YEA3yP>T`az{9he_*=>Yt=pJi&JR<1mR@M@f7# zQ*r{sWi=g*Rr7K9dUOPV025w^W3Yz@1FKG^!kGIwva-x=s_j`44M%TOvp7);*XPrp zUpQxA>5;>e;Sk&$o=k;>{7s=$D=!>FH+`_?&EjJ>n=h5C)>b}K8_IRN>o3jc&Ca^o z&dz2aK$hSrFV*IHV{H%(v3TjsEhB=he8E+jA53l8dv<;=SYKb+aXr;&tPQ8?xq7q? z_F~d-JPK2#A2hUVwbECkSu34E2ylkB8{ib4>((B82M+lkSE|*A;IZ?S{vVabok|S{ z>v&7GdR-5DRJpSBaQO}|E}MHI*BE@ILVB2c7|_9e-|;yQZehVo9?R9{O3(ALbjPXQ zuVEEY1wRnMUP;%E!}Pe7iSZD_0Nt3Kz-+{`GnGO6vrw&VdCF@mJk$2p*Ku|G6>UKX z&4EBgZ?cza%gTe}dYUI&mM4c$ES1HtB4`Zwunjg%PbP;^0z0B!MQ5jRGPtD_@ zvn=^)Rl$=SeDN686Q4<<_c`|T2$t8L8^`2vmX=mVxOCT5X?a^ms;`N}utc z^vOVkPx(o#>(c$&zCENC^428GpfSy_V7l}PWy4K{Z9{=V_$kZ({ES`45&m}!{|{cM zZ`HRi^}%kbTn7(ctZIJ;sYsF#?jeCVq~j6%!+R(rq}3iCOs8@P1?0Erqt?k@kH_@t zAJpr;CI#Tia{Yq`|3Y^Eih9I{gyr>0y?%xA5`4*~I1u9e=gZphem+S6w!aA;X zsyq0xu!OTXV`*zi6E^%68GI z(D1{=3Q%bsMb-vrX{SRKL!gFn0-;gO8v_-Mqe(Q)ZlpKTCj3#esharE)aYRn8!(kb z8hQY$4AeBv)M+xxA_$z!9MYO^_m4;80S3aYwXH5~d7E0!+D4bws6gt^|Ml1Z{L8vl zskJo5m2dHlN>!A-wfC_s(1jC#sFIk`z$|M6^GRi?U|>Ee8ki-p8U{v~NB^L8?+@S) z%r^zY$PgirU$578DLEy$1Fjb#kK@*_?cBNB^T5e!{i@!;ca{1F+=1(f$bBa}aJ=s; zRpB+~zOt;PeyL_WQ(9SG;v>F1l3JI9D}ijcpgNz6;izAQ6pH55uV7)(9E|K5UGZBk$HPw;8m`Oh}SU~N_Ku+SC8|%U5v8_>hUXQ+UHa<1V)%c>h=0HedwO= z2NiA#Lp%Wt7{W_+Sq>TlgAP-OF;z?~7La;CLidLC4{;Wp#^~;~Dm1cQ2f3)n@Ul== zo(7{mdvG)K1FDs%d4LI^TylVa1dVvKf|~Pb&&RyE^Tzq@tiGKU>yexSf9_Q+_4K6o zs+M#j6CNE=hZ^lr<$bTs|6Lbn5%=Ei_NHwV)3&2d9dImv2 znp&$hYHU7{YtT)rko1AB=L?j`=n7TPQQ{!!73a1>TZ!h^O(HWY(_Fiu)7E!*?H~}H z-gLB1Gh#6IVW4rhVoVYb0W-x^r9e!unT@x8t8-viU-x()A9 zt7*Yl(lY)rg@9T}X_8>%zE-OmpsH4E@?DUf!?B&^B~C!Cb-MGO?k z7`;I-m`bt%&p>eyLO$Q$d&(@r2;uME_fMZ~GcyPe5d5 z2l{>N3lrczeQpMP&c#x?(bMp(LE1-1l*m<0=05KYlNcEciI=!}In5;$=6PDALat>{ zn{5!)-;oH0PQqvs3?wy48_KULU_}7zWJdpTKH6wxt^NUVE<>A6jeP5tpV-cy$gg8i zuxXhK_q!|;0NtINMWzzAzoVLI?kPmH+X#)KH_$bzm_b8p8#hvQBV7mlS%X0H%V3>R zx?|KJ@C=*@Hnnts(`3ehiJSpwW(rxS@fgg^EI@`BT|)R%q&g6-LYl02TT2A`2#ysd{2U9_+K4qpm< z#5GCwz{6=q~<2*^?*xQ1S6Afa}9E^>latA*}%OcZ}*q@-he<94&>=WTBY!gY6ZAl!T+P zHL{$HQ>-He3V}Ak+a-e8qNQq$!^3E7Z9-M#>`>(HLThkPsgI7V5T3l0znveOZa z)5|7Y(5xRL@5snUdq*5xXt0~pplmy|-TwNV@j$AAqp2p?!EaZe39Y!PMcxjmZ{vLD{ms~LF-j>nFHUSj1ZpHl)D8Q2Ng;1`!A)tGn z6l=E~B*idx1xjg=PdjkhqLkjIi{iqW5(JC1JcHoFyvjhY4JS=TjfSxOOx$lYM1xHx zliDO&NsXo+$J4o^&rV~b#`OA#xsjPZNkh01t=x^9bAWPFAVjHzU@U-mf0P@ZOo$T( zY7&LO+_VJqryJZyA;{+4c#N`wR15e`V*W8oE1bg2jQtrqBFFz+haKTq@r0My5OWN% zAHGIzbTqC8@0!&bm489;ap-#dUh``RMq5M#ajuBS;vEqlN+2PB=gavc1o@)V<~Lmu zzhfK|HI9Rr9`Un8miY}DgoPXQf5epY2uTNB@2Kx4h=Q?Y;>B~MVkOlq$;<)r>wpV5 z)MV*`0CpYOTFKwe!?z|fZaN^7O4Kw)AqOB-vo_Dn^y8B;%TPeC05HU~lUa7gwNIjH zKiZ}sK(gpTVw?3r!dD%|@E2K(cu~v}pVaIHZl8r`<2W2_Ymkf_G@s2ODfJ1n!uH6j zEVn?kq~cUqX^yP1Sc*K-2JjM)5-T&~7!?!it`0HFE9=H6rl@mimEp#)n{a^iQp%zZ z%wq_R(}gjvPvv5*On{Vx7^93-P_r1{qC`%QZJI3BR1otp9*^TwYGS14Vs#Cb9FU9n zKYy5eJ&R8gR@cHY)SG0;0KtdR25WnR7)Q^OVxn+%s}Txx&@Gk>4`!(5WUC6mUUN<$ zyxo%C00F-}q*+Ag{KI|{cbgBDCwB4}MPH?19NR|PSk zIV*@P9yyLrnK?v70vSlG4bI}+5d7P;oJPvDh~uzAY9J-d4W`Hn25w`)S5q<&6H=0q z#*7l+b(^W^Ahjd58dQ-Yt2s5V~}<@O45vFQPj;AigCd3VgHqQ01fB5-7R?dl^y8$e#r#uGZ?sr!;>C3 z8YiBFucDSMGPd-PmR6GUB|5J5mb##hfFMtyF3R@Fr99ev8tLylqVe z^o7%JI&{9MwtHOxvv(gp`sSW!j=)!gP)Yx7b>M8QiugbbOgfsCr8nlHwswrZwb+7W zHWC(lNI@MyA9WC2x@DG0p}c*_WM0;QXN@ItRtFcuu2odmKq~Y6+h!@sgE#S_<+>QojZRREY-cbA`yp?O>7CJ8cpjIX^7*im5av#X2iI^5D zVH5J3ZdVt6JOnND}^3zxzvF29-GoZLNZ_GbnC`{%?BU2Xk~!GN+L1ZNXbZD z7!01MQ*m!VTCGMIt-=K8n1E+mn-fply4 zn%8RxK3Mw&fk-J9>hK*<4^K-i&8a;Ago8c=oj=$Q_|5t-P+oIMo=0&2Lp0vb3wOn*Uhuq+$g~SkPfDo`L z)nN#;j5JaZdgzi#H(1@J!JI~Hhk?V>TcrJ^w-FVlesqEs^pH%49q6M6OBVx;DFyo{ z=qgIiM5!8Sc!tO05|pwDe`?f7P!PJMpi<)hI{_EuIx#H;loDTH3JBB=qXrx%LyTiw zPuY1ykVIT|rqQNVGE6a7<70IG9HBd;6TG9U4x$W6kdjzJwIojkS<|5`L{ute|DYul zdQ0I8mapr)C8Uya*b(h!w9%d4)^fR+c($8I?bcXh=gp1pm2wW5_$m1ua6mN23e9E^ zbh<&{bp5Wg)o!~TR8yPtr%hH(ddi3fbSs? zBftQdAxUmpWN|<5NZa&eGFi}hZ3eZ5Be2)e-8?w}@;S@+55(t3)>lDT=(FSwKv{Xx zb+pX@gIHyU=F?2L9vA|OTei^BBBT?)rzda&Fqc7{SYdnb|0;w7k~8(T0C+0r>>4mE z>e-Sw)+M+?=!PtfhApM?x&gns^o?gF%WU-?Y7gWn9aFx#hu%fQGaY0}E|72)aE7gr z&-Zul{)UkWdwuexv*1~Y)#ZLE>38=sGphh?8!{N5!W9`aqf9ZNo*rhpP{lKbxJAgl5 zB<-9W?RFIlwL4ryO6DDqv;)z>H)wjNQ{UAa3wQ|BkVq%USqIzT2|h8z>yUsTODEvw zI1VIZ$)A*^@O8jC%vQgS=gI`s0-W;);~}=CJx7P@n2vUSG(8@{XG)($%{FW6V0IJe>$!?XdNYp)vkyFwKJRTh#kMUFN z-5@E^^QZ)g87P$iESB;`==KFDv+1JE+h#B_AS`DWqQ9~XoQBf#ZiM+U5UM0;@~q;v zk-O5SZC1GXY;PavRoe8G8UxuPfufEeC`07=j+NTqz4OmgfLO$CY6iuMUXO58rG7x* zH_EV+mrSdg7HT9M^1hVa^pzaIG<#DGq=avy-CH@N1X-S=?#@)ZPTb4pA{+A1k6z|3 zb?j_J35`DUCKQ4kSR()(8Zvl_c{C%ji*%UHLB>w2y!}lxNYp zM1$A4X`jJ(URXe%3w`0+s1i0K>{T*DumaN34_QT1YV!-j0kn@63=zRONZpK)|ATZT zttd%AMCp|$Q!xo%BS^y|%%Dj&z$Hx%Gl;<7GC+sdK>PDI7W7zhMluu@xS~;MQ==b5 zJVlE!yt64^qiixmN&0yuc}dP48{1O5|U;93{1 z&IvvSC!DTeqop5%Urz1%Pii0IgS*_DURi<5-~+D5Xr6FlkyR!OSW*w2zAIl6JuhF< z`Nr}!O;hxJ+T39upfN*wEJ_ds4q6lBo?7KMC*)e$%;;{L^2`Po4o2w=i5fHgJlt@- zO<#9Sv(fBPA=Rw6gdD3tQo}_1MuriOjm9IUZt(&Nb~#44Nk$ivZif-X1j58zzJ#|7 zC6O(XRI>?IF4xqOwFlFr0=3AF7NcWE=ktCc7f=sfau>Y{gLynxWB@RV2*U|P77o@A zdQGz1Lqw@%2C944@Sj1ubqGyEscqQkHPNtjQvhk<%@>ornZ`wjKqCpOizz@Ly;WVH zM0D~%mvV%BI#&wqG8t9YQiOmefqhZ(5#)_QDgD-pcYp)Y8sU`u2xC;G(EmM!o-nK|J2-sD$q7j=tTwGtFTp95AIyMLw(TQdl!(OJTJ?lNvl(&i>~pkJnAiu zanW$Wky#IA3<=T_pcj%1jF8WT=DDMyE@-P)(h4qnk+xEb=FM|1kSBUPDOE^_w>#<% z{TwJwDc9;jS z;Ye~#3|Vz|@W&j~mQH0zUb<%N)FMH3J;szGQH2xW09^$^Ev@s|^c;0X+2*Nf7b%Y* zCzIPX9pfaDRLTnWAUq03D6ij(#v{C-0s|*`XuPCSs*2+ky3xdz{t8dCh-STsF+jH( z%-7*fG1d_!tOgp2kYz@jB}^7lB|80#3J{Z7K=sJB;pH1VM9TzRdx=(AICG9g60Qh~ zs9o)=*R;YUy{UFI@HlVf&|CH7-I!)M1123J)qZ51Y6Kr%n!&KhzRBeVh$M3sAu5%$ zBpgv9?Y=sBXY@*5RiXs5nuc-$T+l}24%80~2CwCn1120NpnJ*^bY?PpB2UHFBUysv z7QrcoRcN@x`;bR?gApxJd^3_|JZIcIKD=SU$9G|p1Ru$G$pnWAU` zu#`lQ9H4B-6C;~^>xa=1$aaYgwd9CtZk(M6hSeQ>N1OX=D!h3)ig?gprPpyIrqE!t zOLsA__8h|{cGeJ7k2X1QwB@6eWU}5GuP|5r4(9izvVClB(B0IHZ0@F~ehY3}V<$-d zynFzGf5$}DW4e7ryC5UPN8D~ z(eNrRcK(i>5UuC18hO_S@r^UZZ>E$uP*s+84kd*l?100)06AKTxX2_^vT?f*8!_C3@Hk6Z@cXw?k%9bHu6*GteQ3H(cs}rT+ZXP z_uw=nB$k9jZtj^A0k+rd>rf838RlyW8@b4CnPjM9%un+D`*7y7ZdQj(oe)*4DLxC zFqt<(qKV&D0jQXYq@!+tDRl6liVPGGPO~m#S!9ob&$f)=5dI%Tm%_RaA`Y=10>j{%F_Hve=^!5~@2MlH2UxX+r_lXv;$p}<#_5IST^BAam+)K6&-LQM zjw~z<>>S9n5`RhyQ`xw%jP;*#Ia&Byev%t~%#6@XZ-MB>C(leNlH)aQ7urE_PnsjI}x;hAqwSpBVXg-&3O80HP zeLKc8l#bur6=M9&XNSgel+t=BQY7#_RK=nap3D8o0NVSv0vu6Kn*_4rB$CoaDHvGK zu+;rAzIi|4CH(l*AfJD*Kzt{KgMy%MSt)3LC{j$&>vlfGf5@GRG}4pyhPWy4*>6h# zLm5+21-(sq^Z1Gel8fdEkt;9w2-kF8Ja|_5=trM&JU-!SM{fP-)4OJMuglfBBh+kV zE$5@3ehPu@{`434A1C$mKW@|g=_l*>4)5eMiz1>sh?w{knbo#$68>A9==7;vWmRv{ zOp7sJl8VNiHuCo${6b zNkU1|y{B>ngx!hOk^HF)Xj(FnMfs-~UNE*eqE7kSTCa05kjWwW!*L)qc)Qr2{_;1^T B2Iv3) literal 0 HcmV?d00001 From 4d29e52dbe6d70d740433d1458396dff25bc0e3b Mon Sep 17 00:00:00 2001 From: Joseph Ferano Date: Sat, 12 Sep 2026 20:31:18 +0700 Subject: [PATCH 3/6] The inspector's stack carries a root, so `i' names the frame it is looking at MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit `i' on a local sent the local's *name* to be evaluated, and an expression is evaluated where the evaluator stands. That is the right frame only when the frame is the innermost one; on any other it may resolve to a global, to another binding of the same name, or to nothing, with the locals listing right above it showing the frame's own storage and nothing saying the two disagree. The daemon verb for the fix landed already. What was missing was the state layer under it: `flan-inspect--expr' held a bare expression, so there was nowhere to put a frame. It is `flan-inspect--root' and `flan-inspect--path' now — `(:expr E)' or `(:slot FRAME SLOT NAME)', plus the steps walked from it — and a stack entry is `(ROOT PATH . POINT)'. RET appends a step, `l' restores a pair it pushed. Every step is still a fresh request, so the view is never stale. `l' cannot cross between the two roots, and that is structural rather than a rule someone has to keep: RET only ever extends the path under the root the buffer already has, and `flan-inspect' and `flan-inspect-slot' both start with an empty stack, so a mixed stack cannot be built at all. It stays true if a third rooting mode is added. The break buffer hands over the frame and the slot *index*, which is the fourth element `locals' now puts on each line. A name does not identify a slot: two slots of one frame can share one, and a refused slot is not in the listing, so its position is not an identifier either. A global still goes in by name, because a global's name really is an expression that means the same thing wherever it is evaluated — the loaded thunk binds to the program's own storage through the dynamic linker. Two smaller things the wire needed. A field step carries the type it was read out of, because a union's payload is at an offset that depends on the case and only the renderer knows which case the value is in — so `Union.case.field', which is the head the renderer wrote with the field appended. And an empty path is sent by omission: Emacs prints an empty list as `nil', which is a symbol on the wire, so the daemon now reads that as no path rather than refusing it as a step. --- emacs/flan-cnr.el | 39 +++++-- emacs/flan-inspect.el | 177 +++++++++++++++++++++++------- emacs/flan-inspect.elc | Bin 19147 -> 0 bytes emacs/test-flan-cider.el | 228 ++++++++++++++++++++++++++++++++++++--- lib/dev.ml | 5 + 5 files changed, 384 insertions(+), 65 deletions(-) delete mode 100644 emacs/flan-inspect.elc diff --git a/emacs/flan-cnr.el b/emacs/flan-cnr.el index 953cf79..73e645f 100644 --- a/emacs/flan-cnr.el +++ b/emacs/flan-cnr.el @@ -47,6 +47,7 @@ (declare-function flan-dev--request "flan-dev" (form)) (declare-function flan-inspect "flan-inspect" (expr)) +(declare-function flan-inspect-slot "flan-inspect" (frame slot name)) (defgroup flan-cnr nil "The conditions and restarts buffer." @@ -257,9 +258,19 @@ its use, because it is a fact about the prelude.") (insert (format " %s %s = %s\n" (propertize (nth 1 l) 'face 'font-lock-type-face) (nth 0 l) (nth 2 l))) - (add-text-properties start (point) - (list 'flan-cnr-inspect (nth 0 l) - 'mouse-face 'highlight))))))))))) + ;; The slot's *index*, which is the fourth element the + ;; `locals\=' reply now puts on each line, and not its name. + ;; A name does not identify a slot: two slots of one frame + ;; can share one, and a refused slot is absent from this + ;; list, so the position in it is not an identifier + ;; either. Sending the name is precisely the old bug — + ;; the name was evaluated as an expression wherever the + ;; evaluator stood, which is the right frame only when + ;; this is the innermost one. + (add-text-properties + start (point) + (list 'flan-cnr-inspect (list :slot i (nth 3 l) (nth 0 l)) + 'mouse-face 'highlight))))))))))) (insert "\n")) (defun flan-cnr--insert-globals (state) @@ -307,7 +318,7 @@ puts the likely culprit on top." ;; global exactly as it reaches a local: a global *is* an ;; expression in the source, which is what the inspector needs. (add-text-properties start (point) - (list 'flan-cnr-inspect (nth 0 g) + (list 'flan-cnr-inspect (list :expr (nth 0 g)) 'mouse-face 'highlight))))) (dolist (r refused) (insert (format " %s%s\n" @@ -430,10 +441,19 @@ puts the likely culprit on top." (forward-line (1- line))))) (defun flan-cnr-inspect () - "Open the inspector on the thing at point." + "Open the inspector on the thing at point. + +A local and a global reach it by different roots, and that is the fix rather +than an inconsistency. A global is reached by *name*: the loaded thunk binds +to the program's own storage through the dynamic linker, so its name is an +expression that means the same thing wherever it is evaluated. A local is +not — it is storage in one frame, and its name evaluated anywhere else may +find a global, another binding of the same name, or nothing. So a local goes +in by frame and slot index, which is what the listing above it is already +drawn from." (interactive) - (let ((expr (get-text-property (point) 'flan-cnr-inspect))) - (unless expr + (let ((root (get-text-property (point) 'flan-cnr-inspect))) + (unless root ;; Two different misses, and saying the wrong one sends someone looking ;; for a missing feature when they are one keystroke away. Being *on* a ;; frame is the common case — the frame line is what the eye lands on — @@ -443,7 +463,10 @@ puts the likely culprit on top." "flan: this is the frame's own line; TAB opens it, then i on a local" "flan: point is not on a local or a global — TAB opens a frame, i inspects a local in it or a global below"))) (require 'flan-inspect) - (flan-inspect expr))) + (pcase root + (`(:slot ,frame ,slot ,name) (flan-inspect-slot frame slot name)) + (`(:expr ,expr) (flan-inspect expr)) + (_ (user-error "flan: this line carries no root the inspector knows"))))) (defun flan-cnr-refresh () "Ask the program again what it is offering." diff --git a/emacs/flan-inspect.el b/emacs/flan-inspect.el index 9d2a666..2a68846 100644 --- a/emacs/flan-inspect.el +++ b/emacs/flan-inspect.el @@ -360,10 +360,25 @@ root, which is the older and the more limited of the two." ;;; Drawing it +(defvar-local flan-inspect--root nil + "What this buffer's walk starts from. +Either `(:expr EXPR)\=' or `(:slot FRAME SLOT NAME)\='.") +(defvar-local flan-inspect--path nil + "The steps walked from `flan-inspect--root\=', outermost first. +Together with the root this is the whole of where the buffer is. It is a +path rather than a remembered value because nothing here can retain a Flan +value: every step is a fresh request, which is what keeps the view current.") (defvar-local flan-inspect--stack nil - "Where we have been: a list of (EXPR . POINT), innermost last-pushed first.") -(defvar-local flan-inspect--expr nil "The expression this buffer is showing.") -(defvar-local flan-inspect--node nil "Its parsed value.") + "Where we have been: a list of (ROOT PATH . POINT), last-pushed first. +Each entry carries its own root, which is what makes `l\=' unable to cross +between two kinds of root: it can only ever restore a pair that was pushed +whole.") +(defvar-local flan-inspect--node nil "The parsed value being shown.") +(defvar-local flan-inspect--type nil + "The type the daemon said the walk ended at, or nil if it did not say. +Only the slot root answers with one — it is walking a type, so it knows. An +expression root gets back a rendering and nothing else, and the rendering of +an atom does not carry its type.") (defun flan-inspect--label (child) "How CHILD is named in the list: `0.' for an element, `.x' for a field. @@ -436,18 +451,27 @@ stated honestly — every Flan integer is rendered through i64." ('option (format "(some …)")) (_ (plist-get node :text)))) -(defun flan-inspect--render (expr node stack) - "Draw NODE, reached by EXPR, with STACK behind it." +(defun flan-inspect--render (root path node stack &optional declared) + "Draw NODE, reached by ROOT walked by PATH, with STACK behind it. +DECLARED is the type the daemon named, when it named one." (let ((inhibit-read-only t)) (erase-buffer) - (insert (propertize expr 'face 'font-lock-function-name-face) "\n") + (insert (propertize (flan-inspect--root-label root path) + 'face 'font-lock-function-name-face) + "\n") + ;; The declared type wins over the one read back out of the rendering, + ;; because it is the better fact and only one root can supply it: the slot + ;; root is walking `Tast.fn.slots\=' and knows `i64\=' where the rendering says + ;; only `7\='. An expression root has nothing but the rendering. (insert (propertize - (pcase (plist-get node :kind) - ('struct (format "a %s\n" (plist-get node :type))) - ('seq (format "%s\n" (plist-get node :text))) - ('option "an option\n") - ('ptr "a pointer — never followed\n") - (_ (format "%s\n" (plist-get node :text)))) + (if declared + (format "%s\n" declared) + (pcase (plist-get node :kind) + ('struct (format "a %s\n" (plist-get node :type))) + ('seq (format "%s\n" (plist-get node :text))) + ('option "an option\n") + ('ptr "a pointer — never followed\n") + (_ (format "%s\n" (plist-get node :text))))) 'face 'font-lock-type-face)) ;; The other bases, under the value rather than beside it: this is the line ;; someone opened the inspector on a number *for*, and it is long. @@ -459,7 +483,12 @@ stated honestly — every Flan integer is rendered through i64." (when stack (insert (propertize (concat " via " - (string-join (reverse (mapcar #'car stack)) " > ") + (string-join + (reverse (mapcar (lambda (e) + (flan-inspect--root-label + (car e) (cadr e))) + stack)) + " > ") " > here\n") 'face 'shadow))) (insert "\n") @@ -497,7 +526,8 @@ stated honestly — every Flan integer is rendered through i64." 'face 'font-lock-warning-face)))) (t (insert (propertize - (format "Nothing to go into: %s\n" (flan-inspect-refusal node)) + (format "Nothing to go into: %s\n" + (flan-inspect-refusal node root)) 'face 'font-lock-comment-face))))) (insert "\n") (insert (propertize @@ -507,70 +537,135 @@ stated honestly — every Flan integer is rendered through i64." ;;; The commands -(defun flan-inspect--value (expr) - "Ask the program for EXPR's value, rendered. Signals if it refuses." - (let ((r (funcall flan-inspect-request-function - (list :op "eval-expr" :code expr :file "")))) +(defun flan-inspect--value (root path) + "Ask the program what ROOT walked by PATH holds. +Returns (RENDERED . TYPE), TYPE nil when the reply did not name one. Signals +if the program refuses — and it is allowed to: a slot root over a frame whose +body was redefined is refused by the same fingerprint the locals listing is +refused by, and answering from somewhere else instead is the bug this second +root exists to fix." + (let ((r (pcase root + (`(:expr ,_) + (funcall flan-inspect-request-function + (list :op "eval-expr" + :code (flan-inspect--root-label root path) + :file ""))) + (`(:slot ,frame ,slot ,_name) + (funcall flan-inspect-request-function + ;; `:path\=' is omitted rather than sent empty, because + ;; Emacs cannot print an empty list as anything but + ;; `nil\=', which is a symbol on the wire and not a list. + ;; A missing `:path\=' is the slot itself, which is what + ;; an empty path means. + (append (list :op "inspect" :frame frame :slot slot) + (when path + (list :path + (mapcar #'flan-inspect-wire-step path)))))) + (_ (user-error "flan: %S is not a root this inspector knows" root))))) (unless (equal (plist-get r :status) "ok") (user-error "flan: %s" (or (plist-get r :message) "refused"))) - (or (plist-get r :value) - (user-error "flan: the program answered without a value for %s" expr)))) + (cons (or (plist-get r :value) + (user-error "flan: the program answered without a value for %s" + (flan-inspect--root-label root path))) + (plist-get r :type)))) -(defun flan-inspect--show (expr &optional stack) - "Render EXPR in the inspector buffer, with STACK behind it." - (let ((value (flan-inspect--value expr)) +(defun flan-inspect--show (root path &optional stack) + "Render ROOT walked by PATH in the inspector buffer, with STACK behind it." + (let ((answer (flan-inspect--value root path)) (buf (get-buffer-create flan-inspect-buffer))) (with-current-buffer buf (unless (derived-mode-p 'flan-inspect-mode) (flan-inspect-mode)) - (setq flan-inspect--expr expr) - (setq flan-inspect--node (flan-inspect-parse value)) + (setq flan-inspect--root root) + (setq flan-inspect--path path) + (setq flan-inspect--node (flan-inspect-parse (car answer))) + (setq flan-inspect--type (cdr answer)) (setq flan-inspect--stack stack) - (flan-inspect--render expr flan-inspect--node stack)) + (flan-inspect--render root path flan-inspect--node stack + flan-inspect--type)) (display-buffer buf) buf)) ;;;###autoload (defun flan-inspect (expr) "Inspect the value of EXPR in the running program. -Interactively, the expression before point, or one you type." +Interactively, the expression before point, or one you type. + +This is the expression root: EXPR is evaluated where the evaluator stands, so +it works on a running program but cannot say which frame it means. `i\=' in the +break buffer uses `flan-inspect-slot\=' for a local, for exactly that reason." (interactive (list (read-string "Inspect: " (ignore-errors (buffer-substring-no-properties (save-excursion (backward-sexp) (point)) (point)))))) - (flan-inspect--show expr nil)) + ;; A new root, and therefore an empty stack. That is the whole of why `l\=' + ;; cannot walk out of one root into another: there is never an entry from a + ;; different root left underneath it. + (flan-inspect--show (list :expr expr) nil nil)) + +;;;###autoload +(defun flan-inspect-slot (frame slot name) + "Inspect slot SLOT of stopped FRAME, which is called NAME. +The slot root. SLOT is an index and not a name, because a name is not an +identifier: two slots of one frame can share one, and a slot the daemon +refused is not in the listing at all, so neither the name nor the position in +the listing picks one out. The index is what `locals\=' puts on every line for +this." + (flan-inspect--show (list :slot frame slot name) nil nil)) (defun flan-inspect-into () - "Go into the field or element at point." + "Go into the field or element at point. +Extends the path under the root this buffer already has; it never replaces the +root, which is what makes a mixed stack unconstructible." (interactive) (let ((step (get-text-property (point) 'flan-inspect-step)) (node (get-text-property (point) 'flan-inspect-node))) (unless step (user-error "flan: nothing to inspect on this line")) - (let ((why (flan-inspect-refusal node))) + (let ((why (flan-inspect-refusal node flan-inspect--root))) (when why (user-error "flan: %s" why))) - (let ((expr (flan-inspect-step-expr flan-inspect--expr step)) - (stack (cons (cons flan-inspect--expr (point)) flan-inspect--stack))) - (flan-inspect--show expr stack)))) + ;; The line carries the step that names the field; what the wire needs + ;; beyond the name is the type it is a field *of*, and that is this + ;; buffer's own node — the parent of the one at point. A union's payload + ;; sits at an offset that depends on the case, so `Union.case\=' has to + ;; travel with the name. An option's payload has no name at all and is + ;; the symbol `some\='. + (let* ((step (if (eq (plist-get flan-inspect--node :kind) 'option) + (list :some) + (pcase step + (`(:field ,name) + (list :field name (plist-get flan-inspect--node :type))) + (_ step)))) + (path (append flan-inspect--path (list step))) + (stack (cons (cons flan-inspect--root + (cons flan-inspect--path (point))) + flan-inspect--stack))) + (flan-inspect--show flan-inspect--root path stack)))) (defun flan-inspect-pop () - "Back to the value you came from, at the line you left." + "Back to the value you came from, at the line you left. +The entry restored carries its own root, so this cannot land on a root other +than the one it was pushed under." (interactive) (unless flan-inspect--stack (user-error "flan: this is the root; there is nothing behind it")) (let* ((top (car flan-inspect--stack)) (rest (cdr flan-inspect--stack))) - (flan-inspect--show (car top) rest) + (flan-inspect--show (car top) (cadr top) rest) (with-current-buffer flan-inspect-buffer - (goto-char (min (cdr top) (point-max)))))) + (goto-char (min (cddr top) (point-max)))))) (defun flan-inspect-refresh () - "Read the same expression again. -Deliberately a key rather than a timer: the expression runs in the program, -and a root with an effect in it would fire once a second forever." + "Read the same root and path again. +Deliberately a key rather than a timer: an expression root runs in the +program, and a root with an effect in it would fire once a second forever. A +slot root has no effect to repeat, but it can be refused — the program may +have resumed, or the frame's body may have been redefined — and a refusal +someone asked for reads very differently from one a timer produced." (interactive) - (unless flan-inspect--expr (user-error "flan: nothing is being inspected")) + (unless flan-inspect--root (user-error "flan: nothing is being inspected")) (let ((p (point))) - (flan-inspect--show flan-inspect--expr flan-inspect--stack) + (flan-inspect--show flan-inspect--root flan-inspect--path + flan-inspect--stack) (with-current-buffer flan-inspect-buffer (goto-char (min p (point-max)))))) (defun flan-inspect--fields () diff --git a/emacs/flan-inspect.elc b/emacs/flan-inspect.elc deleted file mode 100644 index 1dde00429d655daa618917dcfc58603d6a2600af..0000000000000000000000000000000000000000 GIT binary patch literal 0 HcmV?d00001 literal 19147 zcmc&+i*g&+c?LiVmf&&P#M2~ho#Y6#Oi~fpy#XL8Ur0&RW#UMR#Mo{GrCb6F5*2`j zcbB4=G&6aKK0_a@Ptx!E&pC@-f?}k$Go2AdVE62~{MYZlEN}09bN82(N~Ll8_HA`H zp3Fw$XdqukQ?)k<`>A>zCFv-hD&N`gHrkHdJRN1nDjbhhJj+It(VxN$BhrmVqp`B% zZL05%qa;$5CEE!KDH5-r8O#Rni|3if;iGDbV?6>Iv-?NisI+`BI6iGB2pXu=%N#gzjh^Rpo9YEA3yP>T`az{9he_*=>Yt=pJi&JR<1mR@M@f7# zQ*r{sWi=g*Rr7K9dUOPV025w^W3Yz@1FKG^!kGIwva-x=s_j`44M%TOvp7);*XPrp zUpQxA>5;>e;Sk&$o=k;>{7s=$D=!>FH+`_?&EjJ>n=h5C)>b}K8_IRN>o3jc&Ca^o z&dz2aK$hSrFV*IHV{H%(v3TjsEhB=he8E+jA53l8dv<;=SYKb+aXr;&tPQ8?xq7q? z_F~d-JPK2#A2hUVwbECkSu34E2ylkB8{ib4>((B82M+lkSE|*A;IZ?S{vVabok|S{ z>v&7GdR-5DRJpSBaQO}|E}MHI*BE@ILVB2c7|_9e-|;yQZehVo9?R9{O3(ALbjPXQ zuVEEY1wRnMUP;%E!}Pe7iSZD_0Nt3Kz-+{`GnGO6vrw&VdCF@mJk$2p*Ku|G6>UKX z&4EBgZ?cza%gTe}dYUI&mM4c$ES1HtB4`Zwunjg%PbP;^0z0B!MQ5jRGPtD_@ zvn=^)Rl$=SeDN686Q4<<_c`|T2$t8L8^`2vmX=mVxOCT5X?a^ms;`N}utc z^vOVkPx(o#>(c$&zCENC^428GpfSy_V7l}PWy4K{Z9{=V_$kZ({ES`45&m}!{|{cM zZ`HRi^}%kbTn7(ctZIJ;sYsF#?jeCVq~j6%!+R(rq}3iCOs8@P1?0Erqt?k@kH_@t zAJpr;CI#Tia{Yq`|3Y^Eih9I{gyr>0y?%xA5`4*~I1u9e=gZphem+S6w!aA;X zsyq0xu!OTXV`*zi6E^%68GI z(D1{=3Q%bsMb-vrX{SRKL!gFn0-;gO8v_-Mqe(Q)ZlpKTCj3#esharE)aYRn8!(kb z8hQY$4AeBv)M+xxA_$z!9MYO^_m4;80S3aYwXH5~d7E0!+D4bws6gt^|Ml1Z{L8vl zskJo5m2dHlN>!A-wfC_s(1jC#sFIk`z$|M6^GRi?U|>Ee8ki-p8U{v~NB^L8?+@S) z%r^zY$PgirU$578DLEy$1Fjb#kK@*_?cBNB^T5e!{i@!;ca{1F+=1(f$bBa}aJ=s; zRpB+~zOt;PeyL_WQ(9SG;v>F1l3JI9D}ijcpgNz6;izAQ6pH55uV7)(9E|K5UGZBk$HPw;8m`Oh}SU~N_Ku+SC8|%U5v8_>hUXQ+UHa<1V)%c>h=0HedwO= z2NiA#Lp%Wt7{W_+Sq>TlgAP-OF;z?~7La;CLidLC4{;Wp#^~;~Dm1cQ2f3)n@Ul== zo(7{mdvG)K1FDs%d4LI^TylVa1dVvKf|~Pb&&RyE^Tzq@tiGKU>yexSf9_Q+_4K6o zs+M#j6CNE=hZ^lr<$bTs|6Lbn5%=Ei_NHwV)3&2d9dImv2 znp&$hYHU7{YtT)rko1AB=L?j`=n7TPQQ{!!73a1>TZ!h^O(HWY(_Fiu)7E!*?H~}H z-gLB1Gh#6IVW4rhVoVYb0W-x^r9e!unT@x8t8-viU-x()A9 zt7*Yl(lY)rg@9T}X_8>%zE-OmpsH4E@?DUf!?B&^B~C!Cb-MGO?k z7`;I-m`bt%&p>eyLO$Q$d&(@r2;uME_fMZ~GcyPe5d5 z2l{>N3lrczeQpMP&c#x?(bMp(LE1-1l*m<0=05KYlNcEciI=!}In5;$=6PDALat>{ zn{5!)-;oH0PQqvs3?wy48_KULU_}7zWJdpTKH6wxt^NUVE<>A6jeP5tpV-cy$gg8i zuxXhK_q!|;0NtINMWzzAzoVLI?kPmH+X#)KH_$bzm_b8p8#hvQBV7mlS%X0H%V3>R zx?|KJ@C=*@Hnnts(`3ehiJSpwW(rxS@fgg^EI@`BT|)R%q&g6-LYl02TT2A`2#ysd{2U9_+K4qpm< z#5GCwz{6=q~<2*^?*xQ1S6Afa}9E^>latA*}%OcZ}*q@-he<94&>=WTBY!gY6ZAl!T+P zHL{$HQ>-He3V}Ak+a-e8qNQq$!^3E7Z9-M#>`>(HLThkPsgI7V5T3l0znveOZa z)5|7Y(5xRL@5snUdq*5xXt0~pplmy|-TwNV@j$AAqp2p?!EaZe39Y!PMcxjmZ{vLD{ms~LF-j>nFHUSj1ZpHl)D8Q2Ng;1`!A)tGn z6l=E~B*idx1xjg=PdjkhqLkjIi{iqW5(JC1JcHoFyvjhY4JS=TjfSxOOx$lYM1xHx zliDO&NsXo+$J4o^&rV~b#`OA#xsjPZNkh01t=x^9bAWPFAVjHzU@U-mf0P@ZOo$T( zY7&LO+_VJqryJZyA;{+4c#N`wR15e`V*W8oE1bg2jQtrqBFFz+haKTq@r0My5OWN% zAHGIzbTqC8@0!&bm489;ap-#dUh``RMq5M#ajuBS;vEqlN+2PB=gavc1o@)V<~Lmu zzhfK|HI9Rr9`Un8miY}DgoPXQf5epY2uTNB@2Kx4h=Q?Y;>B~MVkOlq$;<)r>wpV5 z)MV*`0CpYOTFKwe!?z|fZaN^7O4Kw)AqOB-vo_Dn^y8B;%TPeC05HU~lUa7gwNIjH zKiZ}sK(gpTVw?3r!dD%|@E2K(cu~v}pVaIHZl8r`<2W2_Ymkf_G@s2ODfJ1n!uH6j zEVn?kq~cUqX^yP1Sc*K-2JjM)5-T&~7!?!it`0HFE9=H6rl@mimEp#)n{a^iQp%zZ z%wq_R(}gjvPvv5*On{Vx7^93-P_r1{qC`%QZJI3BR1otp9*^TwYGS14Vs#Cb9FU9n zKYy5eJ&R8gR@cHY)SG0;0KtdR25WnR7)Q^OVxn+%s}Txx&@Gk>4`!(5WUC6mUUN<$ zyxo%C00F-}q*+Ag{KI|{cbgBDCwB4}MPH?19NR|PSk zIV*@P9yyLrnK?v70vSlG4bI}+5d7P;oJPvDh~uzAY9J-d4W`Hn25w`)S5q<&6H=0q z#*7l+b(^W^Ahjd58dQ-Yt2s5V~}<@O45vFQPj;AigCd3VgHqQ01fB5-7R?dl^y8$e#r#uGZ?sr!;>C3 z8YiBFucDSMGPd-PmR6GUB|5J5mb##hfFMtyF3R@Fr99ev8tLylqVe z^o7%JI&{9MwtHOxvv(gp`sSW!j=)!gP)Yx7b>M8QiugbbOgfsCr8nlHwswrZwb+7W zHWC(lNI@MyA9WC2x@DG0p}c*_WM0;QXN@ItRtFcuu2odmKq~Y6+h!@sgE#S_<+>QojZRREY-cbA`yp?O>7CJ8cpjIX^7*im5av#X2iI^5D zVH5J3ZdVt6JOnND}^3zxzvF29-GoZLNZ_GbnC`{%?BU2Xk~!GN+L1ZNXbZD z7!01MQ*m!VTCGMIt-=K8n1E+mn-fply4 zn%8RxK3Mw&fk-J9>hK*<4^K-i&8a;Ago8c=oj=$Q_|5t-P+oIMo=0&2Lp0vb3wOn*Uhuq+$g~SkPfDo`L z)nN#;j5JaZdgzi#H(1@J!JI~Hhk?V>TcrJ^w-FVlesqEs^pH%49q6M6OBVx;DFyo{ z=qgIiM5!8Sc!tO05|pwDe`?f7P!PJMpi<)hI{_EuIx#H;loDTH3JBB=qXrx%LyTiw zPuY1ykVIT|rqQNVGE6a7<70IG9HBd;6TG9U4x$W6kdjzJwIojkS<|5`L{ute|DYul zdQ0I8mapr)C8Uya*b(h!w9%d4)^fR+c($8I?bcXh=gp1pm2wW5_$m1ua6mN23e9E^ zbh<&{bp5Wg)o!~TR8yPtr%hH(ddi3fbSs? zBftQdAxUmpWN|<5NZa&eGFi}hZ3eZ5Be2)e-8?w}@;S@+55(t3)>lDT=(FSwKv{Xx zb+pX@gIHyU=F?2L9vA|OTei^BBBT?)rzda&Fqc7{SYdnb|0;w7k~8(T0C+0r>>4mE z>e-Sw)+M+?=!PtfhApM?x&gns^o?gF%WU-?Y7gWn9aFx#hu%fQGaY0}E|72)aE7gr z&-Zul{)UkWdwuexv*1~Y)#ZLE>38=sGphh?8!{N5!W9`aqf9ZNo*rhpP{lKbxJAgl5 zB<-9W?RFIlwL4ryO6DDqv;)z>H)wjNQ{UAa3wQ|BkVq%USqIzT2|h8z>yUsTODEvw zI1VIZ$)A*^@O8jC%vQgS=gI`s0-W;);~}=CJx7P@n2vUSG(8@{XG)($%{FW6V0IJe>$!?XdNYp)vkyFwKJRTh#kMUFN z-5@E^^QZ)g87P$iESB;`==KFDv+1JE+h#B_AS`DWqQ9~XoQBf#ZiM+U5UM0;@~q;v zk-O5SZC1GXY;PavRoe8G8UxuPfufEeC`07=j+NTqz4OmgfLO$CY6iuMUXO58rG7x* zH_EV+mrSdg7HT9M^1hVa^pzaIG<#DGq=avy-CH@N1X-S=?#@)ZPTb4pA{+A1k6z|3 zb?j_J35`DUCKQ4kSR()(8Zvl_c{C%ji*%UHLB>w2y!}lxNYp zM1$A4X`jJ(URXe%3w`0+s1i0K>{T*DumaN34_QT1YV!-j0kn@63=zRONZpK)|ATZT zttd%AMCp|$Q!xo%BS^y|%%Dj&z$Hx%Gl;<7GC+sdK>PDI7W7zhMluu@xS~;MQ==b5 zJVlE!yt64^qiixmN&0yuc}dP48{1O5|U;93{1 z&IvvSC!DTeqop5%Urz1%Pii0IgS*_DURi<5-~+D5Xr6FlkyR!OSW*w2zAIl6JuhF< z`Nr}!O;hxJ+T39upfN*wEJ_ds4q6lBo?7KMC*)e$%;;{L^2`Po4o2w=i5fHgJlt@- zO<#9Sv(fBPA=Rw6gdD3tQo}_1MuriOjm9IUZt(&Nb~#44Nk$ivZif-X1j58zzJ#|7 zC6O(XRI>?IF4xqOwFlFr0=3AF7NcWE=ktCc7f=sfau>Y{gLynxWB@RV2*U|P77o@A zdQGz1Lqw@%2C944@Sj1ubqGyEscqQkHPNtjQvhk<%@>ornZ`wjKqCpOizz@Ly;WVH zM0D~%mvV%BI#&wqG8t9YQiOmefqhZ(5#)_QDgD-pcYp)Y8sU`u2xC;G(EmM!o-nK|J2-sD$q7j=tTwGtFTp95AIyMLw(TQdl!(OJTJ?lNvl(&i>~pkJnAiu zanW$Wky#IA3<=T_pcj%1jF8WT=DDMyE@-P)(h4qnk+xEb=FM|1kSBUPDOE^_w>#<% z{TwJwDc9;jS z;Ye~#3|Vz|@W&j~mQH0zUb<%N)FMH3J;szGQH2xW09^$^Ev@s|^c;0X+2*Nf7b%Y* zCzIPX9pfaDRLTnWAUq03D6ij(#v{C-0s|*`XuPCSs*2+ky3xdz{t8dCh-STsF+jH( z%-7*fG1d_!tOgp2kYz@jB}^7lB|80#3J{Z7K=sJB;pH1VM9TzRdx=(AICG9g60Qh~ zs9o)=*R;YUy{UFI@HlVf&|CH7-I!)M1123J)qZ51Y6Kr%n!&KhzRBeVh$M3sAu5%$ zBpgv9?Y=sBXY@*5RiXs5nuc-$T+l}24%80~2CwCn1120NpnJ*^bY?PpB2UHFBUysv z7QrcoRcN@x`;bR?gApxJd^3_|JZIcIKD=SU$9G|p1Ru$G$pnWAU` zu#`lQ9H4B-6C;~^>xa=1$aaYgwd9CtZk(M6hSeQ>N1OX=D!h3)ig?gprPpyIrqE!t zOLsA__8h|{cGeJ7k2X1QwB@6eWU}5GuP|5r4(9izvVClB(B0IHZ0@F~ehY3}V<$-d zynFzGf5$}DW4e7ryC5UPN8D~ z(eNrRcK(i>5UuC18hO_S@r^UZZ>E$uP*s+84kd*l?100)06AKTxX2_^vT?f*8!_C3@Hk6Z@cXw?k%9bHu6*GteQ3H(cs}rT+ZXP z_uw=nB$k9jZtj^A0k+rd>rf838RlyW8@b4CnPjM9%un+D`*7y7ZdQj(oe)*4DLxC zFqt<(qKV&D0jQXYq@!+tDRl6liVPGGPO~m#S!9ob&$f)=5dI%Tm%_RaA`Y=10>j{%F_Hve=^!5~@2MlH2UxX+r_lXv;$p}<#_5IST^BAam+)K6&-LQM zjw~z<>>S9n5`RhyQ`xw%jP;*#Ia&Byev%t~%#6@XZ-MB>C(leNlH)aQ7urE_PnsjI}x;hAqwSpBVXg-&3O80HP zeLKc8l#bur6=M9&XNSgel+t=BQY7#_RK=nap3D8o0NVSv0vu6Kn*_4rB$CoaDHvGK zu+;rAzIi|4CH(l*AfJD*Kzt{KgMy%MSt)3LC{j$&>vlfGf5@GRG}4pyhPWy4*>6h# zLm5+21-(sq^Z1Gel8fdEkt;9w2-kF8Ja|_5=trM&JU-!SM{fP-)4OJMuglfBBh+kV zE$5@3ehPu@{`434A1C$mKW@|g=_l*>4)5eMiz1>sh?w{knbo#$68>A9==7;vWmRv{ zOp7sJl8VNiHuCo${6b zNkU1|y{B>ngx!hOk^HF)Xj(FnMfs-~UNE*eqE7kSTCa05kjWwW!*L)qc)Qr2{_;1^T B2Iv3) diff --git a/emacs/test-flan-cider.el b/emacs/test-flan-cider.el index 50390e3..da9db11 100644 --- a/emacs/test-flan-cider.el +++ b/emacs/test-flan-cider.el @@ -213,12 +213,15 @@ (message "\nthe inspector buffer") (defun test-flan--inspect (expr rendered) - "Draw EXPR's RENDERED value in a temp buffer and return it, live." + "Draw EXPR's RENDERED value in a temp buffer and return it, live. +The expression root, which is what most of the block below is about: the +rooting the buffer has always had, and the one that still works on a running +program." (let ((flan-inspect-request-function (lambda (_) (list :status "ok" :value rendered))) (flan-inspect-buffer " *test-inspect*")) (when (get-buffer " *test-inspect*") (kill-buffer " *test-inspect*")) - (save-window-excursion (flan-inspect--show expr nil)))) + (save-window-excursion (flan-inspect--show (list :expr expr) nil)))) (let* ((buf (test-flan--inspect "b" "(Blob {.id 7 .name \"sandy\" .pos (V {.x 1.5 .y 0})})")) @@ -284,7 +287,7 @@ (flan-inspect-buffer " *test-inspect*")) (when (get-buffer " *test-inspect*") (kill-buffer " *test-inspect*")) (save-window-excursion - (flan-inspect--show "b" nil) + (flan-inspect--show '(:expr "b") nil) (with-current-buffer " *test-inspect*" (goto-char (point-min)) (flan-inspect-next) (flan-inspect-next) ; :pos @@ -329,6 +332,180 @@ (string-match-p "span bound of 8" text))) +;;; The slot root + +(message "\nthe slot root: a frame and a slot index") + +;; The other rooting mode, and the reason it exists: an expression is +;; evaluated where the evaluator stands, so a local's *name* names the right +;; storage only on the innermost frame. This root names the frame. + +(defvar test-flan--asked nil + "Every request the last slot-root fixture sent, newest first.") + +(defun test-flan--slot (frame slot name replies body) + "Open the slot root on FRAME/SLOT/NAME and run BODY in its buffer. +REPLIES answers each request. BODY runs *inside* the binding of +`flan-inspect-request-function', which is not optional here: RET and `l' are +further requests, so a helper that returned the buffer and let the binding +unwind would send the next one to a daemon that is not there." + (setq test-flan--asked nil) + (let ((flan-inspect-request-function + (lambda (form) (push form test-flan--asked) (funcall replies form))) + (flan-inspect-buffer " *test-inspect*")) + (when (get-buffer " *test-inspect*") (kill-buffer " *test-inspect*")) + (save-window-excursion + (with-current-buffer (flan-inspect-slot frame slot name) + (funcall body))))) + +;; The header names the frame, which is the whole of what the expression root +;; could not say, and the type comes from the reply rather than being read +;; back out of the rendering — a rendering of `7' does not carry `i64'. +(test-flan--slot + 1 3 "b" + (lambda (_) (list :status "ok" :type "Blob" + :value "(Blob {.id 7 .pos (V {.x 1.5 .y 0})})")) + (lambda () + (let ((text (buffer-string))) + (test-flan--check "the slot root names the frame in the header" + (string-match-p "\\`b \\[frame 1\\]\n" text)) + (test-flan--check "and the daemon's type is what is shown" + (string-match-p "\nBlob\n" text))) + (test-flan--check "it asks the inspect op, not eval-expr" + (equal (plist-get (car test-flan--asked) :op) "inspect")) + (test-flan--check "with the frame and the slot index it was given" + (and (= 1 (plist-get (car test-flan--asked) :frame)) + (= 3 (plist-get (car test-flan--asked) :slot)))) + ;; An empty path is sent by *omission*: Emacs prints an empty list as + ;; `nil', which is a symbol on the wire and would be refused as a step. + (test-flan--check "and no :path at all for the slot itself" + (null (plist-get (car test-flan--asked) :path))))) + +;; Going in extends the path. The root does not change, and that is what +;; makes `l' unable to cross: every entry on the stack was pushed with the +;; root it belongs to, so `l' can only ever restore a pair it built. +(test-flan--slot + 1 3 "b" + (lambda (form) + (if (equal (plist-get form :path) '("pos")) + (list :status "ok" :type "V" :value "(V {.x 1.5 .y 0})") + (list :status "ok" :type "Blob" + :value "(Blob {.id 7 .pos (V {.x 1.5 .y 0})})"))) + (lambda () + (goto-char (point-min)) + (flan-inspect-next) (flan-inspect-next) ; .pos + (flan-inspect-into) + (test-flan--check "RET sends a path step, not an expression" + (equal (plist-get (car test-flan--asked) :path) '("pos"))) + (test-flan--check "the header walks with it" + (string-match-p "\\`b \\[frame 1\\]\\.pos\n" (buffer-string))) + (test-flan--check "with the frame's own root behind it in the trail" + (string-match-p "via b \\[frame 1\\] > here" (buffer-string))) + (flan-inspect-pop) + (test-flan--check "l shortens the path back to the root" + (null (plist-get (car test-flan--asked) :path))) + (test-flan--check "and the root never changed under it" + (seq-every-p (lambda (f) (equal (plist-get f :op) "inspect")) + test-flan--asked)) + (test-flan--check "so nothing was ever evaluated as an expression" + (not (seq-some (lambda (f) (plist-get f :code)) + test-flan--asked))) + (test-flan--check "and popping at the root refuses, as for an expression" + (string-match-p + "nothing behind it" + (or (test-flan--caught #'flan-inspect-pop) ""))))) + +;; An option's payload: the one thing the slot root reaches and the expression +;; root cannot, because Flan has no accessor form that names it. So the +;; refusal is the *root's* and not the value's, and it has to be asked with +;; the root in hand. +(test-flan--check "an expression root refuses an option's payload" + (string-match-p + "no accessor form" + (or (flan-inspect-refusal (flan-inspect-parse "(some 3)") + '(:expr "o")) + ""))) +(test-flan--check "a slot root does not" + (null (flan-inspect-refusal (flan-inspect-parse "(some 3)") + '(:slot 0 1 "o")))) + +(test-flan--slot + 0 2 "o" + (lambda (form) + (if (plist-get form :path) + (list :status "ok" :type "V" :value "(V {.x 1 .y 2})") + (list :status "ok" :type "(Option V)" :value "(some (V {.x 1 .y 2}))"))) + (lambda () + (goto-char (point-min)) + (flan-inspect-next) + (flan-inspect-into) + ;; The payload has no name, so the step is the symbol `some' and not a + ;; field called "some". + (test-flan--check "RET into an option sends the symbol some" + (equal (plist-get (car test-flan--asked) :path) '(some))) + (test-flan--check "and the trail says so" + (string-match-p "\\`o \\[frame 0\\]\\.some\n" (buffer-string))))) + +;; A union case's field. The payload sits at an offset that depends on which +;; case the value is in, and only the renderer knows which it currently holds +;; — it wrote the head `Shape.circle'. So the case travels with the name. +(test-flan--check "a union field carries its case on the wire" + (equal (flan-inspect-wire-step '(:field "r" "Shape.circle")) + "Shape.circle.r")) +(test-flan--check "a struct field does not" + (equal (flan-inspect-wire-step '(:field "x" "V")) "x")) +(test-flan--check "an element is its number" + (equal (flan-inspect-wire-step '(:index 2)) 2)) + +(test-flan--slot + 0 1 "s" + (lambda (form) + (if (plist-get form :path) + (list :status "ok" :type "V" :value "(V {.x 1 .y 2})") + (list :status "ok" :type "Shape" + :value "(Shape.circle {.at (V {.x 1 .y 2})})"))) + (lambda () + (goto-char (point-min)) + (flan-inspect-next) + (flan-inspect-into) + (test-flan--check "RET into a union field names the case it is in" + (equal (plist-get (car test-flan--asked) :path) + '("Shape.circle.at"))))) + +;; The daemon is allowed to refuse — a program that resumed, or a frame whose +;; body was redefined since it was entered — and the refusal has to reach the +;; person rather than being answered from somewhere else. Being answered from +;; somewhere else is the bug this root exists to fix, so it is asserted. +(let ((flan-inspect-request-function + (lambda (_) + (list :status "error" + :message "look's body was redefined since that frame was entered"))) + (flan-inspect-buffer " *test-inspect*")) + (test-flan--check "a refused slot root says why, and shows nothing" + (string-match-p + "redefined" + (or (test-flan--caught + (lambda () (flan-inspect-slot 0 1 "p"))) + "")))) + +;; And the structural claim about `l' from the other side: a new root always +;; starts a fresh stack, so there is never an entry of another kind left +;; underneath for `l' to land on. +(let ((flan-inspect-request-function + (lambda (form) (if (equal (plist-get form :op) "inspect") + (list :status "ok" :type "i32" :value "7") + (list :status "ok" :value "9")))) + (flan-inspect-buffer " *test-inspect*")) + (save-window-excursion + (flan-inspect-slot 1 3 "b") + (flan-inspect "g") + (with-current-buffer " *test-inspect*" + (test-flan--check "a new root drops the stack it did not build" + (null flan-inspect--stack)) + (test-flan--check "and l has nothing to cross back into" + (string-match-p + "nothing behind it" + (or (test-flan--caught #'flan-inspect-pop) "")))))) ;;; Restarts: which of them can be taken @@ -458,8 +635,11 @@ :restarts '("retry") :stack (list (list :fn "sim/settle" :loc "sand.flan:42:3" :fetched t - :locals '(("i" "i32" "7") - ("b" "Blob" "(Blob {.id 7})"))) + ;; Four elements now: the fourth is + ;; the slot's index, which is what `i' + ;; hands to the inspector. + :locals '(("i" "i32" "7" 0) + ("b" "Blob" "(Blob {.id 7})" 1))) (list :fn "sim/step" :loc "sand.flan:60:1" :fetched t :locals nil)))) (buf (test-flan--cnr state)) @@ -494,25 +674,41 @@ (test-flan--check "and TAB again closes it" (not (string-match-p "i32 i = 7" (buffer-string)))))) -;; The two buffers meet: `i' on a local opens the inspector on its name, which -;; is an expression the program can be handed. +;; The two buffers meet, and this is the fixture the bug lived in. `i' used +;; to send the local's *name* to be evaluated, which resolves wherever the +;; evaluator stands: right on the innermost frame by luck, and on any other +;; frame a global, another binding of the same name, or nothing — with the +;; listing right above it showing the frame's own storage and nothing saying +;; the two disagree. It sends the frame and the slot index now. (let ((asked nil)) (let ((flan-inspect-request-function - (lambda (form) (push (plist-get form :code) asked) - (list :status "ok" :value "(Blob {.id 7})"))) + (lambda (form) (push form asked) + (list :status "ok" :type "Blob" :value "(Blob {.id 7})"))) (flan-inspect-buffer " *test-inspect*")) (with-current-buffer (test-flan--cnr (list :condition "Missing" :restarts '("retry") - :stack (list (list :fn "f" :fetched t - :locals '(("b" "Blob" "…")))))) + :stack (list (list :fn "g" :fetched t + :locals '(("b" "Blob" "…" 4))) + (list :fn "f" :fetched t + :locals '(("b" "Blob" "…" 2)))))) (goto-char (point-min)) - (search-forward " 0: > f") + (search-forward " 1: > f") (flan-cnr-toggle-frame) (goto-char (point-min)) + (search-forward " 1: v f") (search-forward "Blob b") (save-window-excursion (flan-cnr-inspect)) - (test-flan--check "`i' on a local inspects it by name" - (equal (car asked) "b"))))) + (test-flan--check "`i' on a local inspects it by frame and slot" + (equal (plist-get (car asked) :op) "inspect")) + ;; The outer frame, and its own slot index — the two facts a name cannot + ;; carry. Frame 1 has a `b' and so does frame 0; sending "b" would have + ;; reached whichever one the evaluator stands in. + (test-flan--check "naming the frame the listing was drawn from" + (= 1 (plist-get (car asked) :frame))) + (test-flan--check "and the slot index that frame's listing gave" + (= 2 (plist-get (car asked) :slot))) + (test-flan--check "nothing is evaluated as an expression" + (null (plist-get (car asked) :code)))))) ;; `flan-cnr-show' refuses a running program by name rather than opening an ;; empty buffer. @@ -635,10 +831,10 @@ ;; inspector is built on. (with-current-buffer buf (goto-char (point-min)) - (test-flan--check "and a global line is inspectable" + (test-flan--check "and a global line is inspectable, by expression" (progn (search-forward "pressure") (equal (get-text-property (point) 'flan-cnr-inspect) - "pressure"))))) + '(:expr "pressure")))))) ;; Empty is a claim, not a gap: the section is the union of what the stack ;; reaches, so nothing in it means the state is all in the locals. diff --git a/lib/dev.ml b/lib/dev.ml index aac36ce..b4a7ee9 100644 --- a/lib/dev.ml +++ b/lib/dev.ml @@ -1625,6 +1625,11 @@ let handle t req = "a :path step is a string for a field, an integer for an element, or `some' for an option's payload")) (Ok []) l |> Result.map List.rev + (* Emacs prints an empty list as [nil], because it has no other + spelling for one. Taking it is cheaper than making every client + in that language special-case the empty path, and [nil] is not a + step under any other reading. *) + | Some { Form.v = Form.Sym "nil"; _ } -> Ok [] | Some _ -> Error "inspect's :path is a list" | None -> Ok [] in From 404c810958cb0796ec4fddd376c1b0e8038adcb8 Mon Sep 17 00:00:00 2001 From: Joseph Ferano Date: Sat, 12 Sep 2026 20:34:32 +0700 Subject: [PATCH 4/6] Which frame the inspector answered from, asserted rather than reasoned about MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit The `inspect' verb had no coverage. The discriminating case is not a path step, it is the frame: dev-inspect.flan gives `mark' to a global holding 99 and to a local of the OUTER frame holding a Point, so evaluating the name and rooting at the frame answer differently and not even with the same type. One `eval-expr' and one `inspect' of that name is the bug and the fix in a pair. The slot index comes off the locals listing's fourth element rather than being written as a literal, which exercises the field the editor depends on and keeps the test from passing for the wrong reason if slot allocation shifts. The rest is what a path can and cannot do: a struct field, an array element, an option's payload and a union case's field — the last two having offsets but no accessor form in the language — and four refusals, each checked for naming the step and saying why. A `:path' of `nil' is read as the slot itself, because Emacs has no other spelling for an empty list. Two claims about the frame, since `stopped_frame' being shared is an assertion about code rather than about behaviour until something proves it: the frame whose body was redefined under it is refused, and so is the whole stack once the program resumes. --- test/programs/dev-inspect.flan | 53 +++++++++ test/test_dev.ml | 209 +++++++++++++++++++++++++++++++++ 2 files changed, 262 insertions(+) create mode 100644 test/programs/dev-inspect.flan diff --git a/test/programs/dev-inspect.flan b/test/programs/dev-inspect.flan new file mode 100644 index 0000000..753a8aa --- /dev/null +++ b/test/programs/dev-inspect.flan @@ -0,0 +1,53 @@ +;;;; A stopped stack whose OUTER frame holds a local the evaluator cannot see. +;;;; +;;;; dev-locals.flan is about what one frame holds; this one is about which +;;;; frame the answer came from. The whole of the bug the `inspect' verb +;;;; exists for is that an expression is evaluated where the evaluator stands, +;;;; so a local's *name* reaches the right storage only when the frame is the +;;;; innermost one. `mark' below is a global AND a local of the outer frame, +;;;; holding different things of different types: evaluating the name answers +;;;; the global, and rooting at the frame and slot answers the frame. +;;;; +;;;; The other locals are the shapes a path step has to walk and that an +;;;; expression cannot reach at all: an option's payload, which has no +;;;; accessor form in the language, and a union case's field, whose offset +;;;; depends on which case the value is in. +(import agent "vendor:agent") + +(defstruct Point [x f32 y f32]) +(defstruct Boom [why i32]) + +(defunion Shape + [Empty + (Dot [x f64 y f64]) + (Rect [w i32 h i32])]) + +;; The discriminator. `outer' binds a local of this name to something else, so +;; every claim about which frame answered is visible in the value itself. +(defvar mark i64) + +;; The innermost frame, and it is deliberately dull: it holds nothing worth +;; inspecting, so that the frame worth inspecting is not the one an expression +;; would have found by luck. +(defn deeper [] i64 + (restart-case + (do (error (Boom {.why 7})) 1) + (carry-on [] 5))) + +(defn outer [] i64 + (let [mark (Point {.x 1.5 .y 2.5}) + xs [10 20 30] + box (Some (Point {.x 4.5 .y 5.5})) + s (Shape.Rect {.w 3 .h 6})] + (deeper))) + +(defvar ticks i64) + +(defn main [] i32 + (set mark 99) + (agent/start "/tmp/flan-dev-inspect-fallback.sock") + (print (outer)) (println "") + (dotimes [i 4000] + (agent/wait 5) + (set ticks (+ ticks 1))) + 0) diff --git a/test/test_dev.ml b/test/test_dev.ml index afb6c0b..2dd8a3a 100644 --- a/test/test_dev.ml +++ b/test/test_dev.ml @@ -884,6 +884,215 @@ let () = end end; + (* ── Which frame the inspector answered from ───────────────────── *) + + (* The locals listing was already frame-accurate; the inspector was not. + `i' in the break buffer sent the local's *name* to be evaluated, and an + expression is evaluated where the evaluator stands — the right frame + only when the frame is the innermost one. + + dev-inspect.flan is built so that failing to root at the frame is + visible in the value rather than only in the reasoning: `mark' is a + global holding 99 and a local of the *outer* frame holding a Point, and + the two are not even the same type. So the discriminating pair below is + one evaluation and one inspection of the same name. + + It also carries the two shapes an expression cannot reach at all: an + option's payload, which no accessor form in the language names, and a + union case's field, whose offset depends on which case the value is + in. *) + let isock = tmp "inspect.sock" and iout = tmp "inspect.out" in + (try Sys.remove isock with Sys_error _ -> ()); + let ifd = Unix.openfile iout [ Unix.O_WRONLY; Unix.O_CREAT; Unix.O_TRUNC ] 0o600 in + let ipid = + Unix.create_process flan + [| flan; "dev"; "programs/dev-inspect.flan"; "-s"; isock |] + Unix.stdin ifd Unix.stderr + in + Unix.close ifd; + if not (await (fun () -> Sys.file_exists isock)) then begin + fail "the inspect daemon never listened"; + (try Unix.kill ipid Sys.sigkill with Unix.Unix_error _ -> ()) + end + else begin + let c = connect isock in + let ask sexp = Wire.parse (Wire.send c sexp; Wire.recv c) in + let stopped r = + match Wire.field r "stopped" with + | Some { Form.v = Form.Sym "t"; _ } -> true + | _ -> false + in + let contains hay needle = + let n = String.length needle in + let rec go i = + i + n <= String.length hay + && (String.equal (String.sub hay i n) needle || go (i + 1)) + in + go 0 + in + if not (await (fun () -> stopped (ask "(:op \"describe\")"))) then + fail "the inspect program never stopped" + else begin + (* The slot travels by index and the index comes off the listing, + which is the fourth element of each entry. Reading it here rather + than writing 0 exercises the field the editor depends on, and keeps + this test from passing for the wrong reason if slot allocation ever + shifts. *) + let slot_of r name = + match Wire.field r "locals" with + | Some { Form.v = Form.List l; _ } -> + List.fold_left + (fun acc (e : Form.t) -> + match acc with + | Some _ -> acc + | None -> + (match e.Form.v with + | Form.List + [ { Form.v = Form.Str n; _ }; _; _; + { Form.v = Form.Int i; _ } ] + when String.equal n name -> + Some (Int64.to_int i) + | _ -> None)) + None l + | _ -> None + in + let listing = ask "(:op \"locals\" :frame 1)" in + if status listing <> "ok" then + fail "locals of the outer frame: %s" + (Option.value ~default:(status listing) (Wire.string_field listing "message")) + else begin + let inspect ?(path = "()") slot = + ask + (Printf.sprintf "(:op \"inspect\" :frame 1 :slot %d :path %s)" slot + path) + in + let value r = Option.value ~default:"" (Wire.string_field r "value") in + let want name path ty v = + match slot_of listing name with + | None -> + fail "the locals listing gave no slot index for %s, so the \ + inspector has nothing to root at" name + | Some slot -> + let r = inspect ~path slot in + if status r <> "ok" then + fail "inspect %s%s: %s" name path + (Option.value ~default:(status r) (Wire.string_field r "message")) + else begin + if value r <> v then + fail "inspect %s%s rendered %s, not %s" name path (value r) v; + if Option.value ~default:"" (Wire.string_field r "type") <> ty then + fail "inspect %s%s says its type is %s, not %s" name path + (Option.value ~default:"" (Wire.string_field r "type")) ty + end + in + (* The pair the whole verb exists for. `mark' evaluated as an + expression is the global, because that is where the evaluator + stands; `mark' rooted at frame 1's slot is the frame's own + storage. Both answers are correct answers to different + questions, and the break buffer was asking the wrong one. *) + let r = ask "(:op \"eval-expr\" :code \"mark\" :file \"\")" in + if status r <> "ok" || value r <> "99" then + fail "the global `mark' did not evaluate to 99: %s" (value r); + want "mark" "()" "Point" "(Point {.x 1.5 .y 2.5})"; + (* A path step, which is an address plus an offset with that field's + type — the arithmetic the listing already does. *) + want "mark" "(\"x\")" "f32" "1.5"; + want "xs" "(1)" "i32" "20"; + (* And the two an expression cannot write at all. *) + want "box" "(some)" "Point" "(Point {.x 4.5 .y 5.5})"; + want "box" "(some \"x\")" "f32" "4.5"; + want "s" "(\"Shape.Rect.w\")" "i32" "3"; + (* Emacs prints an empty list as `nil' and has no other spelling for + one, so a client in that language cannot send `()'. *) + (match slot_of listing "mark" with + | None -> () + | Some slot -> + let r = inspect ~path:"nil" slot in + if status r <> "ok" || value r <> "(Point {.x 1.5 .y 2.5})" then + fail "a :path of nil was not read as the slot itself: %s" + (Option.value ~default:(status r) (Wire.string_field r "message"))); + (* Every step that does not fit the type in hand is refused by name + with its reason. A path with a step quietly dropped out of it + would render a *different* value and say nothing, which is the + failure this whole buffer is built to avoid. *) + List.iter + (fun (name, path, needle) -> + match slot_of listing name with + | None -> () + | Some slot -> + let r = inspect ~path slot in + let m = Option.value ~default:"" (Wire.string_field r "message") in + if status r <> "error" then + fail "inspect %s%s answered instead of refusing: %s" name path + (value r) + else if + (* The refusal names the step and says why. *) + not + (contains m needle + && contains m name) + then fail "inspect %s%s refused without saying why: %s" name path m) + [ ("mark", "(\"nope\")", "no field called nope"); + ("mark", "(some)", "not an option"); + ("xs", "(9)", "past the end"); + (* A union field without its case: the payload's offset depends + on the case, so guessing one that two cases share would read + one case's layout over another's payload. *) + ("s", "(\"w\")", "name the case") ] + end; + (* The innermost frame records no slots at all, and that is refused + with the reason rather than answered with something. *) + let r = ask "(:op \"inspect\" :frame 0 :slot 0 :path ())" in + if status r <> "error" then + fail "a frame with no slots answered the inspector anyway"; + (* And the frame checks are the listing's, by construction: both go + through `stopped_frame'. An inspector with its own copy would be + free to read a frame whose body was redefined since it was entered, + which is exactly the stale-slot answer the listing refuses. This + body renames every local and keeps the count and the types, which + only the slot fingerprint can see. *) + let r = + ask + "(:op \"eval\" :code \"(defn outer [] i64 (let [tag (Point {.x 9.0 .y 9.0}) ys [1 2 3] maybe (Some (Point {.x 0.0 .y 0.0})) sh (Shape.Rect {.w 1 .h 1})] (deeper)))\" :file \"/tmp/buf.flan\")" + in + if status r <> "ok" then + fail "installing a renamed body while stopped: %s" + (Option.value ~default:"" (Wire.string_field r "message")) + else begin + let r = ask "(:op \"inspect\" :frame 1 :slot 0 :path ())" in + if status r <> "error" then + fail + "the inspector read a frame whose body was redefined under it: %s" + (Option.value ~default:"" (Wire.string_field r "value")) + end + end; + (* And a running program has no frame to root at. The inspector says so + rather than falling back to evaluating the name somewhere else, which + is the behaviour it replaced. *) + let r = ask "(:op \"restart\" :name \"carry-on\")" in + if status r <> "ok" then + fail "resuming the inspect program: %s" + (Option.value ~default:"" (Wire.string_field r "message")); + if not (await (fun () -> not (stopped (ask "(:op \"describe\")")))) then + fail "the inspect program never resumed" + else begin + let r = ask "(:op \"inspect\" :frame 1 :slot 0 :path ())" in + if status r <> "error" then + fail "a running program answered the inspector" + end; + ignore (ask "(:op \"close\")"); + Unix.close c; + if not + (await ~ms:5000 (fun () -> + match Unix.waitpid [ Unix.WNOHANG ] ipid with + | 0, _ -> false + | _ -> true + | exception Unix.Unix_error _ -> true)) + then begin + (try Unix.kill ipid Sys.sigkill with Unix.Unix_error _ -> ()); + (try ignore (Unix.waitpid [] ipid) with Unix.Unix_error _ -> ()) + end + end; + (* ── The globals a stopped stack reaches ───────────────────────── *) (* The other half of what a break loop can show. Locals are one frame's; From 0389c2282ccf9e1e1f7f165e155df66d35c07c64 Mon Sep 17 00:00:00 2001 From: Joseph Ferano Date: Sat, 12 Sep 2026 20:36:48 +0700 Subject: [PATCH 5/6] What the second root can reach, what it needs, and why both are kept MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit The daemon side and the Emacs side both landed with nothing written down. Four files owed something. `BUILT.md` gets the whole of it: why rooting at an address alone was rejected and why that rejection was half wrong, what a path step is and how a union's case travels with it, why the slot goes by index and not by name, and the two capability lists side by side — the expression root works on a running program and cannot name a frame; the slot root names one frame and one slot and reaches an option's payload and a union case's fields, and needs the program stopped. Neither contains the other, which is the reason there are two. `emacs/MANUAL.md` says the same thing in the register that file uses, under the inspector, because the person pressing `i` is the one who needs to know which root they got and what it cannot do. The globals section's claim that `i` works on a global "exactly as it does on a local" was true and is now the interesting difference, so it says what the difference is. `NEXT.md`'s decided item is struck with what actually shipped: a frame and a slot index rather than an address and a type, and `l` crossing between the modes was predicted as a cost and turned out not to be one. `DISCUSS.md` item 1 is no longer an open question. The number stays — cimport.ml and NEXT.md cite these by number — and what stays with it is the one correction worth keeping: an address is not an expression, but a step does not have to be one either. And BUILT.md's last paragraph still said `render.ml` prints `(V {:x 1.5})` and that the printer would move when its reader did. They moved together some time ago. --- BUILT.md | 76 +++++++++++++++++++++++++++++++++++++++++++++++++ DISCUSS.md | 45 ++++++++--------------------- NEXT.md | 15 ++++------ emacs/MANUAL.md | 51 +++++++++++++++++++++++++++------ 4 files changed, 136 insertions(+), 51 deletions(-) diff --git a/BUILT.md b/BUILT.md index 35a4d5d..c47e10b 100644 --- a/BUILT.md +++ b/BUILT.md @@ -2769,3 +2769,79 @@ is a wire format — `emacs/flan-inspect.el` parses it back and hard-codes the c moving the printer alone would break struct inspection in the dev loop without breaking any test that says so. The printer moves when its reader does, in the Emacs lane. It is the one place the old spelling is still correct, and the reason is worth keeping: **a format with two ends only changes at both.** + +**Since written: the printer moved, and both ends moved together.** `render.ml` prints `(V {.x 1.5 .y 0})` now and +`emacs/flan-inspect.el` reads the dot, which is the "moves when its reader does" the paragraph above was waiting on. +The reader tells `...` from a field label by one character of lookahead, because both begin with a dot and a field +name never starts with a second one. + +## Two ways to root a walk, and why neither subsumes the other + +`i` in the break buffer sent a local's **name** to be evaluated. An expression is evaluated where the evaluator +stands, so on the innermost frame that lands in the right frame by luck; on any other it may resolve to a global, to +another binding of the same name, or to nothing — with the locals listing right above it showing the frame's own +storage and nothing saying the two disagree. The display was right and the inspector was not, which is the worst +arrangement of the two. + +**The obvious fix was tried and rejected, and the rejection was half wrong.** Rooting the walk at the slot's address +does not work on its own: an address is not an expression, so the first `RET` has nothing to build the next expression +from and navigation dies at step one. What that argument assumed is that the *step* has to be an expression too, and +the shadow stack is what stopped that being true. The daemon holds the frame's address and every slot's type, so +stepping into a field is an address plus an offset with that field's type — which is exactly the arithmetic +`Render.render` already does for the locals listing. So `Session.render_slot` is `render_locals` with a path applied +to the root before the walk and one line out instead of one per slot. No second walk was written and no backend +change was needed. + +The verb is `(:op "inspect" :frame N :slot I :path (...))`. A path step is a string for a struct field, an integer for +an array or slice element, and the symbol `some` for an option's payload; a union case's field is spelled +`Union.case.field`, because the payload's offset depends on which case the value is in and only the renderer knows +which case it currently holds — it wrote the head `(Union.case {…})`. Guessing the case from a field name two cases +share would read one case's layout over another's payload. Every step that does not fit the type in hand is refused +by name with its reason. A pointer is still never followed; that is the renderer's rule and not this mode's. + +**The slot travels by index, not by name.** `check.ml`'s `fresh_slot` only ever allocates, so `(let [v 22] …)` inside +`(let [v 11] …)` is two slots both called `v` and both are in the listing; and a refused slot is not in the listing at +all, so its position there is not an identifier either. `locals` therefore puts the slot index on each entry as a +fourth element, and that is what the break buffer hands back. + +**The frame checks are the listing's, by construction.** `Dev.stopped_frame` is one function and `locals`, `globals` +and `inspect` all go through it: alive, stopped, the frame exists, it is the program's and not a `C-x C-e` thunk's, +its body is one this session holds, the slot count matches, and `Emit.slot_fingerprint` matches. An inspector with its +own copy of those conditions would be free to read a frame whose body was redefined since it was entered, which is +precisely the stale-slot answer the listing refuses. `inspect` adds one refusal of its own, for the listing's reason: +an unbound slot is a null address and a thunk that read it would fault on the game thread of a program that is already +stopped. + +### What each root cannot do that the other can + +Both are wanted and the buffer says which it is on. + +**The expression root** works on a **running** program and starts from anything you can write, a call included. It +cannot name a frame — that is the bug — and it cannot reach an option's payload, because the compiler gets at that as +field 1 and nothing in the surface language does. + +**The slot root** is exact to one frame and one slot, and it reaches an option's payload and a union case's fields, +which have offsets but no accessor form to write. It needs a **stopped** program, it is refused when the frame's body +was redefined since it was entered — the same fingerprint the listing is refused by — and it cannot root at an +expression at all, so `g` after the program resumes is refused rather than quietly answered from somewhere else. + +A refusal someone can read is the point of the second one existing. The failure being fixed was not "no answer", it +was a confident answer from the wrong place. + +### `l` does not cross between them, structurally + +A stack entry in `flan-inspect.el` is `(ROOT PATH . POINT)`. `RET` only ever appends a step to the path under the root +the buffer already has, and every new root — `flan-inspect`, `flan-inspect-slot` — starts with an empty stack. A stack +with two kinds of root in it therefore cannot be constructed, so the question of what `l` should do when it crosses +one does not arise. That stays true if a third rooting mode is added, which is why it is worth having as structure +rather than as a rule in a comment. + +The Emacs state is a root plus a path rather than a retained value for the same reason the expression stack was: +nothing on this side can hold a Flan value. A value has no header, the thunk that rendered it is `dlclose`d the moment +it returns, and there is no heap to retain it in. So every step and every `g` is a fresh request, which is what keeps +the view from ever being stale — and it is also why `g` is a key someone presses rather than a timer, since an +expression root with an effect in it would fire once a second for ever. + +**One wire detail worth recording.** An empty `:path` is sent by omission. Emacs prints an empty list as `nil`, which +is a symbol on the wire and would be read as a step, so there is no way for a client in that language to spell `()`. +The daemon reads a missing `:path` — and `nil` — as the slot itself. diff --git a/DISCUSS.md b/DISCUSS.md index e39b469..4f10b02 100644 --- a/DISCUSS.md +++ b/DISCUSS.md @@ -8,42 +8,21 @@ Settled decisions live in `NEXT.md`. Reasons for what already exists live in `BU --- -## 1. `i`, the inspector, and the frame it cannot see +## 1. `i`, the inspector, and the frame it cannot see — answered and built -Two things got conflated here and they should be separated. +Option 2 was taken: the inspector has a second rooting mode, at a frame and a slot index. `BUILT.md`'s "Two ways to +root a walk" says what each root can and cannot do and why both are kept. The number stays here because other files +cite these by number; the question itself is no longer open. -**What the inspector already does.** Most of what was asked for is built. `flan-inspect` opens its own buffer, lays a -value's fields one per line, `RET` walks into one, `l` comes back, `g` re-reads. The renderer bounds its walk at depth 4 -and span 8, and entering a field renders *that field* from depth 0 — so the elision moves with you rather than -truncating permanently. It is CIDER's inspector adapted, and the file says what the adaptation changed. +One thing the original entry recorded turned out to be half right, and is worth keeping here rather than deleting with it. "Root the inspector +at the slot's address does not work, because an address is not an expression and the first `RET` has nothing to build +from" — the premise is true and the conclusion was wrong. What changes it is that the *step* need not be an expression +either: the daemon holds the frame's address and every slot's type, so a field is an address plus an offset with that +field's type, which is the arithmetic the locals listing already does. The navigation objection was to rooting at an +address while still stepping by source. -**What is actually missing** is detail on the leaves: a number shows in decimal only, with no hex and no binary, and a -pointer does not show its address. Purely additive, small, and worth doing. - -**The real problem, and it is sharper than "a bug".** The locals listing renders from each frame's own slot addresses, -so it is frame-accurate. The inspector is built on a stack of **expressions** — going into a field means sending a -different expression (`(.pos b)` where the last was `b`), and `l` works by popping back to the previous one. That design -is forced: a Flan value has no header, the thunk that rendered it is `dlclose`d as soon as it returns, and there is no -heap to retain anything in, so nothing can be held server-side the way CIDER holds a JVM object. - -The consequence is that `i` evaluates a name wherever the evaluator stands, **not in the frame being looked at**. On the -innermost frame that happens to be right. On any other it may resolve to a global, to a different binding, or fail — -with nothing saying so. - -**An earlier suggestion in this conversation — "root the inspector at the slot's address" — does not work**, and the -reason is worth keeping: an address is not an expression, so the first `RET` has nothing to build the next expression -from and navigation dies at step one. Recorded because it is the obvious fix and it is wrong. - -So the options are genuinely three, and none is free: - -1. **Teach the program to evaluate an expression relative to a frame.** The most useful and the most work: the frame's - slots would have to be in scope for a compiled thunk, which means the daemon building a thunk whose free names bind - to that frame's addresses. It would also fix `C-x C-e` while stopped, which has the same blindness. -2. **Give the inspector a second rooting mode** — an address root that can still walk, by carrying a type alongside the - address and stepping to a field's address rather than to a sub-expression. Navigation then works, but the two modes - have different capabilities and `l` has to cross between them. -3. **Refuse `i` outside the innermost frame**, honestly and by name. Cheapest, and it gives up the feature exactly where - it is most wanted, since the innermost frame is the one already fully visible. +`l` crossing between the modes was listed as a cost of option 2 and it is not one. A stack entry carries its own root +and `RET` only extends the path under the root it already has, so a mixed stack cannot be built at all. ## 2. Annotating the IR and the disassembly with the source diff --git a/NEXT.md b/NEXT.md index 96fef9d..46396c2 100644 --- a/NEXT.md +++ b/NEXT.md @@ -710,16 +710,11 @@ op that compiles on first use and a cheap re-invoke per tick. The author also raised **ghost text** as an alternative or addition to a dedicated buffer — values shown inline at the code they belong to. Not designed; the buffer is the port, ghost text is a further question. -**The inspector gets a second way to start: an address and a type.** Closes the hole in `DISCUSS.md` item 1, where `i` -on a local in any frame but the innermost evaluates a name wherever the evaluator stands rather than in that frame, and -may silently inspect something else. - -The inspector navigates by rewriting *expressions* — `(.pos b)` where the last was `b` — and `l` pops back. That is -why the obvious fix, rooting it at the slot's address, was rejected: an address is not an expression, so the first -`RET` has nothing to build from. **The shadow stack changed this.** The daemon now has a frame's address and every -slot's type, so the second rooting mode is cheap: start from an address plus a type, and stepping into a field is -address-plus-offset with the field's type. `Render.render` already does exactly that arithmetic for locals, and -navigation keeps working, which was the objection. +~~**The inspector gets a second way to start: an address and a type.**~~ **Built.** See `BUILT.md`, "Two ways to root +a walk, and why neither subsumes the other". It went in as a frame and a slot *index* rather than an address and a +type — the daemon holds both and an index is the thing the listing can hand back, while an address is not something an +editor should be holding. The one prediction that did not survive contact: `l` crossing between the two modes was +listed as a cost and is not one, because a stack entry carries its own root and a mixed stack cannot be built. **Structural typing requires identical layout — same fields, same types, same order.** Settled by the author, and it makes the feature simple rather than hard: structural compatibility becomes "the same memory", which costs nothing at diff --git a/emacs/MANUAL.md b/emacs/MANUAL.md index 4540b02..0de1682 100644 --- a/emacs/MANUAL.md +++ b/emacs/MANUAL.md @@ -145,7 +145,7 @@ Keys in that buffer: | `TAB` / `n` | next restart | | `S-TAB` / `p` | previous | | `f` | fold a stack frame open or closed | -| `i` | inspect a local variable | +| `i` | inspect the local or global at point | | `a` | abort | | `g` | read the program again | | `q` | close the buffer | @@ -198,11 +198,40 @@ Two things worth knowing, because they are unlike other inspectors. **The view is never stale.** Every step reads the program as it is *now*. Most inspectors show you the object as it was when you opened it. -**The root expression runs again on every step.** Going into a field sends a new -expression — `(.pos b)` where the last one was `b`. Appending a field name is -harmless, but the root need not be: if you inspect `(spawn-enemy)`, you spawn one -per keystroke. That is why there is no auto-refresh and why `g` is a key you -press rather than a timer. +**The root runs again on every step.** Going into a field sends a new request, +not a lookup in something remembered. Appending a field name to an expression +is harmless, but the expression itself need not be: if you inspect +`(spawn-enemy)`, you spawn one per keystroke. That is why there is no +auto-refresh and why `g` is a key you press rather than a timer. + +### Two ways to root a walk + +There are two, they are not equally capable, and the top line of the buffer +says which one you are on. + +**An expression** — `C-c C-i`, and `i` on a global line in the break buffer. +It works on a **running** program and starts from anything you can write, +including a call. It cannot name a frame: an expression is evaluated where the +evaluator stands, so a local's name reaches that local only when its frame is +the innermost one. And it cannot reach an option's payload, because nothing in +the language names it. + +**A frame and a slot** — `i` on a local line in the break buffer. It is exact +to one frame and one slot, so the value you get is the one the listing above it +drew. It reaches an **option's payload** and a **union case's fields**, which +have offsets but no accessor form to write. In exchange it needs a **stopped** +program, and it is refused — by name, with the reason — once the program +resumes or if the frame's body was redefined since the frame was entered. It +cannot start from an expression at all. + +Neither subsumes the other, which is why both are here. The one you get is +chosen for you by the line you press `i` on. + +**`l` never crosses between them**, and that is structural rather than a rule +someone has to remember. Every entry on the buffer's stack carries its own +root; `RET` only ever lengthens the path under the root already in hand; and +starting a new root starts an empty stack. So a stack with both kinds in it +cannot be built, and `l` has nothing to cross into. --- @@ -463,8 +492,14 @@ does" — at no cost in duplication. And the order is **by the innermost frame that touches it**, because a deep stack makes the union large and proximity to the error is what puts the likely culprit on top. -`i` works on a global line exactly as it does on a local: a global's name is an -expression, so the inspector can be pointed at it with nothing new. +`i` works on a global line, and it roots differently there than on a local — +which is the fix rather than an inconsistency. A global really is reached by +name: the thunk the daemon loads binds to the program's own storage through the +dynamic linker, so the name means the same thing wherever it is evaluated. A +local is storage in one frame, and its name evaluated anywhere else may find a +global, another binding of the same name, or nothing. So a local goes in by +frame and slot index — the same two facts the listing was drawn from — and a +global by name. See "Two ways to root a walk" above for what each can reach. Two things are said rather than left out. A global whose type the structural printer has no arm for is refused by name with the reason. And a frame the From 306fc88094122f0c18008a4f6f83b89950c9aff1 Mon Sep 17 00:00:00 2001 From: Joseph Ferano Date: Sat, 12 Sep 2026 20:40:02 +0700 Subject: [PATCH 6/6] A union's fields have no accessor, so RET refuses them where none exists MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit The capability lists were written before the code held the line they claim. Under an expression root, RET on a field of a union built `(.at s)' and sent it, and the checker refused it — "a union's fields belong to a case ... they are reached by (match ...)". A refusal from the far end of a socket is exactly what this buffer's own comment says not to do: every refusal is by name, here, with the reason, because RET working on some lines and erroring on others teaches nothing about the language. It is a refusal of the *parent* and not of the value at point, which is why it is not in `flan-inspect-refusal': a struct field that merely holds a union is an ordinary accessor and has to stay enterable. It is a field of the union itself that cannot be written. The two cases are one test each. The slot root steps into it by offset and is unaffected, which is the difference the manual now claims and the tests now show. `lib/dev.ml' cited DISCUSS.md item 1 as a hole; item 1 is the answer now, so it cites BUILT.md instead. And the item 1 stub is two sentences and a pointer — everything else in it is in BUILT.md verbatim, and DISCUSS.md's own header says nothing in it is a decision. --- DISCUSS.md | 16 +++------------- emacs/flan-inspect.el | 19 +++++++++++++++++++ emacs/test-flan-cider.el | 31 +++++++++++++++++++++++++++++++ lib/dev.ml | 3 ++- 4 files changed, 55 insertions(+), 14 deletions(-) diff --git a/DISCUSS.md b/DISCUSS.md index 4f10b02..7791d98 100644 --- a/DISCUSS.md +++ b/DISCUSS.md @@ -10,19 +10,9 @@ Settled decisions live in `NEXT.md`. Reasons for what already exists live in `BU ## 1. `i`, the inspector, and the frame it cannot see — answered and built -Option 2 was taken: the inspector has a second rooting mode, at a frame and a slot index. `BUILT.md`'s "Two ways to -root a walk" says what each root can and cannot do and why both are kept. The number stays here because other files -cite these by number; the question itself is no longer open. - -One thing the original entry recorded turned out to be half right, and is worth keeping here rather than deleting with it. "Root the inspector -at the slot's address does not work, because an address is not an expression and the first `RET` has nothing to build -from" — the premise is true and the conclusion was wrong. What changes it is that the *step* need not be an expression -either: the daemon holds the frame's address and every slot's type, so a field is an address plus an offset with that -field's type, which is the arithmetic the locals listing already does. The navigation objection was to rooting at an -address while still stepping by source. - -`l` crossing between the modes was listed as a cost of option 2 and it is not one. A stack entry carries its own root -and `RET` only extends the path under the root it already has, so a mixed stack cannot be built at all. +Answered, and built as option 2. `BUILT.md`'s "Two ways to root a walk, and why neither subsumes the other" is where +it lives now, including the correction to what this entry said about rooting at an address. The number is kept because +other files cite these by number; nothing here is open. ## 2. Annotating the IR and the disassembly with the source diff --git a/emacs/flan-inspect.el b/emacs/flan-inspect.el index 2a68846..1475c28 100644 --- a/emacs/flan-inspect.el +++ b/emacs/flan-inspect.el @@ -623,6 +623,25 @@ root, which is what makes a mixed stack unconstructible." (unless step (user-error "flan: nothing to inspect on this line")) (let ((why (flan-inspect-refusal node flan-inspect--root))) (when why (user-error "flan: %s" why))) + ;; A union case's field, under an expression root. This is a refusal of + ;; the *parent* and not of the value at point, which is why it is here and + ;; not in `flan-inspect-refusal\=': a struct field that happens to hold a + ;; union is reached by an ordinary accessor and must stay enterable; it is + ;; a field *of the union itself* that has no accessor. `(match ...)\=' is + ;; how a union is opened in the language, and it binds names rather than + ;; producing a value to send, so there is nothing to build here. The + ;; renderer wrote the head as `Union.case\=', which is the one type spelling + ;; with a dot in it — a package qualifies with a slash. + (let ((ty (plist-get flan-inspect--node :type))) + (when (and (not (eq (car-safe flan-inspect--root) :slot)) + (stringp ty) + (string-match-p "\\." ty)) + (user-error + "flan: %s" + (concat "a union case's field: it is reached by (match ...) in the " + "language, not by an accessor, so there is no expression to " + "send. `i' on a local in the break buffer roots at the frame's " + "slot instead, and that root steps into it by offset")))) ;; The line carries the step that names the field; what the wire needs ;; beyond the name is the type it is a field *of*, and that is this ;; buffer's own node — the parent of the one at point. A union's payload diff --git a/emacs/test-flan-cider.el b/emacs/test-flan-cider.el index da9db11..2054e80 100644 --- a/emacs/test-flan-cider.el +++ b/emacs/test-flan-cider.el @@ -457,6 +457,37 @@ unwind would send the next one to a daemon that is not there." (test-flan--check "an element is its number" (equal (flan-inspect-wire-step '(:index 2)) 2)) + +;; And the other half of that pair: under an *expression* root there is no +;; accessor to send, so RET refuses there rather than sending `(.at s)' for +;; the checker to reject. A union's fields are reached by `(match ...)' in +;; the language, which binds names rather than producing a value. It is a +;; refusal of the parent, not of the value at point — a struct field that +;; merely *holds* a union is an ordinary accessor and stays enterable. +(let ((buf (test-flan--inspect "s" "(Shape.circle {.at (V {.x 1 .y 2})})"))) + (with-current-buffer buf + (goto-char (point-min)) + (flan-inspect-next) + (test-flan--check "an expression root refuses a union case's field" + (string-match-p + "reached by (match" + (or (test-flan--caught #'flan-inspect-into) ""))))) + +(let ((asked nil)) + (let ((flan-inspect-request-function + (lambda (form) (push (plist-get form :code) asked) + (list :status "ok" + :value "(Cell {.id 1 .s (Shape.circle {.at (V {.x 1 .y 2})})})"))) + (flan-inspect-buffer " *test-inspect*")) + (when (get-buffer " *test-inspect*") (kill-buffer " *test-inspect*")) + (save-window-excursion + (flan-inspect--show '(:expr "c") nil) + (with-current-buffer " *test-inspect*" + (goto-char (point-min)) + (flan-inspect-next) (flan-inspect-next) ; .s, which holds the union + (test-flan--check "but a struct field that merely holds one is enterable" + (progn (flan-inspect-into) (equal (car asked) "(.s c)"))))))) + (test-flan--slot 0 1 "s" (lambda (form) diff --git a/lib/dev.ml b/lib/dev.ml index b4a7ee9..3f9e49b 100644 --- a/lib/dev.ml +++ b/lib/dev.ml @@ -921,7 +921,8 @@ let locals t ~frame = refused) ])) (* [(:op "inspect" :frame N :slot I :path (...))] — the inspector's second - rooting mode, and the answer to the hole [DISCUSS.md] item 1 named. + rooting mode. [BUILT.md]'s "Two ways to root a walk" says what each root + can and cannot do; this is the half that names a frame. [i] in the break buffer used to send a local's *name* to be evaluated as an expression. On the innermost frame that happens to be right; on any other