From 37f8f77380a56e2af3bbca66a752900b46feaf3b Mon Sep 17 00:00:00 2001 From: Joseph Ferano Date: Sat, 19 Sep 2026 10:16:03 +0700 Subject: [PATCH 1/4] The inspector can store, and a write names the stop it was addressed to MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit `(:op "set")` is `inspect`'s addressing with the arrow turned round: same frame, same slot index, same path steps, same fingerprint check, and a list of (path, expression) edits relative to what the buffer is showing. The thunk stores and then renders the same place, so what comes back is what the program holds afterwards rather than an echo of what was asked for. `stopped-only` was not enough for a write. It asks whether the program is stopped, and for a read that is the whole question — the worst a render can do against the wrong stop is print something true of a different frame. A module that *stores* through `flan/dev-slot` reaches its target through whatever snapshot is on top when the store runs, so a resume and a second stop inside the ~300ms build window lands it in the same slot index of a different stack. Not a fault: a plausible shape, in the wrong place, silently. So the agent grew `at-stop N` beside `stopped-only`, the generation `snap_push` already mints for the restart machinery, checked on the game thread at the moment the job is claimed. `stop` answers it, `inspect` carries it out on every reply, and a write that names a stop the program has left is refused before anything is built. Three refusals about where rather than what, and they are in session.ml above both backends because emit and x86 disagree about two of them. A data type's case field has no address that does not also settle the tag. An option's payload has none that does not settle whether there is one. A pointer would be an address this end made up, which is the blessing the registry exists to insist on. `Check.expression` grew a `want` and `Check.expressions` a shared frame: the first is why `3` into an `f32` field is an f32 three rather than "expected f32, found i32", and the second is why two edits in one commit are not two `let`s reading each other's storage. --- lib/check.ml | 48 ++++++- lib/dev.ml | 243 ++++++++++++++++++++++++++++++-- lib/session.ml | 282 ++++++++++++++++++++++++++++++++++++++ test/test_dev.ml | 235 +++++++++++++++++++++++++++++++ vendor/agent/flan_agent.c | 103 +++++++++++++- 5 files changed, 889 insertions(+), 22 deletions(-) diff --git a/lib/check.ml b/lib/check.ml index a8bf82a..67008a4 100644 --- a/lib/check.ml +++ b/lib/check.ml @@ -7070,17 +7070,55 @@ let instances_since env mark = (* One expression, checked against a program that is already running. The frame is empty — a REPL expression has no parameters and no enclosing - function — so the slots it needs are whatever its own [let]s allocate. *) -let expression env (e : Ast.expr) : - Tast.expr * Types.t array * string option array = + function — so the slots it needs are whatever its own [let]s allocate. + + [want] is the inspector's write verb and nothing else: [C-x C-e] has no + expectation to offer, but a store into a slot of type [f32] does, and the + whole value of passing it is that [3] arrives as an [f32] rather than as an + [i32] the store would then have to be refused for. The expectation flows + through [check] the way it flows anywhere — that is what bidirectional + means — and [expect] at the end is what catches the cases that ignore it, + so the refusal is the checker's own "expected f32, found string" and not a + second sentence written here that would drift from it. *) +(* Several of them against one frame, which is what the inspector's write verb + needs and what it must not build by hand. Two expressions checked + separately each number their slots from zero, so splicing them into one + thunk would have the second one's [let] reading and writing the first + one's storage — a frame that is two frames wearing one frame's clothes. + Sharing the [ctx] is the whole of the fix, and it is a fix because there is + exactly one allocator of slot indices in this compiler and it is this + record's counter. + + The expressions are otherwise independent: nothing binds a name for the + next one, because the list is a list of values being stored and not a + sequence. *) +let expressions env (es : (Types.t option * Ast.expr) list) : + Tast.expr list * Types.t array * string option array = let ctx = { env; ret = Types.Unit; slots = 0; slot_tys = []; slot_names = []; scope = []; defers = []; outer = []; outer_what = None; in_frames = None; loops = []; tail = false; in_defer = false; defer_ok = false; defer_block = "a nested form"; owner = "" } in - let t = check ctx e in - (t, Array.of_list (List.rev ctx.slot_tys), + (* Folded rather than mapped, because [List.map]'s order is unspecified and + every one of these calls has a side effect on [ctx] — the slot counter it + shares. An order nobody chose is one that can differ between builds, and + two frames laid out differently for the same edit is the kind of thing + that is found by somebody else, much later. *) + let ts = + List.rev + (List.fold_left + (fun acc (want, (e : Ast.expr)) -> + expect e.Ast.loc ~want (check ctx ?want e) :: acc) + [] es) + in + (ts, Array.of_list (List.rev ctx.slot_tys), Array.of_list (List.rev ctx.slot_names)) +let expression env ?want (e : Ast.expr) : + Tast.expr * Types.t array * string option array = + match expressions env [ (want, e) ] with + | [ t ], tys, names -> (t, tys, names) + | _ -> assert false + (* ── --no-gc ──────────────────────────────────────────────────────────── The flag that says this program is to be compiled with no collector in it, diff --git a/lib/dev.ml b/lib/dev.ml index 34baa6e..3904488 100644 --- a/lib/dev.ml +++ b/lib/dev.ml @@ -166,6 +166,30 @@ let deliver t path = String.trim (request t path) the *question*, not the code. *) let deliver_stopped_only t path = deliver t ("stopped-only " ^ path) +(* And the same again for a module that may only run from *one particular* + break. See the agent's [at_stop] note for why a write needs the stronger + promise: "stopped at all" lets a resume and a re-stop through, and a store + that goes through the shadow stack would then land in the same slot index + of a different stack. *) +let deliver_at_stop t ~gen path = + deliver t (Printf.sprintf "at-stop %d %s" gen path) + +(* Which stop the program is at: a number that is never reused, and 0 when it + is not stopped at all. + + [state] cannot stand in for this. Two stops at the same [(error (Boom …))] + are both [Stopped "Boom"], and "is this still the stop I rendered under" is + exactly the question they cannot tell apart — which is the question a write + has to have an answer to before it stores anything. + + [None] where the program cannot be reached or answers something else, and + the caller treats that the way it treats a missing refusal count: as no + evidence, not as zero. Zero is a fact — it means running. *) +let stop_gen t : int option = + match request t "stop" with + | exception Unix.Unix_error _ -> None + | text -> int_of_string_opt (String.trim text) + (* How many stopped-only modules the program has thrown away for reaching the game thread while it was running, and the sentence the agent says about it. @@ -1348,17 +1372,33 @@ let backtrace_op t = that storage has existed since the process started. Neither carries a permission that can go stale between the asking and the running, because neither was given one. Tagging them stopped-only would refuse work that is - sound, which is the other way to lose an answer. *) -let run_render_thunk ?(stopped_only = false) t ~tag ~(c : Session.change) - : (string, string) result = + sound, which is the other way to lose an answer. + + ── [at_stop], the third setting, and the only one a write may use ──── + + A write through [flan/dev-slot] is the case the paragraph above declares + safe and is not. What makes a *read* of a frame slot safe against a resume + is that [snap_top] is then empty and the render produces nothing; what makes + a write unsafe is that a resume followed by a second stop refills it, and + the store lands in the same slot index of a stack the reader never saw. + [stopped_only] is blind to that — the program is stopped, which is all it + asks. So a write names the generation instead, and the agent compares it + against the stop actually in force at the moment it claims the job. + + The wait below is shared: both settings are watched through the same + refusal counter, because the agent drops both the same way and the sentence + it hands back is the one that says which. *) +let run_render_thunk ?(stopped_only = false) ?at_stop t ~tag + ~(c : Session.change) : (string, string) result = let before = match result t with Some (g, _) -> g | None -> 0L in (* Read *before* the build, not before the wait: the resume this is watching for can land while llc is still running, and the job it kills is this one. [None] when the program cannot say, in which case nothing below compares against it — a missing count is no evidence either way. *) - let refused_before = if stopped_only then refusals t else None in + let watched = stopped_only || at_stop <> None in + let refused_before = if watched then refusals t else None in let resumed () = - match (refused_before, if stopped_only then refusals t else None) with + match (refused_before, if watched then refusals t else None) with | Some (before, _), Some (now, why) when now > before -> Some why | _ -> None in @@ -1367,7 +1407,11 @@ let run_render_thunk ?(stopped_only = false) t ~tag ~(c : Session.change) match build_module c ~debug:t.session.Session.debug ~out with | exception Failure m -> Error m | _ -> - (match (if stopped_only then deliver_stopped_only t out else deliver t out) with + (match + (match at_stop with + | Some gen -> deliver_at_stop t ~gen out + | None -> if stopped_only then deliver_stopped_only t out else deliver t out) + with | exception Unix.Unix_error (e, _, _) -> Error ("cannot reach the program: " ^ Unix.error_message e) | "ok" -> @@ -1645,7 +1689,126 @@ let inspect t ~frame ~slot ~path = 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 ])) + ":type " ^ Wire.quote ty; ":value " ^ Wire.quote v; + (* Which stop this was read at, so that a write built from + what is on the screen can name it and be refused if the + program has been round the loop since. Nothing about the + read needs it; it is put here because *here* is the only + moment at which it is true of what the reader is looking + at, and an editor that asked for it separately would be + asking a second time about a different instant. *) + ":at-stop " ^ string_of_int (Option.value ~default:0 (stop_gen t)) ])) + + +(* [(:op "set" :frame N :slot I :path (...) :edits (...) :at-stop G)] — the + inspector's other direction, and [docs/BUILT.md]'s "Writing one of them + back" is the argument for having it at all. + + The addressing is [inspect]'s, to the letter: same frame, same slot index, + same path steps, same [stopped_frame] fingerprint. A write that addressed + values its own way would be free to land somewhere the render above it + never showed, which is precisely the stale-slot answer both verbs exist to + refuse. [:edits] is a list of (path-from-here, expression) pairs, so one + field set from a line of the buffer and a whole edited value committed at + once are the same request with a different number of entries. + + ── The two stops, and why a write needs both to be the same ───────── + + [:at-stop] is the generation the editor last *read* at. It is compared + twice, and the two comparisons catch different things. + + Here, before anything is built: the program has been round its loop and + stopped again since the buffer was drawn, so what is on the screen + describes storage that has been through a frame of the game. Nothing is + wrong with the request except that its author has not seen what they are + about to overwrite. It is refused, with the fact, and looking again is the + whole of the fix. + + And in the agent, on the game thread, at the moment the module is claimed: + everything between this check and that one takes time — a third of a second + of llc, a delivery, a wait — and a game that breaks every frame closes that + window without trying. That check is the one that makes this sound; this + one is the one that makes it *legible*, because a refusal that arrives + before the build arrives in a tenth of the time and names the buffer rather + than the module. + + A write with no [:at-stop] is taken. The stop is still named to the agent — + this end reads it and hands it over — so the window is closed either way; + what is skipped is only the "you are looking at an older stop" check, which + a caller that never rendered anything has no answer for. *) +let set_slot t ~frame ~slot ~path ~edits ~expect_stop = + match stopped_frame t ~frame ~what:"a local" with + | Error m -> error m + | Ok (name, fn) -> + (match stop_gen t with + | None -> + error + "cannot ask the program which stop it is at, and a write that cannot \ + name its stop is one the program has no way to refuse if it has \ + moved on" + | Some 0 -> + (* [stopped_frame] passed and this says running, so the program resumed + in between. Said as the race it is rather than repeated as the + running refusal, which would read as a check that had been made and + had not. *) + error + "the program resumed while this was being asked; there is no frame to \ + store into any more" + | Some gen -> + (match expect_stop with + | Some want when want <> gen -> + error + (Printf.sprintf + "this was written against stop %d and the program is at stop %d \ + now: it ran on and stopped again, so what is on the screen is \ + not what would be overwritten. Look again and re-do the edit" + want gen) + | _ -> + (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 listing's refusal, and the same one [inspect] gives: an + unbound slot's entry is null, and storing through it would + fault on the game thread of a program that is already + stopped. A write faulting there is worse than a read doing + it — the program is not coming back from either, but this + one was asked to change something. *) + error + (Printf.sprintf + "slot %d of %s was not bound yet at the point the program \ + stopped; there is nothing at that address to store to" + slot name) + else + (* The rollback [eval_expr] takes and for its reason: checking + the stored expressions can instantiate a generic, the copies + land in the session before this module has been built or + taken, and a copy the session holds and no module defines is + a null cell. *) + let held = Session.held t.session in + let refused msg = Session.restore t.session held; error msg in + (match + Session.write_slot t.session ~frame ~fn ~slot ~path ~edits + with + | exception Loc.Error { Loc.dmsg = why; _ } -> refused why + | Error why -> refused why + | Ok (c, label, ty) -> + (match run_render_thunk ~at_stop:gen t ~tag:"s" ~c with + | Error m -> refused m + | Ok v -> + (* The value is what the *program* holds now, rendered by + the same thunk that did the storing — not an echo of + what was asked for. A buffer redrawn from this shows + the program's truth, which is the only reason it is + worth redrawing. *) + ok + [ ":frame " ^ Wire.quote name; ":name " ^ Wire.quote label; + ":type " ^ Wire.quote ty; ":value " ^ Wire.quote v; + ":wrote " ^ string_of_int (List.length edits); + ":at-stop " + ^ string_of_int + (Option.value ~default:0 (stop_gen t)) ]))))) (* ── The allocation registry, read from this end ───────────────────── *) @@ -2890,15 +3053,20 @@ let handle t req = 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" -> + | Some (("inspect" | "set") as verb) -> (match Wire.int_field req "slot" with - | None -> error "inspect needs :slot, the index the locals listing gave" + | None -> + error (verb ^ " 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 + (* Shared with [set], which addresses the same way down to the step — + one reader and not two, because a write that read its path by a + second set of rules could reach a value the render above it never + showed, which is the whole thing both verbs are built to refuse. *) + let path_of what (f : Form.t option) = + match f with | Some { Form.v = Form.List l; _ } -> List.fold_left (fun acc (e : Form.t) -> @@ -2919,12 +3087,59 @@ let handle t req = 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" + | Some _ -> Error (what ^ " is a list") | None -> Ok [] in - (match steps with + (match path_of (verb ^ "'s :path") (Wire.field req "path") with | Error m -> error m - | Ok path -> inspect t ~frame ~slot ~path)) + | Ok path -> + if verb = "inspect" then inspect t ~frame ~slot ~path + else + (* [:edits] is a list of [(:path (...) :code "...")], each path + relative to [:path] above. A list even for one edit, because + the buffer commit and the single field set are the same + request and a shorthand for the second would be a second shape + to keep in step with the first. *) + let edits = + match Wire.field req "edits" with + | None -> + Error + "set needs :edits, a list of (:path (...) :code \"...\") — \ + what to store and where, relative to :path" + | 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.List _ -> + (match Wire.string_field e "code" with + | None -> + Error + "every :edits entry needs :code, the expression \ + whose value is to be stored" + | Some code -> + (match + path_of "an :edits entry's :path" + (Wire.field e "path") + with + | Error m -> Error m + | Ok steps -> Ok ((steps, code) :: got))) + | _ -> + Error + "every :edits entry is a list: (:path (...) :code \ + \"...\")")) + (Ok []) l + |> Result.map List.rev + | Some { Form.v = Form.Sym "nil"; _ } -> Ok [] + | Some _ -> Error "set's :edits is a list" + in + (match edits with + | Error m -> error m + | Ok edits -> + set_slot t ~frame ~slot ~path ~edits + ~expect_stop:(Wire.int_field req "at-stop")))) (* 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 230158c..04a2146 100644 --- a/lib/session.ml +++ b/lib/session.ml @@ -1186,6 +1186,288 @@ let render_slot ?(origin = "") t ~frame ~(fn : Tast.fn) ~slot ~path name ^ path_text path, Types.to_string v.Tast.ty))) +(* ── Writing one of them back ──────────────────────────────────────── *) + +(* The inspector's other direction. SLY sets a value from the inspector and + the reason it is worth having here is the same one the read half has: a + game keeps its state in a struct somewhere, and the loop between "that + field is wrong" and "is it this value that fixes it" is the loop the whole + dev story is about. Changing it in the source and reloading answers a + different question — it answers what the *next* run does. + + Everything about the addressing is the read half's, deliberately and not + for economy: the same root, the same [step_into], the same refusals for a + field a type does not have. A write that addressed values its own way would + be free to land somewhere the render above it never showed, which is the + whole class of bug [render_slot] exists to have closed. + + What is new is two things. The walk has to end at a *place* and not at a + value, and the value being stored is an expression somebody typed, so it + goes through the checker against the type the walk ended at. Both of those + refuse, and both refuse with a sentence rather than by doing something + smaller than was asked. *) + +(* The walk's last expression, as somewhere to store. + + [step_into] builds exactly four shapes and three of them are places. That + is not a coincidence to be relied on quietly, so the fourth is named here + rather than left to fall through to a backend: [emit]'s [place] would + [failwith] on it and [x86]'s would not, and two backends disagreeing about + what is writable is worse than either answer. + + Refused with the reason, not the layout. "A data type has no place form" is + a fact about this compiler; "the tag is what says which case the bytes are" + is the fact about the program, and it is the one that says why writing the + field alone would be wrong even if the offset were right. *) +let place_of (v : Tast.expr) : (Tast.place, string) result = + match v.Tast.e with + | Tast.Deref p -> Ok (Tast.Pderef p) + | Tast.Prim (Tast.At, target :: idx) when idx <> [] -> + Ok (Tast.Pindex (target, idx)) + (* [Ssome] builds this too, and it is the one [Field] that is not writable: + an option is a tag and a payload, and storing the payload on its own + leaves a [None] holding a value — a value nothing will ever read, because + every reader asks the tag first. Set the option itself. *) + | Tast.Field (target, _) when (match target.Tast.ty with + | Types.Option _ -> true | _ -> false) -> + Error + "an option's payload is not a place on its own: the tag is what says \ + whether there is one, and storing past it would leave a None holding a \ + value nothing will ever look at. Set the option itself" + | Tast.Field (target, i) -> Ok (Tast.Pfield (target, i)) + | Tast.CaseField (_, case, _) -> + Error + (Printf.sprintf + "%s is a field of a data type's case, and which case the bytes are in \ + is what the tag says — so there is no address to store to that does \ + not also have to settle the tag. Set the whole value instead" + case) + | _ -> + Error + (Printf.sprintf "%s is not somewhere a value can be stored" + (Types.to_string v.Tast.ty)) + +(* And the types that are places but must not be written through the editor. + + A [Ptr] is the one that matters. Every other refusal here is about a shape; + this one is about where the number would come from. A pointer value typed + into a prompt is an address this end made up, and the registry's whole + argument is that an address is only worth anything with a blessing beside + it. Storing one would hand the program a pointer nothing ever blessed, to + be dereferenced at a moment nobody chose. The read half refuses to *follow* + a pointer for the same reason it is refused here. *) +let writable_type (ty : Types.t) : (unit, string) result = + match ty with + | Types.Ptr _ -> + Error + (Printf.sprintf + "%s is a pointer, and an address typed in here is one this end made \ + up: nothing blessed it, and the program would dereference it at a \ + moment nobody chose. The inspector does not follow pointers either" + (Types.to_string ty)) + | _ -> Ok () + +(* Stores into slot [slot] of frame [frame], one store per [edits] entry, + after walking [path]. + + A list and not one store, because the buffer this exists for hands back a + whole value with several fields changed in it. N modules would be N builds + of a third of a second each and N trips past the agent's gate — so a + five-field edit would feel broken, and, worse, would be five separate + moments for a resume to land between. One module is one job: either every + store in it happened at this stop or none of them did. + + Each edit's steps are relative to [path], which is what the buffer is + showing. A single field set from a line of the inspector is one edit with + one step; a whole value committed is one edit per changed leaf, with the + steps that reach it. + + The thunk stores and then *renders*, between the same [dev-begin] and + [dev-end] the read half uses, and what comes back is therefore not the + editor's idea of what it asked for: it is what is actually there + afterwards, read out of the program's own storage by the printer that drew + the buffer in the first place. + + [retains] is left at its default on purpose. A module that stores a string + literal leaves the program pointing into that module's image, and the + default is what keeps the mapping alive for it; claiming otherwise here to + save a page would be [(set msg "tuned")] left pointing at unmapped memory, + which [emit.ml] spells out where it writes [flan_reload_transient]. + + The caller has established the frame, as it has for [render_slot]. *) +let write_slot ?(origin = "") t ~frame ~(fn : Tast.fn) ~slot ~path + ~(edits : (step list * string) list) + : (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 if edits = [] then + (* Not a no-op quietly performed. A commit that found nothing to write is + a fact worth saying, and a module built to store nothing would cost a + third of a second to say it. *) + Error "there is nothing to store: nothing in this was changed" + 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 where = name ^ path_text path 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 (where ^ ": " ^ why) + | Ok shown -> + (* Two passes over the edits, and the split is the point. This one + settles every *place* and refuses the whole commit if any of them + is not one, before a single expression has been read — so a buffer + with one impossible field in it stores nothing rather than storing + the fields that happened to sort first. The module's + all-or-nothing property would be an empty promise if this end had + already half-decided. *) + let rec places acc = function + | [] -> Ok (List.rev acc) + | (steps, code) :: rest -> + let at = where ^ path_text steps in + (match walk shown steps with + | Error why -> Error (at ^ ": " ^ why) + | Ok target -> + (match writable_type target.Tast.ty with + | Error why -> Error (at ^ ": " ^ why) + | Ok () -> + (match place_of target with + | Error why -> Error (at ^ ": " ^ why) + | Ok dest -> + places ((at, dest, target.Tast.ty, code) :: acc) rest))) + in + (match places [] edits with + | Error why -> Error why + | Ok targets -> + (* And this one reads and checks the values. Every expression is + checked against one [ctx] — [Check.expressions], not one + [Check.expression] each — because two expressions checked apart + both number their slots from zero, and splicing them into one + thunk would have the second one's [let] reading and writing the + first one's storage. *) + let mark = Check.instance_mark t.env in + let wanted = + List.map + (fun (at, _, tty, code) -> + let form = + match Reader.read_all ~file:origin code with + | [ f ] -> f + | [] -> fail loc "nothing to store into %s" at + | _ :: f :: _ -> fail f.Form.loc "one value at a time" + in + (* Expanded with the session's imported macros in front of + it, for the reason [eval_expr] gives: the prompt sends + one expression with no import in sight, and the session + is the only thing holding what the imports brought in. *) + (Some tty, Parse.with_imported t.macros (fun () -> Parse.expr form))) + targets + in + (* Checked *against the place's type*, which is the whole reason + [Check.expression] grew a [want]. Without it, [7] into an [f32] + field arrives as an [i32] and is refused for a mismatch the + reader never wrote; with it, it arrives as an [f32], and what + stays refused is what really does not fit — in the checker's + own words, which is the only place that sentence should ever be + written down. *) + let values, base, bnames = Check.expressions t.env wanted in + let fresh = Check.instances_since t.env mark in + let stores = + List.map2 + (fun (_, dest, _, _) value -> + { Tast.e = Tast.Set (dest, value); ty = Types.Unit; loc }) + targets values + in + let extra = ref [] and nslots = ref (Array.length base) in + let c = + { Render.structs = t.program.Tast.structs; + datas = t.program.Tast.datas; + unions = t.program.Tast.unions; + enums = + Hashtbl.fold (fun k v acc -> (k, v) :: acc) t.env.Check.enums []; + emit = dev_emitter; + ptrs = Some dev_pointers; + alloc = (fun ty -> + let i = !nslots in + incr nslots; + extra := ty :: !extra; + i) } + in + (match Render.render c 0 shown with + | exception Loc.Error { Loc.dmsg = why; _ } -> + Error (where ^ ": " ^ why) + | parts -> + let nullary n = + { Tast.e = Tast.Call (n, []); ty = Types.Unit; loc } + in + t.thunks <- t.thunks + 1; + let tname = Printf.sprintf "set/%d" t.thunks in + let thunk : Tast.fn = + { Tast.name = tname; params = []; ret = Types.Unit; + body = + stores + @ (nullary "flan/dev-begin" :: parts) + @ [ nullary "flan/dev-end" ]; + fdefers = []; fparent = None; floc = loc; + slots = Array.append base (Array.of_list (List.rev !extra)); + (* The stored expressions' own [let]s keep their names; the + slots [render] added behind them are the walk's own + scratch and have none to keep. *) + snames = + Array.append bnames + (Array.make (List.length !extra) None) } + in + let program = + { t.program with + Tast.fns = t.program.Tast.fns @ fresh @ [ thunk ]; + externs = t.program.Tast.externs @ externs } + in + let ir = + redefinition t ~call:tname program + ~fns: + (List.map (fun (f : Tast.fn) -> f.Tast.name) fresh + @ [ tname ]) + in + (* The instances the values forced stay, the thunk does not — + [eval_expr] says why, and the caller takes the same [held] + around this that it takes around one. *) + t.program <- + { t.program with Tast.fns = t.program.Tast.fns @ fresh }; + Ok + ({ ir; x86 = t.x86; names = []; fns = []; installs = true }, + where, Types.to_string shown.Tast.ty)))) + (* ── The globals a stopped stack reaches ───────────────────────────── *) (* The other half of what a break loop can show, and in this language arguably diff --git a/test/test_dev.ml b/test/test_dev.ml index a9fccd1..905a51a 100644 --- a/test/test_dev.ml +++ b/test/test_dev.ml @@ -1867,6 +1867,241 @@ let () = end end; + (* ── Writing one of them back ─────────────────────────────────── *) + + (* The inspector's other direction. Its own daemon over the same program, + because the block above finishes by redefining [outer] under its own + frame on purpose — which is exactly the state in which nothing may be + written, so it is no state to write from. + + What is checked here is the three claims the verb makes. The store + lands where the render said it would, and the value that comes back is + read out of the program afterwards rather than echoed. The expression + is checked against the *place's* type, so a literal arrives at the + width the place has and a value that does not fit is refused in the + checker's own words. And a write that cannot name the stop it was + addressed to is refused rather than aimed at whatever stack happens to + be there. *) + let wsock = tmp "set.sock" and wout = tmp "set.out" in + (try Sys.remove wsock with Sys_error _ -> ()); + let wfd = Unix.openfile wout [ Unix.O_WRONLY; Unix.O_CREAT; Unix.O_TRUNC ] 0o600 in + let wpid = + Unix.create_process flan + [| flan; "dev"; "programs/dev-inspect.flan"; "-s"; wsock; "--llvm" |] + Unix.stdin wfd Unix.stderr + in + Unix.close wfd; + if not (listening ~pid:wpid wsock) then begin + fail "the set daemon %s" !listen_why; + (try Unix.kill wpid Sys.sigkill with Unix.Unix_error _ -> ()) + end + else begin + let c = connect wsock 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 message r = Option.value ~default:(status r) (Wire.string_field r "message") in + let value r = Option.value ~default:"" (Wire.string_field r "value") in + if not (await (fun () -> stopped (ask "(:op \"describe\")"))) then + fail "the set program never stopped" + else begin + 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" (message listing) + else begin + let slot name = + match slot_of listing name with + | Some s -> s + | None -> + fail "the locals listing gave no slot index for %s" name; + -1 + in + let set ?(path = "()") name edits = + ask + (Printf.sprintf "(:op \"set\" :frame 1 :slot %d :path %s :edits %s)" + (slot name) path edits) + in + let inspect ?(path = "()") name = + ask + (Printf.sprintf "(:op \"inspect\" :frame 1 :slot %d :path %s)" + (slot name) path) + in + (* One field, addressed the way a line of the buffer addresses it: + the path reaches the field and the edit stores at it. The reply's + value is the field read back, and the inspection after it is the + independent one — the same thunk that stored could in principle + have rendered the value it was handed rather than the storage. *) + let r = set ~path:"(\"x\")" "mark" "((:code \"3.5\"))" in + if status r <> "ok" then fail "setting mark.x: %s" (message r) + else if value r <> "3.5" then + fail "setting mark.x answered %s, not 3.5" (value r); + let r = inspect ~path:"(\"x\")" "mark" in + if value r <> "3.5" then + fail "mark.x reads back as %s after the write, not 3.5" (value r); + + (* And the literal arrives at the *place's* width. Without the + expectation flowing into the checker this is the i32 three and + "expected f32, found i32"; with it, it is the f32 three, which is + the whole of what [Check.expression]'s [want] buys. *) + let r = set ~path:"(\"x\")" "mark" "((:code \"3\"))" in + if status r <> "ok" then + fail "an integer literal into an f32 field: %s" (message r) + else if value r <> "3" then + fail "the integer three into an f32 field read back as %s" (value r); + + (* Several fields at once, which is the buffer commit: one module, + one job, one render of what is there afterwards. *) + let r = + set "mark" "((:path (\"x\") :code \"9.25\") (:path (\"y\") :code \"8.5\"))" + in + if status r <> "ok" then fail "setting both fields of mark: %s" (message r) + else if value r <> "(Point {.x 9.25 .y 8.5})" then + fail "the pair of writes answered %s" (value r); + if Wire.int_field r "wrote" <> Some 2 then + fail "a two-edit commit did not report writing two"; + + (* The whole value, not a field of it. *) + let r = set "mark" "((:code \"(Point {.x 0.5 .y 0.25})\"))" in + if status r <> "ok" then fail "setting mark whole: %s" (message r) + else if value r <> "(Point {.x 0.5 .y 0.25})" then + fail "setting mark whole answered %s" (value r); + + (* An element, through the same [at] the render walks. The value is + an expression and not a literal, because the point of sending + Flan rather than a number is that it is evaluated in the + program. *) + let r = set "xs" "((:path (1) :code \"(+ 20 5)\"))" in + if status r <> "ok" then fail "setting xs[1]: %s" (message r) + else if value r <> "[ 10 25 30]" then + fail "setting xs[1] answered %s" (value r); + + (* A value that does not fit is refused in the checker's own words, + and nothing is stored. *) + let r = set ~path:"(\"x\")" "mark" "((:code \"\\\"hello\\\"\"))" in + if status r <> "error" then + fail "a string stored into an f32 field was accepted" + else if not (contains_sub (message r) "expected f32") then + fail "the type refusal does not name the type: %s" (message r); + let r = inspect "mark" in + if value r <> "(Point {.x 0.5 .y 0.25})" then + fail "the refused write changed something: %s" (value r); + + (* Two refusals about where, not about what. A data type's field has + no address that does not also settle the tag, and an option's + payload has none that does not settle whether there is one. Both + are readable — the block above reads them — which is the point: + what can be shown and what can be stored to are different sets, + and each refusal says which it is. *) + let r = set ~path:"(\"Shape.Rect.w\")" "s" "((:code \"11\"))" in + if status r <> "error" then + fail "a data type's case field was written to" + else if not (contains_sub (message r) "tag") then + fail "the data type refusal does not say why: %s" (message r); + let r = set ~path:"(some)" "box" "((:code \"(Point {.x 1.0 .y 1.0})\"))" in + if status r <> "error" then + fail "an option's payload was written to on its own" + else if not (contains_sub (message r) "None") then + fail "the option refusal does not say why: %s" (message r); + + (* An edit whose path is impossible refuses the whole commit, so the + good edit beside it does not land either. All-or-nothing is what + makes one module per commit worth anything. *) + let r = + set "mark" "((:path (\"x\") :code \"77.0\") (:path (\"z\") :code \"1.0\"))" + in + if status r <> "error" then fail "a commit with a bad field was taken"; + let r = inspect ~path:"(\"x\")" "mark" in + if value r <> "0.5" then + fail "half of a refused commit landed anyway: %s" (value r); + + (* And a write addressed to a stop the program is no longer at is + refused before anything is built. The number is one the program + cannot be at — generations start at one and count up — so this is + the mismatch and not a program that happens to have moved. *) + let r = + ask + (Printf.sprintf + "(:op \"set\" :frame 1 :slot %d :path () :edits ((:code \"(Point {.x 2.0 .y 2.0})\")) :at-stop 999999)" + (slot "mark")) + in + if status r <> "error" then + fail "a write against a stop the program is not at was taken" + else if not (contains_sub (message r) "Look again") then + fail "the stale-stop refusal does not say what to do: %s" (message r); + + (* The stop the reads have been carrying all along is the one the + writes have been landing at, which is what makes the editor able + to hold it between the two. *) + let r = inspect "mark" in + (match Wire.int_field r "at-stop" with + | Some g when g > 0 -> + let r = + ask + (Printf.sprintf + "(:op \"set\" :frame 1 :slot %d :path (\"y\") :edits ((:code \"4.5\")) :at-stop %d)" + (slot "mark") g) + in + if status r <> "ok" then + fail "a write naming the stop it read at: %s" (message r) + else if value r <> "4.5" then + fail "the write naming its stop answered %s" (value r) + | _ -> fail "an inspection did not say which stop it read at") + end; + (* An unbound slot has nothing to store to, and says so rather than + faulting on the game thread of a program that is already stopped. *) + let r = ask "(:op \"set\" :frame 0 :slot 0 :path () :edits ((:code \"1\")))" in + if status r <> "error" then + fail "a frame with no slots was written to" + end; + (* And a running program has no frame to store into. The same refusal + the read half gives, through the same check, which is the point of + it being the same check. *) + let r = ask "(:op \"restart\" :name \"carry-on\")" in + if status r <> "ok" then + fail "resuming the set program: %s" + (Option.value ~default:"" (Wire.string_field r "message")); + if not (await (fun () -> not (stopped (ask "(:op \"describe\")")))) then + fail "the set program never resumed" + else begin + let r = ask "(:op \"set\" :frame 1 :slot 0 :path () :edits ((:code \"1\")))" in + if status r <> "error" then + fail "a running program was written to" + end; + ignore (ask "(:op \"close\")"); + Unix.close c; + if not + (await ~ms:5000 (fun () -> + match Unix.waitpid [ Unix.WNOHANG ] wpid with + | 0, _ -> false + | _ -> true + | exception Unix.Unix_error _ -> true)) + then begin + (try Unix.kill wpid Sys.sigkill with Unix.Unix_error _ -> ()); + (try ignore (Unix.waitpid [] wpid) with Unix.Unix_error _ -> ()) + end + end; + (* ── A pointer the registry knows about ───────────────────────── *) (* The inspector's pointer arm, and the address root beside it. diff --git a/vendor/agent/flan_agent.c b/vendor/agent/flan_agent.c index 01a00f5..e376ad1 100644 --- a/vendor/agent/flan_agent.c +++ b/vendor/agent/flan_agent.c @@ -176,12 +176,41 @@ int flan_dev_reg_overflowed(void); * [handle] is set only for a module that declared itself transient — one that * ran a thunk and left nothing behind. Everything else is kept mapped forever: * a cell holds an address inside a module's text, and unloading it would leave - * every call site pointing at unmapped memory. */ + * every call site pointing at unmapped memory. + * + * ── [at_stop], and why [stopped_only] is not enough for a *write* ────── + * + * [stopped_only] asks "is the program stopped", and for a read that is the + * whole question: the worst a render can do against the wrong stop is print + * something that was true of a different frame, and it is printed into a + * buffer nobody stores anywhere. + * + * A write is not that. A module that *stores* into frame N slot I reaches its + * target through [flan_agent_frame_slot], which reads whatever snapshot is on + * top at the moment the store runs. Resume and stop again inside the build + * window — ~300ms of llc, and a game loop that breaks every frame closes that + * window without trying — and [depth] is above zero again, the job is + * accepted, and the store lands in frame N of a *different* stack. Not a + * fault: a plausible shape, in the wrong place, silently. + * + * So a write names the stop it was addressed against. [snap_push] mints a + * generation that is monotone and never reused, precisely so that "resumed + * and stopped again" is distinguishable from "still the same stop" — the + * restart machinery already leans on it for the same reason. [at_stop] is + * that number, asked for by the daemon through [stop] and handed back on the + * request, and checked here, on the game thread, at the moment the job is + * claimed. Zero means the job does not care, which is every read. + * + * It sits beside [stopped_only] rather than subsuming it because they are two + * different questions and one of them has no answer to give: a render rooted + * at a raw address wants "stopped at all" and has no stop to name, since the + * registry that blessed the address is not a stack. */ typedef struct { install_fn install; call_fn call; void *handle; int stopped_only; + int32_t at_stop; } job; /* Said once, in one place, and shipped to the daemon over [refusals] rather @@ -193,6 +222,24 @@ static const char *RESUMED = "the program resumed while this inspection was being built — stop it again " "and re-ask"; +/* The other way a job's stop can stop being the job's stop, and it needs its + * own sentence because the fix is a different one. Above, the program is + * running and the reader has to stop it. Here it *is* stopped — at a stop + * that came after the one the request named — so stopping it again would do + * nothing, and what is wanted is to look at what is there now. A write built + * against a render of the old stop would otherwise land in storage the reader + * never saw. */ +static const char *RESTOPPED = + "the program was resumed and stopped again while this was being built, so it " + "is no longer at the stop this was addressed to — look again and re-ask"; + +/* Which of the two the last drop was. One counter and two sentences rather + * than two counters, because the daemon's question is "did a drop happen + * between these two reads" and that is a count; the text is only what it says + * afterwards. Last writer wins, which is the residual [refused_while_running] + * already documents below for two inspections in flight at once. */ +static const char *_Atomic refused_why = NULL; + /* How many stopped-only jobs have been dropped, ever. A count and not a flag: * the daemon reads it before it delivers and again while it waits, and what it * wants to know is whether one happened *in between*, which a flag somebody @@ -734,10 +781,25 @@ int32_t flan_agent_poll(void) { * nothing was installed, and [n] is what a caller polls to find out that * something was. */ if (j.stopped_only && atomic_load(&depth) <= 0) { + atomic_store(&refused_why, RESUMED); atomic_fetch_add(&refused_while_running, 1); if (j.handle != NULL) { dlclose(j.handle); } continue; } + /* And the same gate for a job that named a stop. Read from [snap_top] and + * not from [snap_gen], which is the counter and not the stop: after a + * resume [snap_gen] still holds the generation of the break that ended, + * so comparing against it would accept a job whose stop is over. The + * snapshot on top is the stop that is in force. */ + if (j.at_stop != 0) { + snapshot *s = snap_top(); + if (s == NULL || s->gen != j.at_stop) { + atomic_store(&refused_why, s == NULL ? RESUMED : RESTOPPED); + atomic_fetch_add(&refused_while_running, 1); + if (j.handle != NULL) { dlclose(j.handle); } + continue; + } + } if (j.install != NULL) { j.install(); n++; } /* After the install, so a thunk sees the bodies its own module published. * @@ -1199,10 +1261,28 @@ static void handle_line(char *line, sink *o) { int k = snprintf(hdr, sizeof hdr, "%llu\n", (unsigned long long)atomic_load(&refused_while_running)); if (k > 0) emit(o, hdr, (size_t)k); - reply(o, RESUMED); + const char *why = atomic_load(&refused_why); + reply(o, why != NULL ? why : RESUMED); reply(o, "\n"); return; } + /* Which stop the program is at, as a number that is never reused and never + * zero — zero being "it is not stopped". [status] cannot answer this: two + * stops at the same [(error (Boom …))] are both "stopped Boom", and telling + * them apart is the whole question a write has to ask before it stores into + * a frame somebody rendered a moment ago. + * + * Its own verb rather than a field on [status] or [backtrace], because both + * of those have readers in flight and a reply format is a thing two ends + * agree on. Answered while running as well, for [status]'s reason: an + * editor polls this without knowing the state already. */ + if (strcmp(line, "stop") == 0) { + snapshot *s = (atomic_load(&depth) > 0) ? snap_top() : NULL; + char hdr[32]; + int k = snprintf(hdr, sizeof hdr, "%d\n", s == NULL ? 0 : s->gen); + if (k > 0) emit(o, hdr, (size_t)k); + return; + } if (strcmp(line, "result") == 0) { uint64_t gen = 0, len = 0; uint64_t cap = flan_dev_result_cap(); @@ -1404,6 +1484,23 @@ static void handle_line(char *line, sink *o) { stopped_only = 1; line += 13; } + /* [at-stop N ] travels the same way and for the same reason, and it goes + * after [stopped-only ] so that a module which is both spells it + * "stopped-only at-stop 7 /path". Nothing sends both today — naming a stop + * already implies one — but the two prefixes answer different questions and + * a parser that made them exclusive would have to be revisited the first + * time something wants the pair. The number is parsed here rather than + * trusted: a path beginning "at-stop " with no number after it is a path, + * and treating it as a malformed prefix would lose the module. */ + int32_t at_stop = 0; + if (strncmp(line, "at-stop ", 8) == 0) { + char *end = NULL; + long n = strtol(line + 8, &end, 10); + if (end != line + 8 && *end == ' ' && n > 0 && n <= 0x7fffffff) { + at_stop = (int32_t)n; + line = end + 1; + } + } /* Before the dlopen, not after it: a module there is no room to queue is * one there is no point relocating, and refusing here means no handle is * taken for it at all. Only one producer runs at a time, so room seen now is @@ -1455,7 +1552,7 @@ static void handle_line(char *line, sink *o) { * is the failure being fixed. */ if (!publish((job){ .install = f, .call = c, .handle = transient == NULL ? NULL : h, - .stopped_only = stopped_only })) + .stopped_only = stopped_only, .at_stop = at_stop })) fprintf(stderr, "flan: reload queue full after it was checked\n"); return; } From 416ce10ee7fe1527b89d08ecfa2e7f76acab6137 Mon Sep 17 00:00:00 2001 From: Joseph Ferano Date: Sat, 19 Sep 2026 10:30:56 +0700 Subject: [PATCH 2/4] The inspector buffer is the value, and a commit is a diff MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit `e` on a line sets that field: prompted with what is there, sending a Flan expression that the program evaluates and the checker measures against the type of the place it is going into. `C-c C-e` turns the buffer into the value — the Flan literal the program wrote, which is the value's own spelling and not a second notation invented for editing it — and `C-c C-c` commits, `C-c C-k` abandons. A commit is a diff. The buffer is read back as a value, compared leaf by leaf with what was drawn, and one write goes out per leaf that changed, so editing one field does not rewrite the others with whatever was on the screen. A shape that changed is a refusal and it voids the edits collected before it: the walk visits fields in order, so a struct with one good change and one impossible one has already collected the good one, and handing that back beside the refusal would make it possible to send half of what was asked for. The truncation guard is the one that is easy to miss. `...` is what the renderer writes where it stopped, and a commit read off a buffer holding one could not tell a field that was never written from one somebody deleted — so such a value refuses to be opened for editing at all. Writing is refused on the expression and address roots, by name. An expression is evaluated wherever the evaluator stands and whenever it next reaches a frame boundary, which for a write means possibly into a running program; globals stay unwritable from here until they have a root that names a stop. test-flan.el runs the whole chain against a real daemon — a frame, a slot index off the listing, a render, a set, a re-read, a typed refusal, an edited buffer, a commit, and a commit against a stop the program has left. --- docs/BUILT.md | 91 +++++++++ emacs/MANUAL.md | 79 ++++++++ emacs/flan-inspect.el | 403 ++++++++++++++++++++++++++++++++++++++- emacs/test-flan-cider.el | 274 ++++++++++++++++++++++++++ emacs/test-flan.el | 86 ++++++++- 5 files changed, 925 insertions(+), 8 deletions(-) diff --git a/docs/BUILT.md b/docs/BUILT.md index ceb9d46..4f04896 100644 --- a/docs/BUILT.md +++ b/docs/BUILT.md @@ -4501,6 +4501,97 @@ expression root with an effect in it would fire once a second for ever. 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. +## Writing one of them back, and the difference between a stop and being stopped + +SLY sets a value from its inspector; this does that and then the thing the author actually wanted, which is the buffer +*being* the value. Both are `(:op "set" :frame N :slot I :path (...) :edits (...) :at-stop G)` — one edit for `e` on a +line, one per changed leaf for a committed buffer — and both are refused whole if any single edit is impossible. + +**The addressing is `inspect`'s, to the letter**, and that is not economy. Same `stopped_frame`, same slot index, same +`Session.step_into`, read by the same wire parser. A write that addressed values its own way would be free to land +somewhere the render above it never showed, which is exactly the stale-slot answer both verbs exist to refuse. What is +new is that the walk has to end at a **place** rather than a value, and that the value being stored is an expression +somebody typed, checked against the type the walk ended at. + +### `stopped_only` is not enough for a write, and the gap is not small + +The gate at `flan_agent_poll` asked `j.stopped_only && depth <= 0` — "is the program stopped". For a *read* that is the +whole question: the worst a render can do against the wrong stop is print something that was true of a different frame, +into a buffer nobody stores anywhere. + +A write is not that. A module that stores through `flan/dev-slot` reaches its target through whatever snapshot is on +top when the store runs. Resume and stop again inside the build window — ~300ms of `llc`, and a game that breaks every +frame closes it without trying — and `depth > 0` is true again, the job is accepted, and the store lands in the same +slot index of a different stack. Not a fault: a plausible shape, in the wrong place, silently. Nothing already here +catches it. The slot fingerprint does not: the same function re-entered has the same fingerprint. The refusal counter +does not: it counts jobs that were *dropped*, and this one is not. + +So a write names the **stop** and not the state. `snap_push` has minted a monotone, never-reused generation since the +restart machinery needed one for the same reason, and it travels on the request as `at-stop N ` beside `stopped-only ` +— in front of the path rather than inside the module, for `stopped_only`'s own reason: what is stopped-only, or +addressed to one stop, is the *question* and not the code. A new `stop` verb answers the current one (0 while +running), `inspect` carries it out on every reply, and it is checked twice: + +- in the daemon, before anything is built, so a stale buffer refuses in a tenth of the time and the sentence names the + buffer rather than the module; +- in the agent, on the game thread, at the moment the job is claimed — which is the check that makes it *sound*, since + everything between the two takes time. + +The two drops say different sentences, because the fixes differ. Resumed: stop it again. Re-stopped: stopping it again +does nothing, and what is wanted is to look at what is there now. + +### Three refusals about where, above both backends + +`Session.step_into` builds four shapes and three of them are places. The fourth is named in `session.ml` rather than +left to a backend, because `emit`'s `place` would `failwith` on an Option — it derives the type through `Named n` — +and `x86`'s `field_loc` handles one fine. Two backends disagreeing about what is writable is worse than either answer. + +Each refusal gives the reason about the *program*, not about the compiler. A data type's case field: which case the +bytes are in is the tag, so there is no address to store to that does not also settle it. An option's payload: storing +past the tag leaves a `None` holding a value nothing will ever look at. A pointer: an address typed into a prompt is +one the editor made up, nothing blessed it, and the program would dereference it at a moment nobody chose — which is +the read half's rule said in the other direction. + +### `Check.expression` grew a `want`, and `Check.expressions` a shared frame + +The first is why `3` into an `f32` field is an f32 three. Without an expectation the literal takes its default width +and the store is refused for a mismatch the reader never wrote; with one it arrives at the place's type, and what stays +refused is what really does not fit — in the checker's own words, which is the only place that sentence should be +written down. + +The second is the batch. Two expressions checked apart both number their slots from zero, so splicing them into one +thunk would have the second one's `let` reading and writing the first one's storage: a frame that is two frames wearing +one frame's clothes. There is exactly one allocator of slot indices in this compiler and it is `ctx`'s counter, so +sharing the `ctx` is the whole of the fix. + +The thunk stores and then **renders the same place**, between the same `dev-begin`/`dev-end` the read half uses. What +comes back is therefore not the editor's idea of what it asked for; it is what is there afterwards, read by the printer +that drew the buffer. One job also means the store and the reading of it cannot straddle a resume. `retains` is left at +its default: a module that stores a string literal leaves the program pointing into that module's image, and the +default is what keeps the mapping alive for it. + +### The buffer as the value + +A rendered Flan value is a Flan literal, so the editable form of the value is the value's own spelling — no second +notation, nothing to translate. `flan-inspect--literal` lays it out over lines and round-trips through +`flan-inspect-parse`, which is what makes a commit a comparison of two *parses* rather than of two strings. + +A commit is a diff and not a blast. One write per changed leaf, so editing one field of a struct does not rewrite the +others with whatever was on the screen — which matters exactly when it is hardest to see that it does. A shape that +changed is a refusal rather than an edit, and the refusal voids the edits that were collected before it: the walk +visits fields in order, so a struct with one good change and one impossible one has already collected the good one, and +handing that back beside the refusal would make it possible to send half of what was asked for. + +The one guard that is easy to miss: a value the renderer truncated cannot be opened for editing at all. `...` is what +it writes where it stopped, and a commit read off a buffer containing one could not tell a field that was never written +from a field somebody deleted. + +**Writing is refused on the expression and address roots**, by name. Not an omission to be worked around by sending +`(set …)` to be evaluated: an expression is evaluated wherever the evaluator stands and at whatever moment it next +reaches a frame boundary, which for a write means possibly into a running program. That leaves globals unwritable from +the inspector for now, since the break buffer roots them at an expression — `C-x C-e` on `(set the-global …)` does that +write knowingly, and the inspector will not do it behind a key that looks like the safe one. + ## The watch window, and why it is the only listing that is pushed The port of the author's Clojure `watch.el`, with the good idea kept and the transport turned round. The original is diff --git a/emacs/MANUAL.md b/emacs/MANUAL.md index 742d822..5a45a95 100644 --- a/emacs/MANUAL.md +++ b/emacs/MANUAL.md @@ -376,6 +376,8 @@ per line. | `g` | read it again | | `TAB` / `n` | next field | | `S-TAB` / `p` | previous field | +| `e` | set the field at point | +| `C-c C-e` | open the value for editing | | `q` | close | Two things worth knowing, because they are unlike other inspectors. @@ -443,6 +445,83 @@ 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. +### Changing one — `e`, and `C-c C-e` + +The inspector writes as well as reads, and the loop it is for is the one the +whole dev story is about: "that field is wrong" and "is it *this* value that +fixes it" are two keystrokes apart, where editing the source and reloading +answers a different question — it answers what the **next** run does. + +**`e`** sets the field or element at point. You are prompted with what is there +now, and what you type is a Flan **expression**, evaluated in the program and +checked against the type of the place it is going into. `(+ 1 2)`, a string +literal, a whole struct literal all work; one that does not fit comes back with +the checker's own sentence — *expected f32, found string* — and nothing is +stored. A literal arrives at the place's width, so `3` into an `f32` field is +three point oh and not a refusal you would have had to write `3.0` to avoid. +Point on no field line at all sets the whole value, which is how a data type's +case is changed. + +**`C-c C-e`** turns the buffer into the value. What you get is the Flan literal +the program wrote — the value's own spelling, with no second notation to learn +— and you edit it as text. **`C-c C-c`** commits; **`C-c C-k`** throws it away. + +A commit is a **diff**, not a blast. The buffer is read back as a value, +compared leaf by leaf with what was drawn, and one write is sent per leaf that +changed — so editing one field of a struct does not rewrite the others with +what happened to be on your screen. Every write in a commit goes in **one** +module: either all of them happened at this stop, or none did. + +What it refuses, and each by name with the reason: + +- **A shape that changed.** Adding or removing an element, adding or renaming a + field, putting a number where a struct was, changing which case a data type + holds. Those are changes to the container or to the tag, not stores into + storage. `e` on the value sets it whole, which is the operation that *is* + available. +- **A value the renderer did not write.** ``, ``, and the `...` the + walk writes where it stopped at its depth or span bound. A buffer with one of + those in it is a buffer missing part of the value, and a commit read off it + could not tell a field that was never written from one you deleted — so the + value refuses to be opened for editing at all. +- **A pointer.** An address typed into a prompt is one the editor made up. + Nothing blessed it and the program would dereference it at a moment nobody + chose; the read half does not follow pointers either. +- **An option's payload on its own.** The tag is what says whether there is + one. Set the option. + +### What makes writing safe + +Writing is refused outright on the expression and address roots. Only the +**frame and slot** root can be written to, and the reasons are what the whole +feature rests on. + +The program must be **stopped**, because a poke into storage the program is +mutating is corruption with a plausible shape. But "stopped" is not enough on +its own: a write is built by a compiler, and a third of a second of `llc` is +long enough for a game to resume, run a frame, and stop again. The same slot +index of a different stack is not the place you were looking at. + +So a write names the **stop** it was addressed to, not the state. Every +inspection carries the number of the stop it was read at; a write hands that +number back; and it is checked twice — here, before anything is built, so a +stale buffer refuses in a tenth of the time and names the buffer rather than +the module, and again inside the program, on the game thread, at the moment the +module is claimed. A program that went round its loop between the drawing and +the commit refuses with *look again and re-do the edit*, which is the whole of +the fix. + +The read-only view stays the default. `e` and `C-c C-e` are there when the root +can carry them, and the key legend at the foot of the buffer lists them only +then — a legend offering a key that would refuse is advertising a refusal. + +A **global** is not writable from here yet: the break buffer roots globals at an +expression, and an expression is evaluated wherever the evaluator stands and +whenever it next reaches a frame boundary, which for a write means possibly +into a running program. `C-x C-e` on `(set the-global …)` does that write +knowingly; the inspector will not do it behind a key that looks the same as the +safe one. + ### Where the memory went — `M-x flan-allocations` and `M-x flan-leaks` The same registry, read as a table rather than at one address. **`M-x diff --git a/emacs/flan-inspect.el b/emacs/flan-inspect.el index afcb736..d814a1a 100644 --- a/emacs/flan-inspect.el +++ b/emacs/flan-inspect.el @@ -96,6 +96,7 @@ ;;; Code: +(require 'cl-lib) (require 'seq) (require 'subr-x) @@ -420,6 +421,21 @@ whole.") 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.") +(defvar-local flan-inspect--rendered nil + "What the program wrote, before it was parsed. +Kept because it is the thing edit mode hands you: a Flan literal is what the +renderer writes, so the buffer you type into is the value's own spelling and +not a second notation invented for editing it.") +(defvar-local flan-inspect--at-stop nil + "Which stop this buffer was drawn at, as the daemon numbered it. +Nil where the reply did not say — only the slot root does, because only it +reads from a frame, and only what is read from a frame can be written back. +A write carries this number, and the program refuses it if it has been round +its loop and stopped again since: what is on the screen would then describe +storage that has moved, and overwriting it would be aimed at nothing anybody +looked at.") +(defvar-local flan-inspect--editing nil + "Non-nil while this buffer is the value rather than a listing of it.") (defun flan-inspect--label (child) "How CHILD is named in the list: `0.' for an element, `.x' for a field. @@ -571,8 +587,12 @@ DECLARED is the type the daemon named, when it named one." (flan-inspect-refusal node root)) 'face 'font-lock-comment-face))))) (insert "\n") + ;; The write keys are only listed where they would work. A legend that + ;; offered `e' on an expression root would be advertising a refusal. (insert (propertize - "RET inspect l back g refresh TAB/n next p previous q quit\n" + (if (flan-inspect--writable) + "RET inspect l back g refresh TAB/n next p previous q quit\n" + "RET inspect e set C-c C-e edit l back g refresh TAB/n next p previous q quit\n") 'face 'shadow)) (goto-char (point-min)))) @@ -616,10 +636,17 @@ and whether that may be followed is the answer")) (_ (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"))) - (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)))) + (list :value (or (plist-get r :value) + (user-error + "flan: the program answered without a value for %s" + (flan-inspect--root-label root path))) + :type (plist-get r :type) + ;; The stop the read happened at, where the reply carried one. It + ;; travels with the value rather than being asked for separately, + ;; because asked separately it would be a second question about a + ;; different instant — and the whole use of the number is that it is + ;; true of *what is on the screen*. + :at-stop (plist-get r :at-stop)))) (defun flan-inspect--show (root path &optional stack) "Render ROOT walked by PATH in the inspector buffer, with STACK behind it." @@ -629,9 +656,12 @@ and whether that may be followed is the answer")) (unless (derived-mode-p 'flan-inspect-mode) (flan-inspect-mode)) (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--rendered (plist-get answer :value)) + (setq flan-inspect--node (flan-inspect-parse flan-inspect--rendered)) + (setq flan-inspect--type (plist-get answer :type)) + (setq flan-inspect--at-stop (plist-get answer :at-stop)) (setq flan-inspect--stack stack) + (setq flan-inspect--editing nil) (flan-inspect--render root path flan-inspect--node stack flan-inspect--type)) (display-buffer buf) @@ -769,6 +799,356 @@ someone asked for reads very differently from one a timer produced." flan-inspect--stack) (with-current-buffer flan-inspect-buffer (goto-char (min p (point-max)))))) +;;; Writing one back + +;; SLY sets a value from its inspector, and the reason it is worth having here +;; is the reason the read half exists: the loop between "that field is wrong" +;; and "is it this value that fixes it" is the loop the whole dev story is +;; about, and changing the source and reloading answers a different question — +;; it answers what the *next* run does. +;; +;; Two ways in, and they are the same request underneath. `e' on a line sets +;; one field. `C-c C-e' turns the buffer into the value itself, you edit it +;; like text, and `C-c C-c' sends one write per leaf you changed. Both end in +;; `(:op "set")' with a list of (path, expression) edits, both are refused +;; whole if any one edit is impossible, and both redraw from what the program +;; holds afterwards rather than from what was typed. +;; +;; What makes writing defensible at all is that the program is stopped and +;; stays stopped. The daemon checks that, the agent checks it again on the +;; game thread at the moment the module is claimed, and the *stop* is named +;; rather than the state — so a program that resumed and stopped again between +;; the drawing and the commit refuses, instead of storing into the same slot +;; index of a stack nobody looked at. + +(defun flan-inspect--writable (&optional what) + "Why this buffer cannot be written to, or nil if it can. +WHAT names the operation in the refusal." + (let ((what (or what "a write"))) + (cond + ((null flan-inspect--root) "nothing is being inspected") + ;; The write verb roots at a frame slot and has no other root. That is + ;; not an omission to be worked around here by sending `(set …)' to be + ;; evaluated: an expression is evaluated wherever the evaluator stands and + ;; at whatever moment it gets a frame boundary, which for a *write* means + ;; storing into a program that is very possibly running — the one thing + ;; this must not do. So it is refused, with the root that can. + ((not (eq (car-safe flan-inspect--root) :slot)) + (format "%s roots at a frame's slot, and this buffer is on %s. \ +`i' on a local in the break buffer gives the root that can be written to" + what + (if (eq (car-safe flan-inspect--root) :addr) + "an address" + "an expression"))) + ((not (and (integerp flan-inspect--at-stop) (> flan-inspect--at-stop 0))) + (format "%s has to name the stop it was read at, and this drawing \ +carries none. Press `g' to read it again" what)) + (t nil)))) + +(defun flan-inspect--send (edits) + "Store EDITS, a list of (STEPS . CODE), into what this buffer is showing. +STEPS are relative to the buffer's own path. Redraws from the reply, which is +the program's storage read back and not an echo of what was sent." + (let* ((root flan-inspect--root) + (path flan-inspect--path) + (stack flan-inspect--stack) + (frame (nth 1 root)) + (slot (nth 2 root)) + (r (funcall + flan-inspect-request-function + (append + (list :op "set" :frame frame :slot slot) + (when path + (list :path (mapcar #'flan-inspect-wire-step path))) + (list :at-stop flan-inspect--at-stop + :edits + (mapcar + (lambda (e) + (append (list :code (cdr e)) + (when (car e) + (list :path + (mapcar #'flan-inspect-wire-step + (car e)))))) + edits)))))) + (unless (equal (plist-get r :status) "ok") + (user-error "flan: %s" (or (plist-get r :message) "refused"))) + ;; Redrawn from a fresh read rather than from the reply's value, even + ;; though the reply carries one. The reply is the value at the path that + ;; was written; the buffer may be showing a parent of it, and drawing the + ;; child there would be the wrong value in the right place. `--show' also + ;; picks up the new stop number, which the next commit needs. + (flan-inspect--show root path stack) + (message "flan: wrote %s" (plist-get r :value)) + r)) + +(defun flan-inspect-set () + "Set the field or element at point, or the whole value when point is not on one. +Prompts with what is there now; what you type is a Flan *expression*, checked +in the program against the type of the place it is going into — so `(+ 1 2)', +a string literal and a struct literal all work, and one that does not fit is +refused in the checker's own words." + (interactive) + (let ((why (flan-inspect--writable "setting a value"))) + (when why (user-error "flan: %s" why))) + (let* ((step (get-text-property (point) 'flan-inspect-step)) + (node (or (get-text-property (point) 'flan-inspect-node) + flan-inspect--node)) + ;; The step the wire wants carries the type it is a field *of*, the + ;; same graft `flan-inspect-into' makes and for the same reason: a + ;; data type's payload sits at an offset that depends on the case. + (steps (cond + ((null step) nil) + ((eq (plist-get flan-inspect--node :kind) 'option) (list '(:some))) + (t (list (pcase step + (`(:field ,name) + (list :field name + (plist-get flan-inspect--node :type))) + (_ step)))))) + (where (flan-inspect--root-label + flan-inspect--root + (append flan-inspect--path steps))) + (now (flan-inspect--literal node)) + (code (read-string (format "Set %s to: " where) now))) + (when (string-empty-p (string-trim code)) + (user-error "flan: nothing to store")) + (flan-inspect--send (list (cons steps code))))) + +;;; The buffer as the value + +;; The second half, and the one that is not SLY's. A rendered Flan value is a +;; Flan literal — `(Point {.x 1.5 .y 2.5})' is what the renderer writes and +;; what the source would write — so the editable form of the value is the +;; value's own spelling, with no second notation to learn and nothing to +;; translate. Editing it is editing text; committing it is a diff. +;; +;; A diff and not a blast. A struct with one changed field sends one write for +;; that field, so the untouched fields are not rewritten with what was on the +;; screen — which matters exactly when it is hardest to see that it does: two +;; people, or a program and a person, touching the same value. + +(defun flan-inspect--literal (node &optional indent) + "NODE as Flan source, laid out over lines from INDENT. +Round-trips through `flan-inspect-parse': what this writes is what that reads, +which is what makes the commit a comparison of two parses rather than a +comparison of two strings." + (let* ((indent (or indent 0)) + (pad (make-string (+ indent 2) ?\s)) + (kids (plist-get node :children))) + (pcase (plist-get node :kind) + ('struct + (if (null kids) + (format "(%s {})" (plist-get node :text)) + (concat "(" (plist-get node :text) " {" + (mapconcat + (lambda (c) + (concat "\n" pad "." (format "%s" (car c)) " " + (flan-inspect--literal (cdr c) (+ indent 2)))) + kids "") + "})"))) + ('seq + (if (null kids) "[]" + (concat "[" + (mapconcat + (lambda (c) + (concat "\n" pad (flan-inspect--literal (cdr c) (+ indent 2)))) + kids "") + "]"))) + ('option + (concat "(some " (flan-inspect--literal (cdr (car kids)) indent) ")")) + (_ (plist-get node :text))))) + +(defun flan-inspect--complete (node) + "Why NODE is not a whole value, or nil if it is. +The renderer stops at a depth of 4 and a span of 8, and what it writes when it +stops is `...'. A buffer holding one of those is a buffer where some of the +value is simply not present — and a commit read off it would look exactly like +somebody having deleted the part that was never written." + (cond + ((eq (plist-get node :kind) 'trunc) + "the renderer stopped at its depth bound of 4 here, so part of this value \ +was never written. Inspect the field that holds it, which re-roots the walk") + ((plist-get node :truncated) + "the renderer stopped at its span bound of 8, so some of these are not in \ +the buffer — and a commit read off it could not tell them from ones you had \ +deleted") + (t (seq-some (lambda (c) (flan-inspect--complete (cdr c))) + (plist-get node :children))))) + +(defun flan-inspect--diff (old new) + "One edit per leaf that differs between OLD and NEW. +Returns (EDITS . REFUSAL): EDITS is a list of (STEPS . CODE) and REFUSAL, when +it is non-nil, is why the two cannot be compared at all. A shape that changed +is a refusal and not an edit — adding a field to a struct or an element to an +array is not something a store can do, and quietly writing the leaves that did +line up would be the half-done version of what was asked." + (let ((edits nil) (why nil)) + (cl-labels + ((no (fmt &rest args) (unless why (setq why (apply #'format fmt args)))) + (label (steps) + (if steps + (mapconcat (lambda (s) + (pcase s + (`(:field ,f . ,_) (concat "." f)) + (`(:index ,i) (format "[%d]" i)) + (`(:some) ".some") + (_ ""))) + (reverse steps) "") + "this value")) + (walk (o n steps parent) + (let ((ok (plist-get o :kind)) (nk (plist-get n :kind))) + (cond + ((equal o n) nil) + ;; Asked of the *old* node and before the kinds are compared, + ;; because the question is what the program wrote and not what + ;; was typed over it. `' and `' are what the renderer + ;; writes when it has not written the value, so anything in their + ;; place is an edit of nothing, whatever shape it now has. + ((memq ok '(ptr opaque)) + (no "%s is written as %s, which is what the renderer writes \ +when it did not write the value — so there is nothing there to have changed" + (label steps) (plist-get o :text))) + ((not (eq ok nk)) + (no "%s was %s and is now %s: a store replaces a value, it \ +does not change what kind of thing is there. Use `e' on it to set the whole \ +value" + (label steps) (flan-inspect--kind-name ok) + (flan-inspect--kind-name nk))) + ((memq ok '(struct option)) + (if (and (eq ok 'struct) + (not (equal (plist-get o :text) (plist-get n :text)))) + ;; The head is the struct's name, and for a data type it is + ;; `Type.case' — so a changed head is a changed *case*, which + ;; is a change to the tag and not to any field under it. + (no "%s is a %s and the buffer says %s: which case a data \ +type holds is the tag, not a field, so it is set whole. Use `e' on it" + (label steps) (plist-get o :text) (plist-get n :text)) + (children o n steps))) + ((eq ok 'seq) + (if (/= (length (plist-get o :children)) + (length (plist-get n :children))) + (no "%s had %d element%s and the buffer has %d: adding or \ +removing one is a change to the container, which is a thing the program does \ +and not a thing a store does" + (label steps) (length (plist-get o :children)) + (if (= 1 (length (plist-get o :children))) "" "s") + (length (plist-get n :children))) + (children o n steps))) + ((equal (plist-get o :text) (plist-get n :text)) nil) + (t + (push (cons (reverse steps) (plist-get n :text)) edits)))) + (ignore parent)) + (children (o n steps) + (let ((ok (mapcar #'car (plist-get o :children))) + (nk (mapcar #'car (plist-get n :children)))) + (if (not (equal ok nk)) + (no "%s has %s in the buffer and %s in the program: a store \ +writes what is there, it does not add or rename fields" + (label steps) + (if nk (mapconcat (lambda (k) (format "%s" k)) nk " ") "nothing") + (if ok (mapconcat (lambda (k) (format "%s" k)) ok " ") "nothing")) + (dolist (c (plist-get o :children)) + (let ((step (if (integerp (car c)) + (list :index (car c)) + (if (eq (plist-get o :kind) 'option) + (list :some) + (list :field (car c) (plist-get o :type)))))) + (walk (cdr c) + (cdr (assoc (car c) (plist-get n :children))) + (cons step steps) o))))))) + (walk old new nil nil)) + ;; A refusal voids the edits rather than sitting beside them. The walk + ;; visits fields in order, so a struct with one good change and one + ;; impossible one collects the good one before it reaches the other — and + ;; handing that back with the refusal would make it possible for a caller + ;; to send half of what was asked for. Nothing does; this is what makes + ;; it not merely a convention. + (cons (and (null why) (nreverse edits)) why))) + +(defun flan-inspect--kind-name (kind) + "KIND, said in words, for a refusal that has to name two of them." + (pcase kind + ('struct "a struct") ('seq "a sequence") ('option "an option") + ('ptr "a pointer") ('opaque "a type with no structure") + ('trunc "the renderer's mark for where it stopped") + (_ "a single value"))) + +(defun flan-inspect-edit () + "Turn this buffer into the value, editable. +What you get is the Flan literal the program wrote. Change it as text; +`C-c C-c' sends one write per leaf you changed and redraws from what the +program holds afterwards, `C-c C-k' throws the edit away." + (interactive) + (let ((why (flan-inspect--writable "editing the value"))) + (when why (user-error "flan: %s" why))) + (when flan-inspect--editing (user-error "flan: this buffer is already open for editing")) + (let ((why (flan-inspect--complete flan-inspect--node))) + (when why (user-error "flan: %s" why))) + (let ((inhibit-read-only t)) + (erase-buffer) + (insert (propertize (flan-inspect--root-label flan-inspect--root + flan-inspect--path) + 'face 'font-lock-function-name-face) + "\n") + (when flan-inspect--type + (insert (propertize (format "%s\n" flan-inspect--type) + 'face 'font-lock-type-face))) + (insert (propertize + "--- Editing. C-c C-c commits what you changed, C-c C-k abandons it.\n" + 'face 'font-lock-comment-face)) + (insert "\n") + (insert (flan-inspect--literal flan-inspect--node)) + (insert "\n") + (setq buffer-read-only nil) + (setq-local truncate-lines nil) + (setq flan-inspect--editing t) + ;; The header is not part of the value, so it is not part of what gets + ;; parsed back — and it is fixed rather than merely un-parsed, because a + ;; header edited by accident would otherwise read as the value having + ;; grown a line. + (let ((end (save-excursion (goto-char (point-min)) (forward-line 4) (point)))) + (add-text-properties (point-min) end '(read-only t front-sticky t))) + (goto-char (point-max)) + (forward-line -1))) + +(defun flan-inspect--edited () + "What the editable part of this buffer says, parsed." + (save-excursion + (goto-char (point-min)) + (forward-line 4) + (let ((text (buffer-substring-no-properties (point) (point-max)))) + (when (string-empty-p (string-trim text)) + (user-error "flan: there is nothing left in the buffer to commit")) + (let ((node (flan-inspect-parse text))) + (unless node + (user-error "flan: the buffer does not read as a Flan value")) + node)))) + +(defun flan-inspect-commit () + "Send one write per leaf changed since this buffer was opened for editing." + (interactive) + (unless flan-inspect--editing + (user-error "flan: this buffer is a listing, not the value; `C-c C-e' opens it for editing")) + (let* ((old flan-inspect--node) + (new (flan-inspect--edited)) + (d (flan-inspect--diff old new)) + (edits (car d)) + (why (cdr d))) + (when why (user-error "flan: %s" why)) + (unless edits + ;; Not silently nothing. A commit that found no change is a fact worth + ;; saying — most often it means the edit went into the header, or into a + ;; part of the buffer that is a summary rather than the value. + (user-error "flan: nothing in the buffer differs from what the program holds")) + (flan-inspect--send edits))) + +(defun flan-inspect-abandon () + "Throw the edit away and draw what the program holds." + (interactive) + (unless flan-inspect--editing + (user-error "flan: this buffer is not open for editing")) + (flan-inspect--show flan-inspect--root flan-inspect--path + flan-inspect--stack)) + (defun flan-inspect--fields () "The start of every inspectable line, in order. Both movement commands go through this rather than walking property changes @@ -823,6 +1203,15 @@ the kind of thing nobody reports and everybody notices." (define-key map [backtab] #'flan-inspect-previous) (define-key map "p" #'flan-inspect-previous) (define-key map "q" #'quit-window) + ;; The write half. `e' for the one field under point, because that is the + ;; letter Emacs uses for "edit the thing here" everywhere else a buffer + ;; lists things; the prefixed pair for the mode, because `C-c C-c' is what + ;; commits an editing buffer in this editor — message, log-edit and + ;; org-src all — and `C-c C-k' is what abandons one. + (define-key map "e" #'flan-inspect-set) + (define-key map (kbd "C-c C-e") #'flan-inspect-edit) + (define-key map (kbd "C-c C-c") #'flan-inspect-commit) + (define-key map (kbd "C-c C-k") #'flan-inspect-abandon) map) "Keys in `flan-inspect-mode'.") diff --git a/emacs/test-flan-cider.el b/emacs/test-flan-cider.el index dcc18a1..d87b404 100644 --- a/emacs/test-flan-cider.el +++ b/emacs/test-flan-cider.el @@ -655,6 +655,280 @@ unwind would send the next one to a daemon that is not there." (or (test-flan--caught #'flan-inspect-pop) "")))))) +;;; Writing one back + +(message "\nsetting a value, and the buffer as the value") + +(defun test-flan--writable (value &optional type replies body) + "Open a slot root on VALUE, at a stop, and run BODY in its buffer. +The stop number is what makes the buffer writable at all, so it is in the +fixture rather than in each test: a reply without one is a reply from a read +the daemon could not date, and this helper is for the case where it could." + (test-flan--slot + 1 0 "b" + (or replies + (lambda (form) + (if (equal (plist-get form :op) "set") + (list :status "ok" :type (or type "Blob") :value value :at-stop 7 + :wrote 1) + (list :status "ok" :type (or type "Blob") :value value :at-stop 7)))) + body)) + +;; The two refusals that come before any request: a root that names no frame, +;; and a drawing that names no stop. Both are refusals of *this buffer* +;; rather than of the value in it, and both say which root can. +(let ((flan-inspect-request-function + (lambda (_) (list :status "ok" :value "7" :type "i32"))) + (flan-inspect-buffer " *test-inspect*")) + (save-window-excursion + (flan-inspect "g") + (with-current-buffer " *test-inspect*" + (test-flan--check "an expression root cannot be written to" + (string-match-p + "roots at a frame's slot" + (or (test-flan--caught #'flan-inspect-set) ""))) + (test-flan--check "and neither can an address root, for the same reason" + (progn + (flan-inspect-address 4096 nil) + (string-match-p + "roots at a frame's slot" + (or (test-flan--caught #'flan-inspect-set) ""))))))) + +(test-flan--slot + 1 0 "b" + (lambda (_) (list :status "ok" :type "i32" :value "7")) + (lambda () + (test-flan--check "a slot root the daemon did not date cannot be written to" + (string-match-p + "name the stop" + (or (test-flan--caught #'flan-inspect-set) ""))) + (test-flan--check "and the legend does not offer keys that would refuse" + (not (string-match-p "e set" (buffer-string)))))) + +;; `e' on a field line. What is sent is the buffer's own path with the line's +;; step on the end, the stop the drawing was made at, and the expression typed +;; — not a value the client converted into anything. +(test-flan--writable + "(Blob {.id 7 .name \"sandy\"})" "Blob" nil + (lambda () + (test-flan--check "the legend offers the write keys where they work" + (string-match-p "e set" (buffer-string))) + (goto-char (point-min)) + (flan-inspect-next) ; .id + (cl-letf (((symbol-function 'read-string) (lambda (&rest _) "(+ 1 2)"))) + (flan-inspect-set)) + (let ((sent (car (last test-flan--asked 2)))) + (test-flan--check "e sends a set" + (equal (plist-get sent :op) "set")) + (test-flan--check "rooted at the frame and slot the buffer is on" + (and (equal (plist-get sent :frame) 1) + (equal (plist-get sent :slot) 0))) + (test-flan--check "naming the stop the drawing was made at" + (equal (plist-get sent :at-stop) 7)) + (test-flan--check "with one edit, at the field the line names" + (equal (plist-get sent :edits) + '((:code "(+ 1 2)" :path ("id"))))) + (test-flan--check "and the expression is sent as it was typed" + (equal (plist-get (car (plist-get sent :edits)) :code) + "(+ 1 2)"))) + (test-flan--check "and the buffer is drawn again from a fresh read" + (equal (plist-get (car test-flan--asked) :op) "inspect")))) + +;; The prompt offers what is there, so the common edit is a character. +(test-flan--writable + "(Blob {.id 7 .name \"sandy\"})" "Blob" nil + (lambda () + (goto-char (point-min)) + (flan-inspect-next) (flan-inspect-next) ; .name + (let ((offered nil)) + (cl-letf (((symbol-function 'read-string) + (lambda (_ &optional init &rest _r) (setq offered init) "\"sandy2\""))) + (flan-inspect-set)) + (test-flan--check "the prompt starts from what is there now" + (equal offered "\"sandy\""))))) + +;; Point on nothing in particular sets the whole value, which is how a data +;; type's case is changed and how anything the field list cannot reach is. +(test-flan--writable + "(Blob {.id 7})" "Blob" nil + (lambda () + (goto-char (point-min)) + (cl-letf (((symbol-function 'read-string) (lambda (&rest _) "(Blob {.id 9})"))) + (flan-inspect-set)) + (let ((sent (car (last test-flan--asked 2)))) + (test-flan--check "point off a field line sets the whole value" + (equal (plist-get sent :edits) + '((:code "(Blob {.id 9})"))))))) + +;; A refusal from the daemon reaches the person and changes nothing. The +;; refusals that matter here are the daemon's own — a type that does not fit, +;; a stop that has moved — and this end must not paper over either. +(test-flan--writable + "(Blob {.id 7})" "Blob" + (lambda (form) + (if (equal (plist-get form :op) "set") + (list :status "error" :message "expected i32, found string") + (list :status "ok" :type "Blob" :value "(Blob {.id 7})" :at-stop 7))) + (lambda () + (goto-char (point-min)) + (flan-inspect-next) + (cl-letf (((symbol-function 'read-string) (lambda (&rest _) "\"no\""))) + (test-flan--check "the checker's refusal reaches the person" + (string-match-p + "expected i32, found string" + (or (test-flan--caught #'flan-inspect-set) "")))))) + +(test-flan--writable + "(Blob {.id 7})" "Blob" + (lambda (form) + (if (equal (plist-get form :op) "set") + (list :status "error" + :message "this was written against stop 7 and the program is at \ +stop 9 now: it ran on and stopped again, so what is on the screen is not what \ +would be overwritten. Look again and re-do the edit") + (list :status "ok" :type "Blob" :value "(Blob {.id 7})" :at-stop 7))) + (lambda () + (goto-char (point-min)) + (flan-inspect-next) + (cl-letf (((symbol-function 'read-string) (lambda (&rest _) "9"))) + (test-flan--check "a stale drawing is refused with what to do about it" + (string-match-p + "Look again" + (or (test-flan--caught #'flan-inspect-set) "")))))) + +;;; The buffer as the value + +;; The literal the editable buffer holds is the value's own spelling, and it +;; has to read back as what it was written from — otherwise a commit would +;; diff a parse against a different parse and see changes nobody made. +(let ((round + (lambda (s) + (equal (flan-inspect-parse s) + (flan-inspect-parse + (flan-inspect--literal (flan-inspect-parse s))))))) + (test-flan--check "a struct round-trips through the editable spelling" + (funcall round "(Blob {.id 7 .name \"sandy\" .pos (V {.x 1.5 .y 0})})")) + (test-flan--check "an array does too" + (funcall round "[ 10 20 30]")) + (test-flan--check "and an option, and a nested one" + (funcall round "(some (V {.x 1 .y (some 2)}))"))) + +(let ((old (flan-inspect-parse "(Blob {.id 7 .name \"sandy\" .pos (V {.x 1.5 .y 0})})"))) + ;; One leaf changed is one edit, with the steps that reach it and nothing + ;; else — the whole point of diffing rather than writing the value back. + (let ((d (flan-inspect--diff + old + (flan-inspect-parse + "(Blob {.id 7 .name \"sandy\" .pos (V {.x 2.5 .y 0})})")))) + (test-flan--check "one changed leaf is one edit" + (equal (car d) '((((:field "pos" "Blob") (:field "x" "V")) . "2.5")))) + (test-flan--check "and nothing is refused about it" (null (cdr d)))) + (let ((d (flan-inspect--diff + old + (flan-inspect-parse + "(Blob {.id 8 .name \"tuned\" .pos (V {.x 1.5 .y 0})})")))) + (test-flan--check "two changed leaves are two edits, and only two" + (equal (car d) + '((((:field "id" "Blob")) . "8") + (((:field "name" "Blob")) . "\"tuned\""))))) + (let ((d (flan-inspect--diff old (flan-inspect-parse "(Blob {.id 7 .name \"sandy\" .pos (V {.x 1.5 .y 0})})")))) + (test-flan--check "an untouched value is no edits at all" + (and (null (car d)) (null (cdr d))))) + ;; And the shapes that are not stores. Each is refused whole, so the leaf + ;; that did line up beside it does not go either. + (let ((d (flan-inspect--diff + old + (flan-inspect-parse + "(Blob {.id 8 .name \"sandy\" .pos 3})")))) + (test-flan--check "a leaf where a struct was is refused, not written" + (and (null (car d)) (string-match-p "kind of thing" (cdr d))))) + (let ((d (flan-inspect--diff + old + (flan-inspect-parse "(Blob {.id 7 .name \"sandy\"})")))) + (test-flan--check "a field removed is refused by name" + (and (null (car d)) + (string-match-p "does not add or rename" (cdr d)))))) + +(let ((d (flan-inspect--diff (flan-inspect-parse "[ 1 2 3]") + (flan-inspect-parse "[ 1 2 3 4]")))) + (test-flan--check "an element added is a change to the container, and refused" + (and (null (car d)) + (string-match-p "3 elements and the buffer has 4" (cdr d))))) + +(let ((d (flan-inspect--diff + (flan-inspect-parse "(Shape.circle {.r 1})") + (flan-inspect-parse "(Shape.square {.r 1})")))) + (test-flan--check "a data type's case is the tag, so it is not a field edit" + (and (null (car d)) (string-match-p "set whole" (cdr d))))) + +(let ((d (flan-inspect--diff (flan-inspect-parse "(B {.p })") + (flan-inspect-parse "(B {.p 4096})")))) + (test-flan--check "typing over what the renderer did not write is refused" + (and (null (car d)) (string-match-p "nothing there" (cdr d))))) + +;; The truncation guard. A value the renderer stopped short of is one where +;; some of the fields are simply absent from the buffer, and a commit read off +;; it could not tell them from fields somebody deleted. +(test-flan--writable + "(Blob {.id 7 .deep (V {.a (W {.b ...})})})" "Blob" nil + (lambda () + (test-flan--check "a truncated value refuses to be opened for editing" + (string-match-p + "never written" + (or (test-flan--caught #'flan-inspect-edit) ""))))) + +;; And the whole round trip: open, edit the text, commit, and what goes out is +;; one write for the leaf that changed. +(test-flan--writable + "(Blob {.id 7 .name \"sandy\"})" "Blob" nil + (lambda () + (flan-inspect-edit) + (test-flan--check "editing shows the value as a Flan literal" + (string-match-p "(Blob {" (buffer-string))) + (test-flan--check "and says how to commit it" + (string-match-p "C-c C-c commits" (buffer-string))) + (test-flan--check "a commit with nothing changed says so" + (string-match-p + "nothing in the buffer differs" + (or (test-flan--caught #'flan-inspect-commit) ""))) + (goto-char (point-min)) + (search-forward ".id 7") + (replace-match ".id 42") + (flan-inspect-commit) + (let ((sent (car (last test-flan--asked 2)))) + (test-flan--check "the commit writes the one leaf that changed" + (equal (plist-get sent :edits) + '((:code "42" :path ("id"))))) + (test-flan--check "and names the stop the buffer was drawn at" + (equal (plist-get sent :at-stop) 7))) + (test-flan--check "and the buffer is a listing again afterwards" + (not flan-inspect--editing)))) + +(test-flan--writable + "(Blob {.id 7})" "Blob" nil + (lambda () + (flan-inspect-edit) + (goto-char (point-max)) + (insert "junk (") + (test-flan--check "an edit that has stopped being a value refuses whole" + (let ((why (test-flan--caught #'flan-inspect-commit))) + ;; It reads as *something*, but not as the same shape, + ;; which is the refusal that names what changed. + (and why (not (string-match-p "wrote" why))))) + (flan-inspect-abandon) + (test-flan--check "and abandoning draws what the program holds" + (and (not flan-inspect--editing) + (string-match-p "\\.id +7" (buffer-string)))))) + +(test-flan--writable + "(Blob {.id 7})" "Blob" nil + (lambda () + (test-flan--check "committing a listing says it is not an edit" + (string-match-p + "C-c C-e" + (or (test-flan--caught #'flan-inspect-commit) ""))))) + + ;;; Restarts: which of them can be taken (message "\nrestarts, and §4's shadowing") diff --git a/emacs/test-flan.el b/emacs/test-flan.el index 128a913..7a009a9 100644 --- a/emacs/test-flan.el +++ b/emacs/test-flan.el @@ -15,6 +15,7 @@ (require 'flan-repl) (require 'flan-watch) (require 'flan-lower) +(require 'flan-inspect) (defvar test-flan--failures 0) @@ -831,8 +832,13 @@ already rely on it — so nothing here is a stand-in for the real thing." ;; Break it: `step' is called every time round the program's loop, so a body ;; that errors stops it on its own game thread, in a frame of its own — not ;; inside anything this client asked for. Nothing tells Emacs. + ;; + ;; The local in front of the error is for the inspector's write half further + ;; down: a frame has to have a named slot holding something with a field in + ;; it before anything can be stored into one. It is read back out by the + ;; error, so it is not a binding the checker can call unused. (flan--eval - "(defn step [] i64 (restart-case (do (error (Missing {.id 7})) 0) (use-placeholder [] -1)))" + "(defn step [] i64 (let [blip (Missing {.id 7})] (restart-case (do (error (Missing {.id (.id blip)})) 0) (use-placeholder [] -1))))" "form") (let ((deadline (+ (float-time) 20))) (while (and (not flan--stopped) (< (float-time) deadline)) @@ -884,6 +890,84 @@ already rely on it — so nothing here is a stand-in for the real thing." (flan-clear-result) (delete-region beg (point-max))) + ;; The inspector, and then the inspector writing. This is the one place the + ;; whole chain runs against a real program: a frame the shadow stack knows, + ;; a slot index read off the listing, a render, a store, and a second render + ;; that is not the first one's echo — it is a fresh request, so what it shows + ;; came out of the program's storage after the write. + (let* ((listing (flan--request '(:op "locals" :frame 0))) + (slot (car (delq nil + (mapcar (lambda (l) + (and (equal (nth 0 l) "blip") (nth 3 l))) + (plist-get listing :locals))))) + (read-id (lambda () + (plist-get (flan--request + (list :op "inspect" :frame 0 :slot slot + :path '("id"))) + :value))) + (refusal (lambda (f) + (or (condition-case e (progn (funcall f) nil) + (error (error-message-string e))) + "")))) + (test-flan--check "the stopped frame's listing gives the local a slot index" + (integerp slot)) + (when (integerp slot) + (save-window-excursion + (with-current-buffer (flan-inspect-slot 0 slot "blip") + (test-flan--check "the inspector draws the local from the frame" + (string-match-p "\\.id +7" (buffer-string))) + (test-flan--check "and the drawing says which stop it was made at" + (and (integerp flan-inspect--at-stop) + (> flan-inspect--at-stop 0))) + ;; Level one: one field, from the line that names it. + (goto-char (point-min)) + (flan-inspect-next) + (cl-letf (((symbol-function 'read-string) (lambda (&rest _) "(+ 40 2)"))) + (flan-inspect-set)) + (test-flan--check "a field set from the inspector lands in the frame" + (string-match-p "\\.id +42" (buffer-string))) + (test-flan--check "and reading it again agrees with the program" + (equal (funcall read-id) "42")) + ;; A value that does not fit is refused in the checker's own words, + ;; and nothing moves. + (goto-char (point-min)) + (flan-inspect-next) + (cl-letf (((symbol-function 'read-string) (lambda (&rest _) "\"no\""))) + (test-flan--check "a value of the wrong type is refused by the checker" + (string-match-p "expected i32" + (funcall refusal #'flan-inspect-set)))) + (test-flan--check "and the refused write changed nothing" + (equal (funcall read-id) "42")) + ;; Level two: the buffer *is* the value, edited as text and committed + ;; as a diff. + (flan-inspect-edit) + (test-flan--check "editing shows the value as the literal it is" + (string-match-p "(Missing {" (buffer-string))) + (goto-char (point-min)) + (search-forward ".id 42") + (replace-match ".id 11") + (flan-inspect-commit) + (test-flan--check "committing the buffer stores what was changed in it" + (string-match-p "\\.id +11" (buffer-string))) + (test-flan--check "and the program agrees" + (equal (funcall read-id) "11")) + ;; And a commit against a stop the program has left refuses rather + ;; than storing into a stack nobody looked at. The stop is moved on + ;; here rather than the program, because making a program leave a + ;; break and come back inside a batch run is a race; what is under + ;; test is the refusal, and it is the program making it. + (flan-inspect-edit) + (goto-char (point-min)) + (search-forward ".id 11") + (replace-match ".id 99") + (setq flan-inspect--at-stop (+ 1000 flan-inspect--at-stop)) + (test-flan--check "a commit against a stop the program has left is refused" + (string-match-p + "Look again" (funcall refusal #'flan-inspect-commit))) + (test-flan--check "and that write did not land either" + (equal (funcall read-id) "11"))))) + (when (get-buffer flan-inspect-buffer) (kill-buffer flan-inspect-buffer))) + ;; And installing, which the break loop allows on purpose: there is no frame ;; in progress, so the rule against swapping a body that is on the stack does ;; not apply. This is the fix-it-and-retry loop — the broken `step' is From d43c372efe2557f50febf54daa44d3a388afce85 Mon Sep 17 00:00:00 2001 From: Joseph Ferano Date: Sat, 19 Sep 2026 10:38:02 +0700 Subject: [PATCH 3/4] A listing drawn after a commit is a listing again MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit `flan-inspect-edit' turns off read-only and line truncation, and `--show' is the one funnel every drawing goes through — but the mode body that set them in the first place does not run a second time on a buffer already in the mode. So a listing drawn after a commit or an abandon presented as a listing and was plain editable text: `C-k' on one of its lines did what `C-k' does. Put back beside the flag that says which of the two the buffer is. And that flag is now the marker it should have been. The header above the value is two lines or three depending on whether the daemon named a type, and the count that skipped it was written once in the writer and once in the reader that parses the buffer back — two places to keep in step for nothing. The MANUAL's key table lists the two keys that commit and abandon, which were in the prose and not in the table anybody scans. --- emacs/MANUAL.md | 2 ++ emacs/flan-inspect.el | 26 ++++++++++++++++++++------ emacs/test-flan-cider.el | 7 ++++++- 3 files changed, 28 insertions(+), 7 deletions(-) diff --git a/emacs/MANUAL.md b/emacs/MANUAL.md index 5a45a95..5235178 100644 --- a/emacs/MANUAL.md +++ b/emacs/MANUAL.md @@ -378,6 +378,8 @@ per line. | `S-TAB` / `p` | previous field | | `e` | set the field at point | | `C-c C-e` | open the value for editing | +| `C-c C-c` | commit what you changed in it | +| `C-c C-k` | abandon the edit | | `q` | close | Two things worth knowing, because they are unlike other inspectors. diff --git a/emacs/flan-inspect.el b/emacs/flan-inspect.el index d814a1a..2587989 100644 --- a/emacs/flan-inspect.el +++ b/emacs/flan-inspect.el @@ -435,7 +435,10 @@ its loop and stopped again since: what is on the screen would then describe storage that has moved, and overwriting it would be aimed at nothing anybody looked at.") (defvar-local flan-inspect--editing nil - "Non-nil while this buffer is the value rather than a listing of it.") + "Where the value starts, while this buffer is the value rather than a listing. +A marker and not a flag, because the header above it is two lines or three +depending on whether the daemon named a type, and the reader that parses the +buffer back has to start in the same place this one stopped writing.") (defun flan-inspect--label (child) "How CHILD is named in the list: `0.' for an element, `.x' for a field. @@ -662,6 +665,13 @@ and whether that may be followed is the answer")) (setq flan-inspect--at-stop (plist-get answer :at-stop)) (setq flan-inspect--stack stack) (setq flan-inspect--editing nil) + ;; Put back what editing turned off, here and not in the two commands + ;; that leave it: this is the one funnel every drawing goes through, and + ;; the mode body that set them in the first place does not run a second + ;; time on a buffer that is already in the mode. Without it a listing + ;; drawn after a commit is a listing you can yank into. + (setq buffer-read-only t) + (setq-local truncate-lines t) (flan-inspect--render root path flan-inspect--node stack flan-inspect--type)) (display-buffer buf) @@ -1096,25 +1106,29 @@ program holds afterwards, `C-c C-k' throws the edit away." "--- Editing. C-c C-c commits what you changed, C-c C-k abandons it.\n" 'face 'font-lock-comment-face)) (insert "\n") + ;; Where the value starts, recorded rather than counted back to. The + ;; header above is two lines or three depending on whether the daemon + ;; named a type, and a count written here and again in the reader is two + ;; places to keep in step for no gain. + (setq flan-inspect--editing (point-marker)) + (set-marker-insertion-type flan-inspect--editing nil) (insert (flan-inspect--literal flan-inspect--node)) (insert "\n") (setq buffer-read-only nil) (setq-local truncate-lines nil) - (setq flan-inspect--editing t) ;; The header is not part of the value, so it is not part of what gets ;; parsed back — and it is fixed rather than merely un-parsed, because a ;; header edited by accident would otherwise read as the value having ;; grown a line. - (let ((end (save-excursion (goto-char (point-min)) (forward-line 4) (point)))) - (add-text-properties (point-min) end '(read-only t front-sticky t))) + (add-text-properties (point-min) (marker-position flan-inspect--editing) + '(read-only t front-sticky t)) (goto-char (point-max)) (forward-line -1))) (defun flan-inspect--edited () "What the editable part of this buffer says, parsed." (save-excursion - (goto-char (point-min)) - (forward-line 4) + (goto-char (marker-position flan-inspect--editing)) (let ((text (buffer-substring-no-properties (point) (point-max)))) (when (string-empty-p (string-trim text)) (user-error "flan: there is nothing left in the buffer to commit")) diff --git a/emacs/test-flan-cider.el b/emacs/test-flan-cider.el index d87b404..0e613c7 100644 --- a/emacs/test-flan-cider.el +++ b/emacs/test-flan-cider.el @@ -918,7 +918,12 @@ would be overwritten. Look again and re-do the edit") (flan-inspect-abandon) (test-flan--check "and abandoning draws what the program holds" (and (not flan-inspect--editing) - (string-match-p "\\.id +7" (buffer-string)))))) + (string-match-p "\\.id +7" (buffer-string)))) + ;; The listing is read-only again, and that is the assertion rather than + ;; the flag: the flag says which mode the buffer is in, this says whether + ;; `C-k' on a line of the listing would do something. + (test-flan--check "and the listing is read-only again afterwards" + buffer-read-only))) (test-flan--writable "(Blob {.id 7})" "Blob" nil From 6d87c02584086cfcb8ef16b6a3d12af4248c7dd8 Mon Sep 17 00:00:00 2001 From: Joseph Ferano Date: Sat, 19 Sep 2026 14:24:10 +0700 Subject: [PATCH 4/4] Both backends are asked whether they store where the render said they do MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit The x86 block asks the break loop's questions of an --x86 host so that the two sets of answers can be read against each other rather than merely found plausible. A store is where they could most easily differ: the place forms the walk ends at are lowered by each backend's own `place', and the two disagree about an Option — which is why what may be written is settled in session.ml above both of them and not in either. So the same slot is written, read back, and refused for a type that does not fit, on this backend too. And `Check.expressions' carries the comment that was written for the function it replaced; the one-expression entry beside it has its own line. --- lib/check.ml | 45 +++++++++++++++++++++++---------------------- test/test_dev.ml | 27 +++++++++++++++++++++++++++ 2 files changed, 50 insertions(+), 22 deletions(-) diff --git a/lib/check.ml b/lib/check.ml index 67008a4..7e2612a 100644 --- a/lib/check.ml +++ b/lib/check.ml @@ -7068,30 +7068,30 @@ let instances_since env mark = List.rev (List.filteri (fun i _ -> i < fresh) env.instances) -(* One expression, checked against a program that is already running. The - frame is empty — a REPL expression has no parameters and no enclosing - function — so the slots it needs are whatever its own [let]s allocate. +(* Expressions checked against a program that is already running, all of them + into *one* frame. It is empty to start with — a REPL expression has no + parameters and no enclosing function — so the slots it ends up with are + whatever their own [let]s allocate. - [want] is the inspector's write verb and nothing else: [C-x C-e] has no - expectation to offer, but a store into a slot of type [f32] does, and the - whole value of passing it is that [3] arrives as an [f32] rather than as an - [i32] the store would then have to be refused for. The expectation flows - through [check] the way it flows anywhere — that is what bidirectional - means — and [expect] at the end is what catches the cases that ignore it, - so the refusal is the checker's own "expected f32, found string" and not a - second sentence written here that would drift from it. *) -(* Several of them against one frame, which is what the inspector's write verb - needs and what it must not build by hand. Two expressions checked - separately each number their slots from zero, so splicing them into one - thunk would have the second one's [let] reading and writing the first - one's storage — a frame that is two frames wearing one frame's clothes. - Sharing the [ctx] is the whole of the fix, and it is a fix because there is - exactly one allocator of slot indices in this compiler and it is this - record's counter. + One frame and not one each, which is what the inspector's write verb needs + and what it must not assemble by hand. Two expressions checked separately + both number their slots from zero, so splicing them into one thunk would + have the second one's [let] reading and writing the first one's storage — a + frame that is two frames wearing one frame's clothes. Sharing the [ctx] is + the whole of the fix, and it is a fix because there is exactly one allocator + of slot indices in this compiler and it is this record's counter. - The expressions are otherwise independent: nothing binds a name for the - next one, because the list is a list of values being stored and not a - sequence. *) + They are otherwise independent: none of them binds a name for the next, + because the list is a list of values being stored and not a sequence. + + [want] is the write verb too, and [C-x C-e] passes none: a store into a + slot of type [f32] has an expectation to offer and a typed expression does + not. The whole value of passing it is that [3] arrives as an [f32] rather + than as an [i32] the store would then have to be refused for. It flows + through [check] the way an expectation flows anywhere — that is what + bidirectional means — and [expect] at the end catches the arms that ignore + it, so the refusal is the checker's own "expected f32, found string" rather + than a second sentence written here that would drift from it. *) let expressions env (es : (Types.t option * Ast.expr) list) : Tast.expr list * Types.t array * string option array = let ctx = @@ -7113,6 +7113,7 @@ let expressions env (es : (Types.t option * Ast.expr) list) : (ts, Array.of_list (List.rev ctx.slot_tys), Array.of_list (List.rev ctx.slot_names)) +(* The one-expression case, which is every caller but the write verb. *) let expression env ?want (e : Ast.expr) : Tast.expr * Types.t array * string option array = match expressions env [ (want, e) ] with diff --git a/test/test_dev.ml b/test/test_dev.ml index 905a51a..79cc888 100644 --- a/test/test_dev.ml +++ b/test/test_dev.ml @@ -4487,6 +4487,33 @@ let () = else if Wire.string_field r "value" <> Some "(Point {.x 1.5 .y 2.5})" then fail "x86 inspect of slot 2 answered %S" (Option.value ~default:"" (Wire.string_field r "value")); + (* And the write half of the same root, for the reason this whole block + exists: the two backends must answer the same. A store is where they + could most easily not — the place forms the walk ends at are lowered + by each backend's own [place], and the two disagree about an Option, + which is why what may be written is settled in [session.ml] above + both of them rather than in either. *) + let r = + request c + "(:op \"set\" :frame 0 :slot 2 :path (\"y\") :edits ((:code \"6.5\")))" + in + if status r <> "ok" then fail "x86 set: %s" (said r) + else if Wire.string_field r "value" <> Some "6.5" then + fail "x86 set of p.y answered %S" + (Option.value ~default:"" (Wire.string_field r "value")); + let r = request c "(:op \"inspect\" :frame 0 :slot 2)" in + if Wire.string_field r "value" <> Some "(Point {.x 1.5 .y 6.5})" then + fail "x86: the store did not land where the render says it did: %S" + (Option.value ~default:"" (Wire.string_field r "value")); + (* A refusal that comes from above both backends reads the same here + as it does there, which is the claim rather than the refusal. *) + let r = + request c + "(:op \"set\" :frame 0 :slot 2 :path (\"y\") :edits ((:code \"\\\"no\\\"\")))" + in + if status r <> "error" || not (contains_sub (said r) "expected f32") then + fail "x86: a value of the wrong type was not refused by the checker: %s" + (said r); (* And the globals, which are not in the frame at all -- they are found through the same descriptor's fingerprint, and a frame whose [refsig] disagreed with what the daemon recomputes would refuse