diff --git a/emacs/MANUAL.md b/emacs/MANUAL.md index 9550860f..34130ffa 100644 --- a/emacs/MANUAL.md +++ b/emacs/MANUAL.md @@ -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) | diff --git a/emacs/flan.el b/emacs/flan.el index a76f1ce4..bf3b1f50 100644 --- a/emacs/flan.el +++ b/emacs/flan.el @@ -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) diff --git a/emacs/test-flan.el b/emacs/test-flan.el index 15a4ad81..74853a05 100644 --- a/emacs/test-flan.el +++ b/emacs/test-flan.el @@ -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) diff --git a/lib/dev.ml b/lib/dev.ml index c82236d9..efb8e50c 100644 --- a/lib/dev.ml +++ b/lib/dev.ml @@ -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 diff --git a/lib/session.ml b/lib/session.ml index cc3ca9cd..09f1d965 100644 --- a/lib/session.ml +++ b/lib/session.ml @@ -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 = "") ?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 = "") ?(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 = "") ~(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 diff --git a/test/programs/dev-main-broken.flan b/test/programs/dev-main-broken.flan new file mode 100644 index 00000000..6ef4433e --- /dev/null +++ b/test/programs/dev-main-broken.flan @@ -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) diff --git a/test/test_dev.ml b/test/test_dev.ml index adf51d38..5d4046b3 100644 --- a/test/test_dev.ml +++ b/test/test_dev.ml @@ -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 \"\")" + 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 diff --git a/test/test_session.ml b/test/test_session.ml index 4ec393b2..c612c83d 100644 --- a/test/test_session.ml +++ b/test/test_session.ml @@ -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 diff --git a/vendor/agent/flan_agent.c b/vendor/agent/flan_agent.c index 2ca2aadb..65e14c7e 100644 --- a/vendor/agent/flan_agent.c +++ b/vendor/agent/flan_agent.c @@ -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 ");