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

A file with a broken form still starts a session, a package's macros expand bare from its file, a delivery a running program never polls for says so with a fix that compiles, and aborting an expression stopped in the park abandons it and keeps the session

Browse Source
This commit is contained in:
Joseph Ferano 2026-09-25 13:06:36 +07:00
parent b74002be02
commit f87d596bdc
9 changed files with 230 additions and 43 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

7
emacs/MANUAL.md
View File

@ -285,8 +285,10 @@ SLIME and CIDER. It is sent as **one** module rather than as a form at a time.
That matters: a `defonce` and the function that uses it have to arrive together,
or the function refers to storage that does not exist yet.
A form that does not compile is left out, and so is any form that uses it; the
rest are installed. Each form left out is marked in the buffer and listed in
A form that does not compile is left out, and the rest are installed. A name
that was already in the program keeps its earlier definition, and the forms that
use it are compiled against that one; a form that uses a name defined nowhere
else is left out too. Each form left out is marked in the buffer and listed in
`*flan-diagnostics*`, and the echo area counts them. When nothing compiles,
nothing is installed and the first error is reported as `C-c C-c` reports one.
@ -1184,7 +1186,6 @@ Use `C-c C-g` if you need frames.
| `C-u C-c C-c` | ...and stop at the form point is inside (`C-u C-u`: on entry) |
| `C-M-x` | the same as `C-c C-c`, on the binding SLIME and CIDER use |
| `C-c C-k` | load the whole buffer, as one module; what does not compile is listed |
| `C-x C-e` | the form before point, evaluated — or installed, if it is a declaration |
| `C-u C-x C-e` | ...and stop at it instead of showing its value |
| `C-c C-z` | connect (finds `.flan-dev.sock` upward) |

17
emacs/flan.el
View File

