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

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
+A form that does not compile is left out, and the rest are installed. A name
-rest are installed. Each form left out is marked in the buffer and listed in
+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) |

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
+A form that does not compile is left out, and the rest are installed.  A name
-rest are installed.  Each one left out is marked in the buffer and listed in
+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)

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)

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 \
+                   ("the program did not reach a frame boundary in five seconds. "
-                    (agent/poll)?")
+                    ^ 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 \
+                   ("the program did not reach a frame boundary in five seconds. "
-                    (agent/poll)?"
+                    ^ 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
+  (* A thunk stopped in the break loop on the parked thread. Aborting it is
-     stopped in the break loop on the parked thread is something to abort, and
+     abandoning the expression, not ending the process: the program had
-     for a condition with no restart worth taking it is the only thing that
+     already finished, and the break loop offers the thunk's own boundary as a
-     ends it. What it costs is unchanged and is what the reply has always said
+     restart, so that is what is taken and the session stays parked. A trap
-     — the process goes, and the session with it. *)
+     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
+  if not (Session.has_main session) then
-      (List.exists (fun (f : Tast.fn) -> f.Tast.name = "main")
-         session.Session.host.Tast.fns)
-  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
+(* What [flan dev] says about the forms of its file that did not compile. The
-   compile. The session starts without them; C-c C-k loads the file again once
+   session starts without them; C-c C-k loads the file again once they are
-   they are fixed. *)
+   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

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
+(* The session [flan dev] starts: the file's forms loaded as [pruned] loads
-   without one is the empty image of SBCL's order: a [main] that returns at
+   them, so what compiles is in the host and what does not is answered beside
-   once is added so there is a process to park, and the file's forms are
+   the session rather than instead of it. A file with no [main] — or whose
-   loaded into it as [pruned] loads them — what compiles is in the host, and
+   [main] is one of the forms left out — is the empty image of SBCL's order: a
-   what does not is answered beside the session rather than instead of it. 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
+  let build forms =
-  if declares_main forms then
+    of_forms ~debug ~x86 ~file
-    let t, l = create ~debug ~x86 ~file () in
+      (if declares_main forms then forms else forms @ stub_main ())
-    (t, l, [])
+  in
-  else
+  let (t, l), _, errs = pruned build (Reader.read_file file) in
-    let build forms = of_forms ~debug ~x86 ~file (forms @ stub_main ()) in
+  (t, l, errs)
-    let (t, l), _, errs = pruned build forms 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

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)

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 \"<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

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

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 ");