The program's output goes where someone is looking at it

Its stdout is a pipe into the daemon now, and whatever it printed since the
last reply rides along with the next one into *flan-output*. Arriving with a
reply rather than by a separate request is the point: the output an evaluation
itself caused is the output anyone wants to see.

Draining that pipe is a liveness requirement, not a nicety. A pipe nobody reads
fills at 64K and the next write blocks the program forever, so it is read from
the accept loop's select whether or not an editor is asking, and the buffer is
capped - a program printing every frame must not grow the daemon without limit,
and the newest text is the useful end.

test_dev read the program's transcript off the daemon's stdout, which is no
longer where it goes; it collects :output from replies instead, which is also
what the editor does. The emacs test moved to a fixture that keeps running,
since it now evaluates more times than the old one had reloads to give.

NEXT.md

@@ -686,6 +686,7 @@ of the protocol choice: `prin1` writes a request and `read` reads a reply.
 | `C-c C-k` | the whole buffer, as **one** module |
 | `C-x C-e` | the expression before point, evaluated *in the running program* |
 | `C-c C-z` / `C-c C-q` | connect (finds `.flan-dev.sock` upward) / disconnect |
+| `C-c C-o` | the running program's own output, in `*flan-output*` |
 | `C-c C-d` | what the running program currently defines |
 
 `C-c C-k` sends one module rather than a form at a time on purpose: a `defvar`
@@ -704,6 +705,16 @@ syntax table, or in the reply reader passes `test_dev.ml` and fails here.
 An error comes back with a location and the client moves point to it when it is
 this buffer.
 
+**The program's stdout is a pipe into the daemon**, and whatever it printed
+since the last reply rides along with the next one into `*flan-output*`. Having
+it arrive *with* a reply rather than by a separate request is the point: the
+output an evaluation itself caused is the output anyone wants to see. Draining
+that pipe is a liveness requirement and not a nicety — a pipe nobody reads
+fills at 64K and the next write blocks the program forever — so it is read from
+the accept loop's `select`, not only when an editor asks, and the buffer is
+capped so a program printing every frame cannot grow the daemon without
+limit.
+
 ### `C-x C-e` — evaluating an expression
 
 A different primitive from redefining a name, and the difference is the whole

emacs/flan-dev.el

@@ -37,6 +37,10 @@
   "Whether a successful evaluation reports in the echo area."
   :type 'boolean)
 
+(defcustom flan-dev-output-buffer "*flan-output*"
+  "Buffer the running program's own output is appended to."
+  :type 'string)
+
 (defvar flan-dev--connection nil
   "The open connection, or nil.")
 
@@ -84,11 +88,27 @@
           (delete-region (point-min) end)
           form)))))
 
+(defun flan-dev--append-output (text)
+  "Append TEXT, the running program's own output, to its buffer."
+  (when (and text (> (length text) 0))
+    (with-current-buffer (get-buffer-create flan-dev-output-buffer)
+      (let ((at-end (= (point) (point-max))))
+        (save-excursion
+          (goto-char (point-max))
+          (insert text))
+        ;; Follow the tail only for someone who was already at it; a reader
+        ;; scrolled back is reading something.
+        (when at-end (goto-char (point-max)))))))
+
 (defun flan-dev--request (form)
   "Send FORM to the connected program and return its reply."
-  (let ((proc (flan-dev--live-connection)))
+  (let* ((proc (flan-dev--live-connection))
-    (flan-dev--send proc form)
+         (reply (progn (flan-dev--send proc form)
-    (flan-dev--read-reply proc)))
+                       (flan-dev--read-reply proc))))
+    ;; Whatever the program printed since the last reply rides along with this
+    ;; one, so the output an evaluation itself caused arrives with its result.
+    (flan-dev--append-output (plist-get reply :output))
+    reply))
 
 ;;; Connection
 
