JosephFerano/flan
1
0
Fork 0
Code Issues Pull Requests Packages Projects Releases Wiki Activity

The inspector can store, and a write names the stop it was addressed to

Browse Source 
`(: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.
This commit is contained in:
Joseph Ferano 2026-09-19 10:16:03 +07:00
parent f885e1abfa
commit 37f8f77380
5 changed files with 889 additions and 22 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

48
lib/check.ml
View File

@ -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 = "<none>" }
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,

243
lib/dev.ml
View File

@ -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

282
lib/session.ml
View File

@ -1186,6 +1186,288 @@ let render_slot ?(origin = "<inspect>") 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 = "<set>") 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

235
test/test_dev.ml
View File

@ -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.

103
vendor/agent/flan_agent.c vendored
View File

@ -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;
}