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

Merge branch 'worktree-agent-a1c682523850eafa6' into dev-loop

Browse Source
This commit is contained in:
Joseph Ferano 2026-09-13 19:44:13 +07:00
commit af3daaabe2
5 changed files with 435 additions and 12 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

100
lib/dev.ml
View File

@ -2235,6 +2235,67 @@ let handle t req =
| Some op -> error ("unknown op: " ^ op)
| None -> error "no :op"
(* ── The request boundary ──────────────────────────────────────────── *)
(* Every op above answers with a reply; this is what makes that true for the
ones that raise instead of returning.
The ops used to catch [Loc.Error] each at its own call site, which was
enough while the frontend was the only thing that could refuse a form. It is
not any more: expansion is part of evaluating, so both [eval] and
[eval-expr] now run a clang driver — [Build.macro_module] fails with
[Failure], a macro module that will not dlopen fails with [Failure] out of
[Dynload], and a file that moved fails with [Sys_error]. None of those is a
[Loc.Error], so none of them was answered, and an exception that escapes
[serve] is not a refused evaluation: it is a dead daemon. The program is
still on screen, the session is gone, and the editor's next request finds a
closed socket.
So the boundary is here, once, around the whole of a request — rather than
a new arm at each of the dozens of calls, which is the arrangement that let
this happen in the first place. NEXT.md's rule is that a form that does not
check leaves the session exactly as it was, and that is only true if every
way a build or a check can fail comes back as a reply.
What is deliberately *not* caught: [Out_of_memory], [Stack_overflow] and
[Sys.Break]. Those three say the process cannot continue, or that someone at
the terminal asked it to stop — they are not statements about the form that
was sent, and answering "error" to them would be claiming the session
survived something it did not. Everything else is about the form: a clang
exit status, a dlopen with no such symbol, a missing file. *)
let fatal = function
| Out_of_memory | Stack_overflow | Sys.Break -> true
| _ -> false
(* The message an editor shows. A [Failure] out of the clang driver carries
the compiler's own words and a [Sys_error] carries the path, so they are
passed through as they are: "internal error" for either would throw away
the only part of the reply anybody can act on. The catch-all keeps the
exception's name, which at least says which of these arms to add next. *)
let message_of_exn = function
| Loc.Error { Loc.dmsg = m; _ } -> m
(* Only a whole-file driver raises the list and the daemon evaluates one
form — but [lib/parse.ml] says in as many words that a list arriving here
was a dead session, so it is answered rather than left to the catch-all
to print as a constructor name. *)
| Loc.Errors ds ->
String.concat "; " (List.map (fun (d : Loc.diag) -> d.Loc.dmsg) ds)
| Failure m | Sys_error m -> m
| Unix.Unix_error (e, fn, arg) ->
Printf.sprintf "%s: %s%s" fn (Unix.error_message e)
(if arg = "" then "" else " (" ^ arg ^ ")")
| e -> "internal error: " ^ Printexc.to_string e
(* Shaped exactly as the [Loc.Error] arms it replaces: [:loc] where there is
one to give, and nothing where there is not — an editor that highlights a
span must not be handed a made-up one. *)
let reply_of_exn e =
match e with
| Loc.Error { Loc.dloc = l; _ }
| Loc.Errors ({ Loc.dloc = l; _ } :: _) ->
error ~loc:(Loc.to_string l) (message_of_exn e)
| _ -> error (message_of_exn e)
(* ── The loop ──────────────────────────────────────────────────────── *)
(* One connection at a time. An editor is one client, evaluations are
@ -2248,12 +2309,43 @@ let serve t fd =
let rec go () =
match Wire.recv fd with
| src ->
let op, reply =
(* Parsed once, and the verb taken out of it before anything that can
fail: [close] has to be honoured even when the handler for it did not
return normally, and a tuple whose two halves are [Wire.string_field]
and [handle] leaves that to an evaluation order OCaml does not
promise. *)
let parsed =
match Wire.parse src with
| req -> (Wire.string_field req "op", handle t req)
| exception Loc.Error { Loc.dmsg = m; _ } -> (None, error ("bad request: " ^ m))
| req -> Either.Left req
| exception e when not (fatal e) ->
Either.Right (error ("bad request: " ^ message_of_exn e))
in
Wire.send fd (with_output t (with_break t reply));
let op =
match parsed with
| Either.Left req -> Wire.string_field req "op"
| Either.Right _ -> None
in
let reply =
match parsed with
| Either.Right r -> r
| Either.Left req ->
(match handle t req with
| r -> r
| exception e when not (fatal e) -> reply_of_exn e)
in
(* The two annotations are inside the boundary as well, and not because
they are likely to raise: [with_break] asks the program for its state
and [with_output] drains its pipe, so they touch the same things the
ops do. A reply that raised on its way out would be a reply never
sent, which is the same dead session one line lower down. The
fallback is the unannotated reply — worse than a full one, and the
whole point is that the editor gets an answer. *)
let annotated =
match with_output t (with_break t reply) with
| r -> r
| exception e when not (fatal e) -> reply
in
Wire.send fd annotated;
if op = Some "close" then true else go ()
| exception Wire.Closed -> false
| exception Unix.Unix_error _ -> false

33
lib/session.ml
View File

@ -326,6 +326,7 @@ let eval ?(origin = "<eval>") ?pause t src : change =
why the accumulated list is the post-Load one: re-evaluating a file that
imports something would otherwise append a second copy of the import and
the duplicate-name pass would reject it. *)
let macros = ref t.macros in
let incoming =
let l = Load.program ~file:t.file forms in
(* An evaluated import *adds* to the session's set, so a macro brought in
@ -340,8 +341,16 @@ let eval ?(origin = "<eval>") ?pause t src : change =
name collision, and what [Load] just read off disk is newer than what
the session has been holding: editing a macro in a package and
reloading the file that imports it has to expand the new body. The
other order would keep the stale one and say nothing. *)
t.macros <- Load.macro_union l.Load.macros t.macros;
other order would keep the stale one and say nothing.
Held here and committed at the bottom with everything else, rather than
assigned on the spot: this is above the checker, and the session's rule
is that a form which does not check leaves it exactly as it was —
macros included. Nothing between here and there reads [t.macros]:
[Load.program] puts the imported set in front of the parse it drives
itself, and the checker below is handed declarations that are already
parsed. *)
macros := Load.macro_union l.Load.macros t.macros;
let ds = l.Load.decls in
match package_of t origin with
| None -> ds
@ -480,6 +489,10 @@ 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. *)
t.macros <- !macros;
t.decls <- decls;
t.program <- program;
t.env <- env;
@ -1162,12 +1175,6 @@ let eval_expr ?(origin = "<eval>") ?(pause = false) t src : change =
Tast.fns = t.program.Tast.fns @ fresh @ [ thunk ];
externs = t.program.Tast.externs @ externs }
in
(* The copies stay in the session's program, unlike the thunk: the thunk is
not a declaration and there is nothing to keep, but a copy that has been
built and loaded *is* part of the running process from here on, and
forgetting it would generate a second one under the same name at the next
evaluation. *)
t.program <- { t.program with Tast.fns = t.program.Tast.fns @ fresh };
let ir =
(* The thunk gets debug info on the same flag as everything else. It is a
function nobody sets a breakpoint on by name, but it is a frame on the
@ -1176,4 +1183,14 @@ let eval_expr ?(origin = "<eval>") ?(pause = false) t src : change =
Emit.redefinition ~dev:true ~debug:t.debug ~known:(known t) ~call:name
program ~fns:(List.map (fun (f : Tast.fn) -> f.Tast.name) fresh @ [ name ])
in
(* The copies stay in the session's program, unlike the thunk: the thunk is
not a declaration and there is nothing to keep, but a copy that has been
built and loaded *is* part of the running process from here on, and
forgetting it would generate a second one under the same name at the next
evaluation.
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. *)
t.program <- { t.program with Tast.fns = t.program.Tast.fns @ fresh };
{ ir; names = []; fns = []; installs = true }

28
test/programs/dev-robust.flan Normal file
View File

@ -0,0 +1,28 @@
;;;; A program to send failing evaluations at, for as long as it takes.
;;;;
;;;; Same shape as dev-repl.flan and for the same reason — C-x C-e is a thunk
;;;; the agent runs at a frame boundary, so a program under test has to keep
;;;; reaching them — but with room to spare. What test_dev.ml drives here is
;;;; the *failing* path, and a failure in this loop costs a clang driver that a
;;;; success does not: the macro module is built from scratch, thrown away, and
;;;; built again. dev-repl.flan's 4000 frames are twenty seconds, which is less
;;;; than that sequence takes on a cold cache, and a program that ran out mid
;;;; test would look exactly like the session death the test is here to deny.
;;;;
;;;; Two minutes, then, against a block that runs in well under one: enough
;;;; margin for a cold machine, and short enough that an aborted run does not
;;;; leave a process of this behind for the rest of the afternoon.
(import agent "vendor:agent")
(defvar ticks i64)
(defn step [] i64
(set ticks (+ ticks 1))
ticks)
(defn main [] i32
(agent/start "/tmp/flan-dev-robust-fallback.sock")
(dotimes [i 24000]
(agent/wait 5)
(set ticks (step)))
0)

227
test/test_dev.ml
View File

@ -2802,6 +2802,233 @@ let () =
List.iter (fun f -> try Sys.remove f with Sys_error _ -> ())
[ nsock; nlog ];
(* ── A build that fails is a refusal, not the end of the session ── *)
(* Evaluating runs a compiler, and a compiler can fail in ways the
frontend never does. Expansion is part of both C-c C-c and C-x C-e now,
and expanding means building a macro module and dlopening it — a whole
clang driver, which answers with an exit status and a [Failure], not
with a [Loc.Error]. The daemon used to catch only the latter, at each
op, so the former went past [serve] and took the session with it: the
program stays on screen, the daemon is gone, and the editor finds out
at its next request, on a closed socket. NEXT.md's rule — a form that
does not check leaves the session exactly as it was — is about every
way a form can be refused, not only the checker's.
The build is made to fail by taking the cache directory away from it,
which is the one lever that reaches the macro module and nothing else:
a redefinition module goes llc-then-ld into the daemon's own working
directory and does not touch the cache, so an ordinary evaluation is
unaffected while this is in force. It is also the failure *shape* that
matters here rather than its cause — the daemon cannot tell a linker
that cannot write its output from a macro body clang rejects, and the
claim is about what it does with either.
Its own daemon, its own program and its own cache: the cache has to
start empty for the first expansion to be a miss, and the program has to
outlive a sequence with several cold clang drivers in it, which is what
programs/dev-robust.flan is for. *)
let rsock = tmp "robust.sock" and rout = tmp "robust.out" in
let rcache = tmp "robust.cache" in
let rec rm_rf path =
match Sys.is_directory path with
| true ->
Array.iter (fun f -> rm_rf (Filename.concat path f)) (Sys.readdir path);
(try Sys.rmdir path with Sys_error _ -> ())
| false -> (try Sys.remove path with Sys_error _ -> ())
| exception Sys_error _ -> ()
in
(* A run that failed half way through leaves it read-only, and a second
[dune test] has to start from the same place as the first. *)
(try Unix.chmod rcache 0o700 with Unix.Unix_error _ -> ());
rm_rf rcache;
(try Sys.remove rsock with Sys_error _ -> ());
Unix.mkdir rcache 0o700;
let renv =
Array.of_list
(List.filter
(fun kv ->
not (String.length kv >= 15 && String.sub kv 0 15 = "FLAN_CACHE_DIR="))
(Array.to_list (Unix.environment ()))
@ [ "FLAN_CACHE_DIR=" ^ rcache ])
in
let rfd = Unix.openfile rout [ Unix.O_WRONLY; Unix.O_CREAT; Unix.O_TRUNC ] 0o600 in
let rpid =
Unix.create_process_env flan
[| flan; "dev"; "programs/dev-robust.flan"; "-s"; rsock |]
renv Unix.stdin rfd Unix.stderr
in
Unix.close rfd;
if not (listening ~pid:rpid rsock) then begin
fail "the robustness daemon %s" !listen_why;
(try Unix.kill rpid Sys.sigkill with Unix.Unix_error _ -> ())
end
else begin
let c = connect rsock in
let ask sexp =
(* Its own buffer: the transcript checks above are about other
programs, and this one's output is nobody's evidence. *)
Wire.parse (Wire.send c sexp; Wire.recv c)
in
(* A reply that never arrived is the failure being denied, and it comes
back as an exception out of [Wire.recv] rather than as a status — so
every step here is prepared to say "the session died" by name instead
of ending the test binary on an unhandled [Wire.Closed]. *)
let ask_or what sexp =
match ask sexp with
| r -> Some r
| exception e ->
fail "%s ended the session: %s" what (Printexc.to_string e);
None
in
let message r =
match Wire.string_field r "message" with Some m -> m | None -> ""
in
(* What the session knows, as the editor can see it. Liveness is not the
property — a daemon that answers while having lost track of the
program is worse than one that died — so the failing steps below are
bracketed by this and it has to come back unchanged. *)
let knows () =
match ask_or "describe" "(:op \"describe\")" with
| Some r ->
(match Wire.field r "fns" with
| Some f -> Form.to_string f
| None -> "<no :fns>")
| None -> "<dead>"
in
(* An origin inside the programs directory, because an [import] is
resolved relative to the file the form came from and the package is
beside it. The file itself need not exist: it is an editor buffer. *)
let origin = Filename.concat (Sys.getcwd ()) "programs/buf.flan" in
(* The package's macros have to be in the session before C-x C-e can
reach an expansion at all — an evaluated import is how they get
there, which is [Session.eval]'s macro union. *)
(match
ask_or "the import"
(Printf.sprintf
"(:op \"eval\" :code \"(import mac \\\"pkgs/mac\\\")\" :file %s)"
(Wire.quote origin))
with
| Some r when status r = "ok" -> ()
| Some r -> fail "importing a macro package: %s %s" (status r) (message r)
| None -> ());
(* ── C-x C-e, the path that newly reaches the driver ───────────── *)
(* Taken after the import, which is a change that was *accepted*: the
baseline is what the session knows when the failing step begins. *)
let before = knows () in
(try Unix.chmod rcache 0o500 with Unix.Unix_error _ -> ());
(match
ask_or "an expression whose macro module will not build"
(Printf.sprintf
"(:op \"eval-expr\" :code \"(mac/quad 4)\" :file %s)"
(Wire.quote origin))
with
| Some r ->
if status r <> "error" then
fail "an expression whose macro module will not build answered %s"
(status r);
(* The compiler's own words, which is the whole of what an editor has
to go on. "internal error" would be a reply nobody can act on. *)
if not (contains_sub (message r) "(exit ") then
fail "the reply did not carry the compiler's message: %S"
(message r)
| None -> ());
if knows () <> before then
fail "a failed expression changed what the session knows:\n \
was: %s\n now: %s" before (knows ());
(try Unix.chmod rcache 0o700 with Unix.Unix_error _ -> ());
(* Usable afterwards, and usable *for the thing that just failed*: the
same expression, expanded by the module that would not build a moment
ago. A session that had kept a half-built anything would fail here. *)
(match
ask_or "the expression after a failed one"
(Printf.sprintf
"(:op \"eval-expr\" :code \"(mac/quad 4)\" :file %s)"
(Wire.quote origin))
with
| Some r when status r = "ok" ->
(match Wire.string_field r "value" with
| Some "16" -> ()
| Some v -> fail "(mac/quad 4) evaluated to %s, not 16" v
| None -> fail "the expression after a failed one produced no value")
| Some r ->
fail "the expression after a failed one: %s %s" (status r) (message r)
| None -> ());
(* ── C-c C-c, which is a different path and was as exposed ─────── *)
(* A [defmacro] in the form being evaluated, so this evaluation's macro
set is one the cache has never seen and the build is a miss again. It
is also the case NEXT.md describes literally: a macro whose module
does not build. *)
let macro_defn =
"(defmacro plusone [args] `(+ ~(at args 0) 1)) \
(defn probe-one [] i64 (plusone 41))"
in
let before = knows () in
(try Unix.chmod rcache 0o500 with Unix.Unix_error _ -> ());
(match
ask_or "a defmacro whose module will not build"
(Printf.sprintf "(:op \"eval\" :code %s :file %s)"
(Wire.quote macro_defn) (Wire.quote origin))
with
| Some r ->
if status r <> "error" then
fail "a defmacro whose module will not build answered %s" (status r);
if not (contains_sub (message r) "(exit ") then
fail "the reply did not carry the compiler's message: %S"
(message r)
| None -> ());
(* Nothing of the refused form is in the session — not the macro, and
not the function that was declared beside it. *)
(match knows () with
| k when k <> before ->
fail "a failed redefinition changed what the session knows:\n \
was: %s\n now: %s" before k
| k -> if contains_sub k "probe-one" then
fail "a refused redefinition left probe-one in the session");
(try Unix.chmod rcache 0o700 with Unix.Unix_error _ -> ());
(match
ask_or "the redefinition after a failed one"
(Printf.sprintf "(:op \"eval\" :code %s :file %s)"
(Wire.quote macro_defn) (Wire.quote origin))
with
| Some r when status r = "ok" -> ()
| Some r ->
fail "the redefinition after a failed one: %s %s" (status r)
(message r)
| None -> ());
(* And the session knows it *now*, which is the half of "usable
afterwards" that a live socket does not show: the name is there, and
calling it runs the body the failed evaluation never installed. *)
if not (contains_sub (knows ()) "probe-one") then
fail "the redefinition after a failed one installed nothing";
(match
ask_or "a call to the function the recovered evaluation installed"
(Printf.sprintf "(:op \"eval-expr\" :code \"(probe-one)\" :file %s)"
(Wire.quote origin))
with
| Some r when status r = "ok" ->
(match Wire.string_field r "value" with
| Some "42" -> ()
| Some v -> fail "(probe-one) evaluated to %s, not 42" v
| None -> fail "(probe-one) produced no value")
| Some r -> fail "(probe-one): %s %s" (status r) (message r)
| None -> ());
(try
ignore (Wire.send c "(:op \"close\")");
ignore (Wire.recv c)
with _ -> ());
(try Unix.close c with Unix.Unix_error _ -> ())
end;
(try Unix.kill rpid Sys.sigkill with Unix.Unix_error _ -> ());
(try ignore (Unix.waitpid [] rpid) with Unix.Unix_error _ -> ());
(try Unix.chmod rcache 0o700 with Unix.Unix_error _ -> ());
rm_rf rcache;
List.iter (fun f -> try Sys.remove f with Sys_error _ -> ())
[ rsock; rout ];
List.iter (fun f -> try Sys.remove f with Sys_error _ -> ())
[ sock; out; bsock; bout ];
if !failures = 0 then print_endline "dev: all tests passed"

59
test/test_session.ml
View File

@ -130,6 +130,65 @@ let () =
| c -> if c.Session.fns <> [ "bump" ] then fail "the session did not recover"
| exception Loc.Error { Loc.dmsg = m; _ } -> fail "the session was poisoned by a typo: %s" m);
(* "Exactly as it was" is about every field the session holds, not only the
declarations, and the imported macro set is the one that used to be
written before the checker ran rather than after it. A refused form that
brought an import with it would have left the session holding the
package's macros while holding none of its declarations — accepting half
of a change it reported as refused, which is the state a daemon that
answers and has lost track of the program is made of.
Asserted from the other side, because the set itself is private: after the
refusal, a form that calls the package's macro has to be an unknown name.
If the macros had been kept, this would instead build a macro module and
expand — and the expansion would name [mac/twice], which the session has
no declaration for. *)
(let mt, _ = Session.create ~file:"programs/reload.flan" () in
(match Session.eval mt "(import mac \"pkgs/mac\") (defn bump [] i64 nonsense)" with
| _ -> fail "an import beside an unresolvable name was accepted"
| exception Loc.Error _ -> ());
match Session.eval mt "(defn bump [] i64 (mac/twice 3))" with
| _ ->
fail "a refused evaluation left the session holding the import's macros"
| exception Loc.Error { Loc.dmsg = m; _ } ->
(* By name, so that this cannot pass on some other refusal: what is being
asserted is that [mac/twice] never became a name here. *)
if not (has m "mac/twice") then
fail "the refusal after a rolled-back import was about something \
else: %S" m);
(* And the same question asked of [eval_expr], which keeps state of its own:
a copy of a generic it instantiated stays in the session's program,
because the module that carries it is about to be built and loaded. A
refusal must add nothing — the session would otherwise believe it holds a
body no module was ever written for, and would not emit it again.
What this reaches is the refusal every REPL meets, which is the checker's,
and the checker's is *before* any copy is generated. The window after one
is generated is closed by where the assignment sits — below [Emit], the
last thing in [eval_expr] that can raise — and not by anything here: an
[Emit] that raised would be a compiler bug, and there is no way to ask for
one from out here. What is left uncovered by both is [Check.expression]'s
own mutation: the copy is recorded in the env whether or not the rest
succeeds, and nothing rolls that back. *)
(let xt, _ = Session.create ~file:"programs/reload-generic.flan" () in
let count () = List.length xt.Session.program.Tast.fns in
let before = count () in
(match Session.eval_expr xt "(pick (slice [1.5 0.5] 0 2) nonsense)" with
| _ -> fail "a bad expression was accepted"
| exception Loc.Error _ -> ());
if count () <> before then
fail "a refused expression left %d functions in the session, not %d"
(count ()) before;
(* Still usable, and still able to generate the copy the refused one did
not: the recovery half of the same claim. *)
match Session.eval_expr xt "(println (pick (slice [1.5 0.5] 0 2)))" with
| e ->
if not (has e.Session.ir "pick-f64") then
fail "the expression after a refused one carried no copy"
| exception Loc.Error { Loc.dmsg = m; _ } ->
fail "the session was poisoned by a bad expression: %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