@@ -138,6 +158,13 @@ With no argument, look for `flan-dev-socket-name' up from this buffer."
   (setq flan-dev--connection nil)
   (message "flan dev: disconnected"))
 
+;;;###autoload
+(defun flan-show-output ()
+  "Show the running program's output, after collecting anything pending."
+  (interactive)
+  (ignore-errors (flan-dev--request '(:op "describe")))
+  (display-buffer (get-buffer-create flan-dev-output-buffer)))
+
 (defun flan-describe ()
   "Report what the running program currently defines."
   (interactive)

emacs/flan-mode.el

@@ -17,6 +17,7 @@
 (declare-function flan-connect "flan-dev")
 (declare-function flan-disconnect "flan-dev")
 (declare-function flan-describe "flan-dev")
+(declare-function flan-show-output "flan-dev")
 
 (defgroup flan nil
   "Editing and evaluating Flan."
@@ -76,6 +77,7 @@
     (define-key map (kbd "C-c C-z") #'flan-connect)
     (define-key map (kbd "C-c C-q") #'flan-disconnect)
     (define-key map (kbd "C-c C-d") #'flan-describe)
+    (define-key map (kbd "C-c C-o") #'flan-show-output)
     map)
   "Keymap for `flan-mode'.")
 

emacs/test-flan-dev.el

@@ -65,6 +65,16 @@
   ;; The session is not poisoned by that: a good form still lands.
   (flan-dev--eval "(defn step [] i64 (set ticks (+ ticks 100)) ticks)" "form")
 
