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

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

Browse Source 
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.
This commit is contained in:
Joseph Ferano 2026-09-11 07:05:50 +07:00
parent 335e817676
commit 8a94f16acd
8 changed files with 146 additions and 22 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

11
NEXT.md
View File

@ -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

33
emacs/flan-dev.el
View File

@ -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)))
(flan-dev--send proc form)
(flan-dev--read-reply proc)))
(let* ((proc (flan-dev--live-connection))
(reply (progn (flan-dev--send proc form)
(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)

2
emacs/flan-mode.el
View File

@ -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'.")

10
emacs/test-flan-dev.el
View File

@ -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)))

67
lib/dev.ml
View File

@ -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

2
test/programs/dev-repl.flan
View File

@ -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

39
test/test_dev.ml
View File

@ -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
fail "the first reload was never installed";
if not (settle 2) then 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
fail "the second reload was never installed";
if not (settle 3) then 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;

4
test/test_emacs.ml
View File

@ -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 =