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

Merge: a failed module leaves the session as it found it

Browse Source
This commit is contained in:
Joseph Ferano 2026-09-18 07:45:02 +07:00
commit d8fc41a142
4 changed files with 344 additions and 16 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

108
lib/dev.ml
View File

@ -527,6 +527,39 @@ let parked_msg why =
let parked why = error (parked_msg why)
let contains hay needle =
let n = String.length needle and h = String.length hay in
let rec go i = i + n <= h && (String.sub hay i n = needle || go (i + 1)) in
n = 0 || go 0
(* A module the agent would not take, said in the daemon's words rather than
only in the agent's.
The agent refuses a full reload ring with "the program is not calling
agent/poll", which is the right cause for a program that is running and the
wrong one for a program that has finished. A parked process is not failing
to poll: it has no game thread left to poll with, it is waiting in the park
for somebody to run it again, and nothing drains the ring until then — so
the sixty-fifth module queued since it parked is refused for the very
behaviour [eval] below promises it — that a body redefined while parked
installs when the program is run again. A reader told to check their
[agent/poll] calls would go looking at a loop that is not running.
The agent cannot say this itself. Parking is the merged shim's state and the
agent is vendored beside it knowing nothing about runs; what knows is this
daemon, which has just asked [liveness] and is about to quote a reply. So
the substitution is made here, on a substring of a reply this side did not
write — the same move [abi_mismatch] makes on [dlerror]'s text, and made for
the same reason: the component that has the words does not have the
context. *)
let refusal ~parked reply =
if parked && contains reply "reload queue full" then
"the program refused the module: its reload ring is full, and a parked \
program drains none of it — every module queued since it finished is \
still waiting for a frame boundary, and M-x flan-rerun is what gives them \
one; this one was not taken, so send it again after that run"
else "the program refused the module: " ^ reply
(* [pause], when given, is the position of the form to stop at — §9. It rides
beside the code rather than in it, and the reply echoes it back so an editor
marks the buffer only for a mark the session actually applied.
@ -545,6 +578,18 @@ let parked why = error (parked_msg why)
let eval t ~code ~origin ~pause =
let now = liveness t in
let parked_now = now = Parked in
(* What the session was before the form was checked, and every failure below
puts it back. [Session.eval] commits as soon as the check succeeds, which
is two fallible steps too early: the build can fail and the agent can
refuse, and a session left holding a declaration no module was accepted
for hands the *next* module a name to intern a cell for and nothing to put
in it — a null cell the first call through jumps to. See [Session.held].
Only the failures restore. The [installs = false] arm is a real
acceptance: there is nothing to build and nothing to deliver, so there is
nothing that can go wrong after it. *)
let before = Session.held t.session in
let refused msg = Session.restore t.session before; error msg in
if now = Gone then error gone
else
match Session.eval ~origin ?pause t.session code with
@ -557,6 +602,23 @@ let eval t ~code ~origin ~pause =
[ ":names " ^ Wire.strings c.Session.names; ":fns ()";
":note " ^ Wire.quote "nothing to install" ]
| c ->
(* Everything from here to the delivery is inside the restore, and by
exception type as well as by arm. The three named below are the ones
with a sentence to say; what is left is every other way a file system
can refuse — [write_file] cannot create its copy of the module's text,
the working directory went away underneath the daemon — which used to
leave through [serve]'s guard with the session already holding the
declaration. That is the same stranding under a different exception,
and [serve] still writes the reply: this only puts the session back on
the way past.
[accepted] is what the catch-all needs to know and the arms cannot
tell it. Once the agent has said "ok" the module is the program's,
whatever goes wrong while this reply is being written, and rolling
the session back then would strand the declaration the other way
round — the process holding a body the session has forgotten. *)
let accepted = ref false in
(try
t.n <- t.n + 1;
let out = Filename.concat t.dir (Printf.sprintf "m%d.so" t.n) in
(* [Build.shared] deletes its own .ll unless asked to keep it, and what it
@ -573,6 +635,7 @@ let eval t ~code ~origin ~pause =
| timing ->
(match deliver t out with
| "ok" ->
accepted := true;
t.gen <- t.gen + 1;
List.iter
(fun n ->
@ -595,13 +658,21 @@ let eval t ~code ~origin ~pause =
when it is run again rather than at its next frame \
boundary" ]
else []))
| reply -> error ("the program refused the module: " ^ reply)
| reply -> refused (refusal ~parked:parked_now reply)
| exception Unix.Unix_error (e, _, _) ->
error
refused
("cannot reach the program on " ^ t.agent ^ ": "
^ Unix.error_message e))
| exception Failure m -> error m)
| exception Loc.Error { Loc.dloc = l; dmsg = msg; _ } -> error ~loc:(Loc.to_string l) msg
| exception Failure m -> refused m)
with e when not !accepted -> Session.restore t.session before; raise e)
(* Nothing to put back: the check itself raised, so [Session.eval] never
reached its assignments. The restore is written anyway rather than
reasoned about at each arm — a refusal that costs one record copy is
cheaper than a reader working out which of the four fields this one
could have moved. *)
| exception Loc.Error { Loc.dloc = l; dmsg = msg; _ } ->
Session.restore t.session before;
error ~loc:(Loc.to_string l) msg
(* Redefining a name installs a body; evaluating an expression has no name to
install into, so the module carries a thunk the agent runs once. The value
@ -620,6 +691,15 @@ let eval_expr t ~code ~origin ~pause =
"an expression is evaluated at a frame boundary, and a parked program \
reaches none"
| Live ->
(* The same rollback [eval] takes, for the same reason and a smaller
cargo. A thunk is not a declaration and never joins the session, but the
generic instances the expression forced *are* kept — [Session.eval_expr]
says why — and they are kept before this module has been built or taken.
An instance the session holds and no module ever defined is a null cell
exactly as a stranded [defn] is, and the next expression that mentions
the same instantiation would list it as already there. *)
let held = Session.held t.session in
let refused msg = Session.restore t.session held; error msg in
match Session.eval_expr ~origin ~pause t.session code with
| c ->
let before = match result t with Some (g, _) -> g | None -> 0L in
@ -682,10 +762,19 @@ let eval_expr t ~code ~origin ~pause =
error
"the program did not reach a frame boundary; is it calling \
(agent/poll)?")
| reply -> error ("the program refused the module: " ^ reply)
(* A module that was taken is the program's from here on, whatever
the wait then says: a timeout is a frame boundary not reached
yet, not a module refused, so the instances in it stay in the
session. Only the two arms below, where nothing was accepted,
put the session back.
No [refusal] either, and that is not an omission: this verb
refuses a parked program before it compiles anything, so the one
reply whose cause that rewrites cannot arrive here. *)
| reply -> refused ("the program refused the module: " ^ reply)
| exception Unix.Unix_error (e, _, _) ->
error ("cannot reach the program: " ^ Unix.error_message e))
| exception Failure m -> error m)
refused ("cannot reach the program: " ^ Unix.error_message e))
| exception Failure m -> refused m)
| exception Loc.Error { Loc.dloc = l; dmsg = msg; _ } -> error ~loc:(Loc.to_string l) msg
(* What a macro call expands to — [C-c C-m], and the one verb here that never
@ -2031,11 +2120,6 @@ let run_capture cmd =
let code = match Unix.close_process_in ic with Unix.WEXITED c -> c | _ -> -1 in
(code, Buffer.contents b)
let contains hay needle =
let n = String.length needle and h = String.length hay in
let rec go i = i + n <= h && (String.sub hay i n = needle || go (i + 1)) in
n = 0 || go 0
(* The IR of one function out of a module's text. [Emit] writes a define's
closing brace at column 0 and nowhere else, so the end is unambiguous
without parsing LLVM. One .ll can carry several bodies — [C-c C-k] sends a

81
lib/session.ml
View File

@ -408,6 +408,67 @@ let redefinition (t : t) ?retains ?call ?(consts = []) program ~fns =
in
fail loc "the x86 dev backend cannot compile this: %s" m
(* ── Undoing an acceptance ─────────────────────────────────────────── *)
(* Checking is not the last thing that can fail, and until this existed the
session behaved as though it were. [eval] assigns the four mutable fields
the moment a form checks; the *build* and the *delivery* happen afterwards,
in the daemon, and either can refuse — llc can fail, and the agent's reload
ring can be full, which a parked program guarantees after enough queued
installs, since nothing drains the ring while the main thread waits. The
editor saw an error either way, so the evaluation looked refused; the
session went on holding the declaration anyway.
That leftover is not untidiness, it is a segfault. A declaration the session
holds and the host does not export is a name every later module lists in its
install prologue, and the prologue interns a cell for it. A cell nothing
ever stored a body into is NULL, and a dev build's call through a cell is a
load and an indirect call with no test in front of it — so the next
[C-x C-e], the next locals render, the next globals refresh jumps the game
thread to address 0. One failed build, and the next thing anybody types
kills the program.
So the four fields are one unit that can be put back. [held] is what the
session was before the evaluation and [restore] is the session being that
again — all four together, because they are four views of one answer: the
declarations, the checked program, the checker's environment, and the macros
a later form expands against. Putting back three of them would leave the
checker willing to accept a call to a name the program does not have, which
is the same crash by a longer road.
What a restored session can claim is the honest sentence rather than the one
anyone would rather have: it holds no declaration that no module was
*accepted* for. Accepted is not installed — the agent queues a module and
the game thread installs it at a frame boundary — but a queued module is one
the process has and will run, and that is as far as this side can see.
A [defmacro] evaluated in the same breath as a [defn] that fails to build
goes back with it, and that is right: they arrived as one form and were
accepted as one. A [defmacro] on its own never reaches a restore, because a
change with no body to install and no storage to allocate is answered before
anything is built.
[thunks] is not in here. It is a counter that keeps two evaluations from
naming their thunks alike, not something the session believes about the
program, and the agent refuses a full ring *before* it dlopens — so a
rolled-back number would be reused for a module nothing ever mapped, and
reusing it is the one way to make two live modules share a symbol. *)
type held = {
hdecls : Ast.decl list;
hprogram : Tast.program;
henv : Check.env;
hmacros : Form.t list;
}
let held t =
{ hdecls = t.decls; hprogram = t.program; henv = t.env; hmacros = t.macros }
let restore t h =
t.decls <- h.hdecls;
t.program <- h.hprogram;
t.env <- h.henv;
t.macros <- h.hmacros
let eval ?(origin = "<eval>") ?pause t src : change =
let forms = Reader.read_all ~file:origin src in
Parse.with_imported t.macros @@ fun () ->
@ -593,9 +654,15 @@ let eval ?(origin = "<eval>") ?pause t src : change =
(fun (g : Tast.global) -> not (known t g.Tast.gname))
program.Tast.globals
in
(* Every one of these together, and after the last thing that can raise:
until this line the session is still the one the evaluation started
against, which is what makes a refusal cost nothing. *)
(* Every one of these together, and after the last thing *here* that can
raise: until this line the session is still the one the evaluation started
against, which is what makes a refusal cost nothing.
It is not the last thing that can fail, though, and this line used to be
written as if it were. The build and the delivery come after it, in the
daemon, and both can refuse — so the caller takes a [held] first and puts
it back when they do. See [restore] above for what a session that kept the
declaration anyway does to the program. *)
t.macros <- !macros;
t.decls <- decls;
t.program <- program;
@ -1297,7 +1364,13 @@ let eval_expr ?(origin = "<eval>") ?(pause = false) t src : change =
After [Emit], not before it: the session must not come to believe it holds
a body that no module was ever written for. A daemon that answers and has
lost track of what the program contains is worse than one that died. *)
lost track of what the program contains is worse than one that died.
Written for is as far as this line can get, and it is not far enough on
its own: the module still has to build and still has to be taken. The
caller closes that half by taking a [held] before this and restoring it
when either fails — a copy the session holds and no module defines is a
null cell exactly as a stranded declaration is. *)
t.program <- { t.program with Tast.fns = t.program.Tast.fns @ fresh };
{ ir; x86 = t.x86; names = []; fns = []; installs = true }