+  ;; The program's own output arrives on replies and lands in its buffer, so
+  ;; a long-running program is not writing into a terminal nobody is watching.
+  (flan-dev--eval "(defn step [] i64 (do (print-line \"HELLO\") ticks))" "form")
+  (let ((seen nil) (deadline (+ (float-time) 10)))
+    (while (and (not seen) (< (float-time) deadline))
+      (ignore-errors (flan-dev--request '(:op "describe")))
+      (setq seen (with-current-buffer (get-buffer-create flan-dev-output-buffer)
+                   (string-match-p "HELLO" (buffer-string)))))
+    (test-flan--check "the program's output reaches its buffer" seen))
+
   (flan-disconnect)
   (test-flan--check "disconnected" (not (process-live-p flan-dev--connection)))
 

lib/dev.ml

@@ -18,9 +18,47 @@ type t = {
   child   : int;                 (* the running program *)
   agent   : string;              (* where it listens for modules *)
   dir     : string;              (* modules are built here, one per eval *)
+  stdout  : Unix.file_descr;     (* the program's output, on its way to here *)
+  out     : Buffer.t;            (* ...buffered until an editor asks for it *)
   mutable n : int;               (* dlopen caches by path: never reuse one *)
 }
 
+(* The program's stdout is a pipe into this process, so that an editor can see
+   it. That makes draining it a *liveness* requirement and not a nicety: a pipe
+   nobody reads fills at 64K and the next write blocks the program forever. So
+   it is read from the accept loop's select, not only when someone asks. *)
+let capacity = 256 * 1024
+
+let drain t =
+  let b = Bytes.create 8192 in
+  let rec go () =
+    match Unix.select [ t.stdout ] [] [] 0. with
+    | [], _, _ -> ()
+    | _ ->
+      (match Unix.read t.stdout b 0 8192 with
+       | 0 -> ()
+       | n ->
+         Buffer.add_subbytes t.out b 0 n;
+         (* Bounded: a program that prints every frame must not grow this
+            process without limit. The newest text is the useful end. *)
+         if Buffer.length t.out > capacity then begin
+           let keep = Buffer.sub t.out (Buffer.length t.out - capacity) capacity in
+           Buffer.clear t.out;
+           Buffer.add_string t.out keep
+         end;
+         go ()
+       | exception Unix.Unix_error (Unix.EAGAIN, _, _) -> ()
+       | exception Unix.Unix_error (Unix.EWOULDBLOCK, _, _) -> ()
+       | exception Unix.Unix_error _ -> ())
+  in
+  go ()
+
+let take t =
+  drain t;
+  let s = Buffer.contents t.out in
+  Buffer.clear t.out;
+  s
+
 let await ?(ms = 5000) f =
   let rec go ms =
     if f () then true
@@ -101,6 +139,16 @@ let alive t =
 let ok fields =
   "(:status \"ok\"" ^ String.concat "" (List.map (fun f -> " " ^ f) fields) ^ ")"
 
+(* Anything the program printed since the last reply rides along with this one.
+   An editor that had to ask separately would miss the output an evaluation
+   itself caused, which is the output anyone actually wants to see. *)
+let with_output t reply =
+  match take t with
+  | "" -> reply
+  | text ->
+    let i = String.length reply - 1 in
+    String.sub reply 0 i ^ " :output " ^ Wire.quote text ^ ")"
+
 let error ?loc msg =
   "(:status \"error\" :message " ^ Wire.quote msg
   ^ (match loc with None -> "" | Some l -> " :loc " ^ Wire.quote l)
@@ -229,7 +277,7 @@ let serve t fd =
         | req -> (Wire.string_field req "op", handle t req)
         | exception Loc.Error (_, m) -> (None, error ("bad request: " ^ m))
       in
-      Wire.send fd reply;
+      Wire.send fd (with_output t reply);
       if op = Some "close" then true else go ()
     | exception Wire.Closed -> false
     | exception Unix.Unix_error _ -> false
@@ -255,7 +303,12 @@ let start ~file ~sock =
      environment. Guessing instead would fail silently — everything compiles,
      the module is built, and nothing ever receives it. *)
   Unix.putenv "FLAN_AGENT_SOCKET" agent;
-  let child = Unix.create_process exe [| exe |] Unix.stdin Unix.stdout Unix.stderr in
+  (* Through a pipe, so the program's own output can reach an editor instead of
+     only the terminal the daemon was started in. *)
+  let rd, wr = Unix.pipe ~cloexec:false () in
+  let child = Unix.create_process exe [| exe |] Unix.stdin wr Unix.stderr in
+  Unix.close wr;
+  Unix.set_nonblock rd;
 
   (* Wait for it to bind before accepting an evaluation. One that arrives first
      would fail for a reason that reads like a compiler bug. *)
@@ -266,7 +319,9 @@ let start ~file ~sock =
        ^ " — does it call (agent/start ...)?")
   end;
 
-  let t = { session; child; agent; dir; n = 0 } in
+  let t =
+    { session; child; agent; dir; stdout = rd; out = Buffer.create 4096; n = 0 }
+  in
   (try Unix.unlink sock with Unix.Unix_error _ -> ());
   let ls = Unix.socket Unix.PF_UNIX Unix.SOCK_STREAM 0 in
   Unix.bind ls (Unix.ADDR_UNIX sock);
@@ -279,8 +334,11 @@ let start ~file ~sock =
      wait forever. *)
   let rec accept_loop () =
     if alive t then
-      match Unix.select [ ls ] [] [] 0.2 with
+      (* The program's pipe is in the same select as the listening socket: it
+         has to be drained whether or not an editor is asking for anything. *)
+      match Unix.select [ ls; t.stdout ] [] [] 0.2 with
       | [], _, _ -> accept_loop ()
+      | ready, _, _ when not (List.mem ls ready) -> drain t; accept_loop ()
       | _ ->
         (match Unix.accept ls with
          | fd, _ ->
@@ -294,5 +352,6 @@ let start ~file ~sock =
     ~finally:(fun () ->
       (try Unix.kill child Sys.sigterm with Unix.Unix_error _ -> ());
       (try Unix.close ls with Unix.Unix_error _ -> ());
+      (try Unix.close rd with Unix.Unix_error _ -> ());
       (try Unix.unlink sock with Unix.Unix_error _ -> ()))
     accept_loop

test/programs/dev-repl.flan

@@ -10,7 +10,7 @@
 (defconst step-by i64 3)
 
 (defn step [] i64
-  (set ticks (+ ticks step-by))
+  (set ticks (+ ticks 1))
   ticks)
 
 (defn main [] i32

test/test_dev.ml

@@ -28,7 +28,17 @@ let rec connect ?(ms = 5000) path =
     ignore (Unix.select [] [] [] 0.005);
     connect ~ms:(ms - 5) path
 
-let request fd sexp = Wire.send fd sexp; Wire.parse (Wire.recv fd)
+(* The program's own output arrives on the replies, not on a file: the daemon
+   reads its stdout through a pipe so an editor can see it. Every reply is
+   drained into here, which is also what an editor does. *)
+let output = Buffer.create 256
+
+let request fd sexp =
+  let r = Wire.parse (Wire.send fd sexp; Wire.recv fd) in
+  (match Wire.string_field r "output" with
+   | Some t -> Buffer.add_string output t
+   | None -> ());
+  r
 
 let status r =
   match Wire.string_field r "status" with Some s -> s | None -> "<none>"
@@ -57,13 +67,20 @@ let () =
       (* The daemon owns the program's lifetime and kills it on [close], so
          every step waits for the program to have got there. "ok" from an eval
          means the module was queued, not that it has been installed. *)
-      let lines () =
-        List.length
-          (String.split_on_char '\n'
-             (In_channel.with_open_bin out In_channel.input_all))
-        - 1
-      in
       let c = connect sock in
+      (* The daemon owns the program's lifetime and kills it on [close], so
+         every step waits for the program to have got there. "ok" from an eval
+         means the module was queued, not that it has been installed. Output
+         only rides along with a reply, so asking is how it is collected, and
+         [describe] is the cheapest question there is. *)
+      let lines () =
+        List.length (String.split_on_char '\n' (Buffer.contents output)) - 1
+      in
+      let settle n =
+        await (fun () ->
+          ignore (request c "(:op \"describe\")");
+          lines () >= n)
+      in
 
       (* describe: what the daemon believes about the program it launched. *)
       let r = request c "(:op \"describe\")" in
@@ -91,8 +108,7 @@ let () =
          Both queued at once is a legitimate thing for the agent to do — one
          poll installs everything pending — but then only the last is observed
          and the sequencing is not what was tested. *)
-      if not (await (fun () -> lines () >= 2)) then
+      if not (settle 2) then fail "the first reload was never installed";
-        fail "the first reload was never installed";
       let r =
         request c
           "(:op \"eval\" :code \"(defn step [] i64 (set extra (+ extra 100)) extra)\" :file \"/tmp/buf.flan\")"
@@ -111,8 +127,7 @@ let () =
                | None -> false)
       then fail "retyping a global was not refused";
 
-      if not (await (fun () -> lines () >= 3)) then
+      if not (settle 3) then fail "the second reload was never installed";
-        fail "the second reload was never installed";
 
       (* Expression evaluation, which is a different primitive: no name to
          install a body into, so a thunk runs at a frame boundary and the value
@@ -127,7 +142,7 @@ let () =
          proof: 1 before any reload, 5 from a body over a var that did not
          exist when it started, 105 from a second body reading the same one. *)
       ignore (Unix.waitpid [] pid);
-      let text = In_channel.with_open_bin out In_channel.input_all in
+      let text = Buffer.contents output in
       if text <> "1\n5\n105\n" then
         fail "program transcript\n        got: %S\n     wanted: %S" text "1\n5\n105\n"
     end;

test/test_emacs.ml

@@ -29,7 +29,7 @@ let () =
     let flan = "../bin/main.exe" in
     let pid =
       Unix.create_process flan
-        [| flan; "dev"; "programs/dev-loop.flan"; "-s"; sock |]
+        [| flan; "dev"; "programs/dev-repl.flan"; "-s"; sock |]
         Unix.stdin fd Unix.stderr
     in
     Unix.close fd;
@@ -46,7 +46,7 @@ let () =
     (try Sys.remove buf with Sys_error _ -> ());
     ignore
       (Sys.command
-         (Printf.sprintf "cp %s %s" (Filename.quote "programs/dev-loop.flan")
+         (Printf.sprintf "cp %s %s" (Filename.quote "programs/dev-repl.flan")
             (Filename.quote buf)));
     (try Unix.chmod buf 0o644 with Unix.Unix_error _ -> ());
     let code =