@ -537,7 +537,12 @@ with it, and a rejected evaluation is a likely moment to *become* stopped."
(unless (eq was now)
(force-mode-line-update t)
(when now
(message "flan: the program finished; C-c C-M-x runs it again"))))
;; `:main nil' is a file with no main of its own: nothing ran, and
;; there is nothing to run again until one is loaded.
(if (and (plist-member reply :main) (null (plist-get reply :main)))
(message "flan: the file has no main; C-x C-e and C-c C-k work \
on the session, and C-c C-M-x runs main once one is loaded")
(message "flan: the program finished; C-c C-M-x runs it again")))))
(let ((was flan--stopped)
(now (and (plist-get reply :stopped)
(or (plist-get reply :condition) "a condition"))))
@ -1290,7 +1295,8 @@ one process would be writing the same globals at once."
(defun flan-abort ()
"Let the stopped program die where it stopped.
This ends `flan dev' too: the daemon owns the program's lifetime and has
nothing left to serve once it has gone."
nothing left to serve once it has gone. An expression that stopped while the
program was parked is abandoned instead, and the session stays."
(interactive)
(let ((r (flan--request '(:op "abort"))))
(if (equal (plist-get r :status) "ok")
@ -1690,7 +1696,6 @@ Returns non-nil when it put an overlay somewhere."
(when buf
(with-current-buffer buf
(unless keep (flan-clear-errors buf))
;; A refusal is not a value, and the two must never be drawn over
;; one form at once. Ordinarily the command that ran this
;; evaluation already cleared the last one through the hook; this
@ -2875,8 +2880,10 @@ Every top-level form is compiled and installed together, as one module: a var
and the function that uses it have to arrive in the same load or the first
refers to storage that does not exist.
A form that does not compile is left out, and so is a form that uses it; the
rest are installed. Each one left out is marked in the buffer and listed in
A form that does not compile is left out, and the rest are installed. A name
already in the program keeps its earlier definition, and forms that use it are
compiled against that one; a form that uses a name defined nowhere else is
left out too. Each one left out is marked in the buffer and listed in
`flan-diagnostics-buffer'. When nothing compiles, nothing is installed and
the command signals, as `C-c C-c' does."
(interactive)

6
emacs/test-flan.el
View File

@ -2405,6 +2405,12 @@ already rely on it — so nothing here is a stand-in for the real thing."
(flan scratch socket6)
(test-flan--check "a daemon starts on a file with no main"
(process-live-p flan--connection))
(let* ((reply (flan--request '(:op "describe")))
(said (progn (setq flan--parked nil)
(test-flan--said (flan--absorb reply)))))
(test-flan--check "a parked session with no main does not say a program finished"
(and said (string-match-p "has no main" said)
(not (string-match-p "finished" said)))))
(test-flan--check "and an expression reaches the file's functions"
(equal (funcall value "(fib 10)") "55"))
(with-current-buffer (find-file-noselect scratch)

96
lib/dev.ml
View File

@ -137,6 +137,14 @@ let await ?(ms = 5000) f =
(* Every program [flan dev] builds has the agent linked — see [with_agent] — so
a program that cannot be reached is one whose socket went away, not one that
never had an agent. *)
(* What a program does so that code from the editor reaches it while it runs.
Every program [flan dev] builds has the agent's C, but only the program can
decide where its frames end. Both forms compile as written. *)
let polls_for_it =
"Code from the editor runs where the program polls for it: import the \
agent with (import agent \"vendor:agent\") and call (agent/poll) once in \
each pass of the main loop"
let unreachable _t e = "cannot reach the program: " ^ Unix.error_message e
(* Whether the program has bound the socket it receives modules on.
@ -734,6 +742,11 @@ let with_break t reply =
let fields =
fields ^ (if liveness t = Parked then " :parked t" else " :parked nil")
in
(* Only when there is no [main] of the file's own: a parked session over a
file without one finished nothing, and an editor should not say it did. *)
let fields =
if Session.has_main t.session then fields else fields ^ " :main nil"
in
String.sub reply 0 (String.length reply - 1) ^ fields ^ ")"
let error ?loc msg =
@ -875,6 +888,37 @@ let refusal ~parked reply =
the module is still queued through the in-process call. A note saying the
program "has not called (agent/start ...)" named a cause that was not the
cause, so there is none. *)
(* A running program takes a queued module at its next [(agent/poll)], and one
that never polls never takes it. The agent always accepts, so "ok" alone
would report a change that does not land: the ring is watched for a moment
and a module still waiting at the end is said to be waiting, with the fix.
An agent without the [pending] verb (a program vendoring an older one) is
not asked twice. A stopped program polls from its break loop, and a parked
one gets its own note. *)
let unpolled_note t ~parked =
if parked || state t <> Running then []
else begin
let deadline = Unix.gettimeofday () +. 3. in
let rec taken () =
match int_of_string_opt (String.trim (request t "pending")) with
| None | Some 0 -> true
| Some _ ->
if Unix.gettimeofday () >= deadline then false
else begin
drain t;
ignore (Unix.select [] [] [] 0.005);
taken ()
end
| exception Unix.Unix_error _ -> true
in
if taken () then []
else
[ ":note "
^ Wire.quote
("queued, but the running program has not taken it in three \
seconds, so it has not reached a frame boundary. "
^ polls_for_it ^ "; it installs at the first poll") ]
end
let install_note t ~parked =
if parked then begin
@ -1018,6 +1062,7 @@ let eval ?forms ?base ?(extra = []) t ~code ~origin ~pause =
[ ":pause " ^ Wire.quote (Printf.sprintf "%d:%d" l c) ]
| None -> [])
@ install_note t ~parked:parked_now
@ unpolled_note t ~parked:parked_now
@ extra)
| reply -> refused (refusal ~parked:parked_now reply)
| exception Unix.Unix_error (e, _, _) ->
@ -1424,8 +1469,8 @@ let eval_expr t ~code ~origin ~pause =
break buffer, and evaluate this again"
else
error
"the program did not reach a frame boundary; is it calling \
(agent/poll)?")
("the program did not reach a frame boundary in five seconds. "
^ polls_for_it))
(* 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
@ -2195,8 +2240,8 @@ let run_render_thunk ?(stopped_only = false) ?at_stop t ~tag
it stands now"
else
Error
"the program did not reach a frame boundary; is it calling \
(agent/poll)?"
("the program did not reach a frame boundary in five seconds. "
^ polls_for_it)
in
if ms <= 0 then gave_up ()
else begin
@ -3402,11 +3447,28 @@ let abort t =
parked
"the program has already finished, so there is nothing to abort and \
nothing that would end by aborting it but this session"
(* The one exception, and it is the same exception the restarts are: a thunk
stopped in the break loop on the parked thread is something to abort, and
for a condition with no restart worth taking it is the only thing that
ends it. What it costs is unchanged and is what the reply has always said
— the process goes, and the session with it. *)
(* A thunk stopped in the break loop on the parked thread. Aborting it is
abandoning the expression, not ending the process: the program had
already finished, and the break loop offers the thunk's own boundary as a
restart, so that is what is taken and the session stays parked. A trap
offers nothing that can be taken, and there abort still ends the
process. *)
| Parked
when match restarts t with
| Ok (rs, false) -> List.exists (fun (_, f, _) -> f = Boundary) rs
| _ -> false ->
(match restarts t with
| Ok (rs, _) ->
let i, _, _ = List.find (fun (_, f, _) -> f = Boundary) rs in
(match ask t ("restart-at " ^ string_of_int i) with
| reply when accepted reply <> None ->
ok
[ ":note "
^ Wire.quote
"the evaluation is abandoned; the program is still parked, and anything the expression changed before it stopped stays changed" ]
| reply -> error (String.trim reply)
| exception Unix.Unix_error (e, _, _) -> error (unreachable t e))
| Error m -> error m)
| Live | Parked ->
match ask t "abort" with
| reply when String.trim reply = "ok" ->
@ -4229,7 +4291,6 @@ let handle t req =
| code -> load_file t ~code ~origin
| exception Sys_error m -> error ("cannot read the file: " ^ m))))
| Some "describe" -> describe t
| Some "defs" -> defs t
| Some "break" -> break t
| Some "condition" -> condition_op t
@ -4956,10 +5017,7 @@ let make_session_dir ~file dir =
stub [Session.create_dev] gives a file with no [main] is no use to it. The
one-process daemon takes such a file. *)
let need_main ~file (session : Session.t) =
if not
(List.exists (fun (f : Tast.fn) -> f.Tast.name = "main")
session.Session.host.Tast.fns)
then
if not (Session.has_main session) then
failwith
(Printf.sprintf
"%s has no main, and flan dev --two-process runs the program as a \
@ -4991,9 +5049,9 @@ let with_agent ~dir csrcs lflags =
in
(csrcs, lflags)
(* What [flan dev] says about the forms of a file with no [main] that did not
compile. The session starts without them; C-c C-k loads the file again once
they are fixed. *)
(* What [flan dev] says about the forms of its file that did not compile. The
session starts without them; C-c C-k loads the file again once they are
fixed. *)
let report_dropped ~file = function
| [] -> ()
| ds ->
@ -5021,8 +5079,9 @@ let two_process ?(debug = false) ?(x86 = true) ~file ~sock () =
let dir = session_dir ~file ~sock in
let given = file in
let file = try Unix.realpath file with Unix.Unix_error _ -> file in
let session, l = Session.create ~debug ~x86 ~file () in
let session, l, dropped = Session.create_dev ~debug ~x86 ~file () in
need_main ~file:given session;
report_dropped ~file:given dropped;
make_session_dir ~file:given dir;
let csrcs, lflags = with_agent ~dir l.Load.csrcs l.Load.lflags in
let exe = Filename.concat dir "program" in
@ -6061,7 +6120,6 @@ let start_merged ?(debug = false) ?(x86 = true) ~file ~sock () =
than that a program finished. *)
Unix.putenv "FLAN_DEV_NO_MAIN"
(if Session.has_main session then "0" else "1");
let agent = Filename.concat dir "agent.sock" in
(* Every one of these is read by the exec'd binary and by nothing else. They
are set before the exec rather than by the compiler thread afterwards, so

53
lib/session.ml
View File

@ -333,21 +333,19 @@ let has_main t =
&& not (String.equal d.Ast.dloc.Loc.file stub_file))
t.decls
(* The session [flan dev] starts. A file with a [main] is [create]'s. A file
without one is the empty image of SBCL's order: a [main] that returns at
once is added so there is a process to park, and the file's forms are
loaded into it as [pruned] loads them — what compiles is in the host, and
what does not is answered beside the session rather than instead of it. A
(* The session [flan dev] starts: the file's forms loaded as [pruned] loads
them, so what compiles is in the host and what does not is answered beside
the session rather than instead of it. A file with no [main] — or whose
[main] is one of the forms left out — is the empty image of SBCL's order: a
[main] that returns at once is added so there is a process to park, and a
[main] loaded later replaces the stub like any other redefinition. *)
let create_dev ?(debug = false) ?(x86 = false) ~file () =
let forms = Reader.read_file file in
if declares_main forms then
let t, l = create ~debug ~x86 ~file () in
(t, l, [])
else
let build forms = of_forms ~debug ~x86 ~file (forms @ stub_main ()) in
let (t, l), _, errs = pruned build forms in
(t, l, errs)
let build forms =
of_forms ~debug ~x86 ~file
(if declares_main forms then forms else forms @ stub_main ())
in
let (t, l), _, errs = pruned build (Reader.read_file file) in
(t, l, errs)
(* What a macro may call, for the same reason [macros] is held: an evaluation
parses one form with no import in sight, and a package macro whose body
@ -420,6 +418,29 @@ let package_of t origin =
(* A name the running process exports. Everything else is looked up by name at
install time — see [Emit.redefinition]'s [known]. *)
(* The macros a form sent from [origin] can call. From a package's file that
is the package's own under the bare names the file writes, in front of the
rest: the session holds them qualified, as the importer calls them, and a
bare call parsed without these is a call to an unknown function that the
qualification afterwards turns into a call to the macro's own name. *)
let macros_for t origin =
match package_of t origin with
| None -> t.macros
| Some p ->
let pre = p.Load.alias ^ "/" in
let bare =
List.filter_map
(fun (f : Form.t) ->
match f.Form.v with
| Form.List (hd :: ({ Form.v = Form.Sym n; _ } as nf) :: rest)
when String.starts_with ~prefix:pre n ->
let b = String.sub n (String.length pre) (String.length n - String.length pre) in
Some { f with Form.v = Form.List (hd :: { nf with Form.v = Form.Sym b } :: rest) }
| _ -> None)
t.macros
in
Load.macro_union bare t.macros
let known t n =
List.exists (fun (f : Tast.fn) -> String.equal f.Tast.name n) t.host.Tast.fns
|| List.exists
@ -766,7 +787,7 @@ let eval ?(origin = "<eval>") ?base ?forms ?pause ?(running = true) t src : chan
(* What an annotated listing quotes for this form is what was sent, not what
the file on disk said when it was last read. *)
Loc.remember ~file:origin src;
Parse.with_imported ~decls:(package_decls t) t.macros @@ fun () ->
Parse.with_imported ~decls:(package_decls t) (macros_for t origin) @@ fun () ->
(* Through [Load] like any other source, so an evaluated (import ...) means
what it means in a file. Its expansion is what gets spliced, which is also
why the accumulated list is the post-Load one: re-evaluating a file that
@ -2328,7 +2349,7 @@ let eval_expr ?(origin = "<eval>") ?(pause = false) t src : change =
a cold macro module costs its ~300ms before that clock starts,
and the non-termination refusals raise [Loc.Error] out of this call, which
the daemon already answers as an error rather than a silence. *)
let parsed = Parse.with_imported ~decls:(package_decls t) t.macros (fun () -> Parse.expr form) in
let parsed = Parse.with_imported ~decls:(package_decls t) (macros_for t origin) (fun () -> Parse.expr form) in
(* CIDER's rule: an expression sent from a package's file means what it
would mean written in that file, so [(integrate 1.0)] in physics/step.flan
reaches [physics/integrate]. The qualification [eval] gives a declaration
@ -2482,7 +2503,7 @@ let macroexpand ?(origin = "<eval>") ~(all : bool) t (src : string) : expansion
let before = Expand.quasiquote form in
(* And the session's macros in front of it, as [eval] and [eval_expr] both
put them: [Macro.program] reads [Parse.imported_macros] directly. *)
Parse.with_imported ~decls:(package_decls t) t.macros @@ fun () ->
Parse.with_imported ~decls:(package_decls t) (macros_for t origin) @@ fun () ->
let after, name =
if all then Macro.expand_all before else Macro.expand_step before
in

7
test/programs/dev-main-broken.flan Normal file
View File

@ -0,0 +1,7 @@
;;;; A file with a main and one form that does not compile: flan dev starts
;;;; with the rest.
(defn fine [] i64 42)
(defn bad [] i64 "x")
(defn main [] i32 0)

49
test/test_dev.ml
View File

@ -5219,8 +5219,28 @@ let () =
"(:op \"eval\" :code \"(defn step [] i64 9)\" :file \
\"programs/dev-noagent-running.flan\")"
in
let fix m =
contains_sub m "(import agent \"vendor:agent\")"
&& contains_sub m "(agent/poll)"
in
if status r <> "ok" then
fail "a delivery to a running program that never imports the agent: %s"
(Option.value ~default:"" (Wire.string_field r "message"))
else if not (fix (Option.value ~default:"" (Wire.string_field r "note")))
then
fail "a delivery the running program never takes did not say so: %s"
(Option.value ~default:"(no note)" (Wire.string_field r "note"));
(* And an expression, which waits for a frame boundary the program never
reaches, and names the same fix. *)
let r =
request gc
"(:op \"eval-expr\" :code \"(step)\" :file \
\"programs/dev-noagent-running.flan\")"
in
if status r <> "error"
|| not (fix (Option.value ~default:"" (Wire.string_field r "message")))
then
fail "an expression for a program that never polls: %s %s" (status r)
(Option.value ~default:"" (Wire.string_field r "message"));
(try
ignore (Wire.send gc "(:op \"close\")");
@ -7669,6 +7689,35 @@ let () =
|| not (contains_sub (said r) "has no main")
|| not (contains_sub (said r) "(defn main [] i32")
then fail "a re-run with no main: %s %s" (status r) (said r);
(* The replies say there is no main of the file's own, so an editor
does not report a program that finished. *)
(match Wire.field (request mc "(:op \"describe\")") "main" with
| Some { Form.v = Form.Sym "nil"; _ } -> ()
| _ -> fail "a session with no main did not say so on its replies");
(* An expression that stops in the park, aborted: the expression is
abandoned and the session stays. *)
let r =
request mc
"(:op \"eval-expr\" :code \"(twice 1)\" :pause t :file \"<test>\")"
in
ignore r;
if not
(await (fun () ->
match Wire.field (request mc "(:op \"describe\")") "stopped" with
| Some { Form.v = Form.Sym "t"; _ } -> true
| _ -> false))
then fail "a paused expression in the park did not stop"
else begin
match request mc "(:op \"abort\")" with
| r when status r <> "ok" -> fail "aborting a parked expression: %s" (said r)
| _ ->
(match value "(twice 2)" with
| "4" -> ()
| v -> fail "the session after aborting a parked expression: %s" v
| exception e ->
fail "aborting a parked expression ended the session: %s"
(Printexc.to_string e))
end;
(* A main loaded into it is the one a re-run runs. *)
let r =
request mc

28
test/test_session.ml
View File

@ -1658,6 +1658,19 @@ let () =
| exception Loc.Error { Loc.dmsg = m; _ } ->
fail "a no-main file with a bad form refused the session: %s" m);
(* A file with a main of its own and a form that does not compile starts
the same way, with its own main. *)
(match Session.create_dev ~file:"programs/dev-main-broken.flan" () with
| t, _, errs ->
if not (Session.has_main t) then fail "the file's own main was left out";
let fns = List.map (fun (f : Tast.fn) -> f.Tast.name) t.Session.host.Tast.fns in
if not (List.mem "fine" fns) || List.mem "bad" fns then
fail "a file with a main started with the wrong forms";
if List.length errs <> 1 then
fail "a start with one bad form named %d" (List.length errs)
| exception Loc.Error { Loc.dmsg = m; _ } ->
fail "a file with a main and a bad form refused the session: %s" m);
(* [pruned] on its own, as the daemon's load-file runs it: each round drops
the form the error is in, and one it could not blame is raised. *)
(let t, _ = Session.create ~file:"programs/dev-parknote.flan" () in
@ -1697,6 +1710,21 @@ let () =
fail "an expression from a package's file did not reach the package"
| exception Loc.Error { Loc.dmsg = m; _ } ->
fail "an expression from a package's file: %s" m);
(* The package's own macro, bare, from its file: an expression and a
declaration both expand it as the file would. *)
(match
Session.eval_expr ~origin:"programs/pkgs/secret/secret.flan" tq "(mixed 1 1)"
with
| _ -> ()
| exception Loc.Error { Loc.dmsg = m; _ } ->
fail "a package's macro, bare, from its file: %s" m);
(match
Session.eval ~origin:"programs/pkgs/secret/secret.flan" tq
"(defn via-mixed [] i32 (mixed 1 2))"
with
| _ -> ()
| exception Loc.Error { Loc.dmsg = m; _ } ->
fail "a package's macro, bare, in a declaration from its file: %s" m);
match
Session.eval_expr ~origin:"programs/pkg-private.flan" tq "(combine 1 2)"
with

10
vendor/agent/flan_agent.c vendored
View File

@ -1195,6 +1195,16 @@ static void handle_line(char *line, sink *o) {
* running too — "running" is an answer, not a refusal — because this is
* the one question an editor asks without knowing the state already, and
* refusing it would leave nothing to poll. */
/* How many modules are queued and not yet taken by a poll. The daemon asks
* after a delivery to a running program, so that one which never polls is
* told so rather than answered "ok" for a change that never lands. */
if (strcmp(line, "pending") == 0) {
char b[32];
unsigned h = atomic_load(&head), t = atomic_load(&tail);
snprintf(b, sizeof b, "%u\n", h - t);
reply(o, b);
return;
}
if (strcmp(line, "status") == 0) {
if ((atomic_load(&depth) > 0)) {
reply(o, "stopped ");