122
test/test_dev.ml
View File

@ -152,6 +152,42 @@ let contains_sub hay needle =
in
go 0
(* ── Whose fault a full reload ring is ──────────────────────────────── *)
(* The agent refuses a module it has no room to queue with "the program is not
calling agent/poll", and for a running program that is the cause. For a
parked one it is the wrong cause said confidently: there is no game thread
left to poll with, the ring is full precisely *because* the program
finished, and [Dev.eval]'s own note promises exactly that a body redefined
while parked installs when the program is run again. Somebody sent
the sixty-fifth one, and the reply sent them to read a loop that is not
running.
Pinned on the decision rather than end to end. Filling the ring means
sixty-four modules through a real clang, which is minutes of [dune test] to
assert one sentence; what the daemon *does* with the agent's words is the
whole of the change, and it is a function of two arguments. The pass-through
is asserted too: a running program's refusal must still arrive in the
agent's own words, because for it they are true. *)
let () =
let full = "err reload queue full; the program is not calling agent/poll" in
let parked = Dev.refusal ~parked:true full in
if contains_sub parked "not calling agent/poll" then
fail "a parked program's queue-full refusal still blames its poll: %S"
parked;
if not (contains_sub parked "flan-rerun") then
fail "a parked program's queue-full refusal names no way out: %S" parked;
let live = Dev.refusal ~parked:false full in
if not (contains_sub live "not calling agent/poll") then
fail "a running program's queue-full refusal lost the agent's reason: %S"
live;
(* Only that one reply is rewritten. Every other refusal a parked program
can give — a bad ABI, a module with no installer — is the agent's to
explain and is quoted as it stands. *)
let other = Dev.refusal ~parked:true "err flan.abi.x86: the module is x86" in
if not (contains_sub other "flan.abi.x86") then
fail "a parked program's other refusals were rewritten too: %S" other
let () =
match Sys.command "command -v clang > /dev/null 2>&1 && command -v llc > /dev/null 2>&1" with
| 0 ->
@ -3179,6 +3215,92 @@ let () =
| None -> fail "(probe-one) produced no value")
| Some r -> fail "(probe-one): %s %s" (status r) (message r)
| None -> ());
(* ── A form that checks and then fails to land ─────────────────── *)
(* The two above fail inside the check — a macro module that will not
build is refused before [Session.eval] has committed anything, which
is the easy half. This is the other half, and it is the one that used
to end in a segfault: a form that checks, joins the session, and then
cannot be built or cannot be delivered. The editor reads an error and
the session goes on holding the declaration; the next module built for
that session lists the name in its install prologue, interns a cell
for it, stores nothing in it, and the first call through that cell
jumps the game thread to address 0.
Reached by taking the daemon's own working directory away from it,
which is where a redefinition module is written — a different lever
from the cache above, and deliberately so: the cache is the macro
module's and cannot fail a build that has no macro in it. The
directory is named after the daemon's pid, which is the one this test
started.
The last step is the crash. Pre-fix, [(probe-two)] compiled to a call
through a null cell and this file died with the program; the assertion
it now makes is that the daemon refuses by name instead. *)
let devdir =
Filename.concat (Filename.get_temp_dir_name ())
(Printf.sprintf "flan-dev-%d" rpid)
in
let probe_two = "(defn probe-two [] i64 7)" in
let before = knows () in
(try Unix.chmod devdir 0o500 with Unix.Unix_error _ -> ());
(match
ask_or "a redefinition the daemon cannot write its module for"
(Printf.sprintf "(:op \"eval\" :code %s :file %s)"
(Wire.quote probe_two) (Wire.quote origin))
with
| Some r ->
if status r <> "error" then
fail "a redefinition whose module could not be written answered %s"
(status r)
| None -> ());
(try Unix.chmod devdir 0o700 with Unix.Unix_error _ -> ());
(match knows () with
| k when k <> before ->
fail "a redefinition that never landed changed what the session \
knows:\n was: %s\n now: %s" before k
| k ->
if contains_sub k "probe-two" then
fail "a redefinition that never landed left probe-two in the \
session");
(match
ask_or "an expression calling a redefinition that never landed"
(Printf.sprintf "(:op \"eval-expr\" :code \"(probe-two)\" :file %s)"
(Wire.quote origin))
with
| Some r ->
if status r <> "error" then
fail "an expression calling a body no module carries answered %s"
(status r);
if not (contains_sub (message r) "probe-two") then
fail "the refusal did not name the body that never landed: %S"
(message r)
| None -> ());
(* Usable afterwards, for the thing that just failed: the same form
again, and then the call that could not be made. *)
(match
ask_or "the redefinition after one that could not be written"
(Printf.sprintf "(:op \"eval\" :code %s :file %s)"
(Wire.quote probe_two) (Wire.quote origin))
with
| Some r when status r = "ok" -> ()
| Some r ->
fail "the redefinition after one that could not be written: %s %s"
(status r) (message r)
| None -> ());
(match
ask_or "a call to the body the recovered evaluation installed"
(Printf.sprintf "(:op \"eval-expr\" :code \"(probe-two)\" :file %s)"
(Wire.quote origin))
with
| Some r when status r = "ok" ->
(match Wire.string_field r "value" with
| Some "7" -> ()
| Some v -> fail "(probe-two) evaluated to %s, not 7" v
| None -> fail "(probe-two) produced no value")
| Some r -> fail "(probe-two): %s %s" (status r) (message r)
| None -> ());
(* ── An editor that leaves before its reply does ──────────────── *)
(* The failure this closes was a flake in test_emacs, and it read like
nothing it was: two break-loop checks failing, and then

49
test/test_session.ml
View File

@ -189,6 +189,55 @@ let () =
| exception Loc.Error { Loc.dmsg = m; _ } ->
fail "the session was poisoned by a bad expression: %s" m);
(* The other half of "a refusal costs nothing", and the half that used to be
missing: a form can check and *then* fail, in the build or at the agent,
and the session that already accepted it has no way to hear about it
unless the caller puts it back. [Session.held] and [Session.restore] are
that way, and this is the crash they close.
Rehearsed rather than simulated: neither llc nor a full reload ring can be
summoned from here, and what matters is not which of them failed but what
the session does afterwards. So the declaration is accepted, shown to be
callable — the module for an expression that calls it names it, which is
the name a later install prologue would intern a cell for and never store
a body into — and then the session is put back and asked again.
Both sides are asserted. Without the first, a test that only checked the
refusal would pass on a session that had never accepted the [defn] at
all. *)
(let rt, _ = Session.create ~file:"programs/reload.flan" () in
let h = Session.held rt in
(match Session.eval rt "(defn stranded [] i64 7)" with
| c ->
if c.Session.fns <> [ "stranded" ] then
fail "a new declaration did not offer its body to install"
| exception Loc.Error { Loc.dmsg = m; _ } ->
fail "a new declaration was refused: %s" m);
(match Session.eval_expr rt "(println (stranded))" with
| e ->
if not (has e.Session.ir "stranded") then
fail "an expression calling a fresh declaration did not name it"
| exception Loc.Error { Loc.dmsg = m; _ } ->
fail "a fresh declaration was not callable: %s" m);
Session.restore rt h;
(* The module that would have jumped to address 0. After the restore the
name is simply not one this session has, which is the whole of the
fix: a refusal in the editor instead of a segfault in the program. *)
(match Session.eval_expr rt "(println (stranded))" with
| _ ->
fail "a restored session still let an undelivered declaration be called"
| exception Loc.Error { Loc.dmsg = m; _ } ->
if not (has m "stranded") then
fail "the refusal after a restore was about something else: %S" m);
(* And it is a restore, not a poisoning: the same form offered again is
accepted again, which is what an editor does after reading the error. *)
match Session.eval rt "(defn stranded [] i64 7)" with
| c ->
if c.Session.fns <> [ "stranded" ] then
fail "a re-sent declaration did not offer its body to install"
| exception Loc.Error { Loc.dmsg = m; _ } ->
fail "the session was poisoned by a restore: %s" m);
(* A declaration the program already has, with no body and no new storage,
is accepted and has nothing to send. Building a module for it would report
success for a change that cannot have taken effect, and would cost the