diff --git a/NEXT.md b/NEXT.md index 14f5e55..d6ef962 100644 --- a/NEXT.md +++ b/NEXT.md @@ -32,6 +32,8 @@ reader ✅ → parse ✅ → load ✅ → check ✅ → emit ✅ → clang ✅ | `lib/tast.ml` | the typed IR the backend consumes | | `lib/check.ml` | AST → typed IR; two passes, bidirectional | | `lib/session.ml` | **a live program: what the process was built from, plus every change since** | +| `lib/wire.ml` | **the editor protocol: one s-expression per message, length framed** | +| `lib/dev.ml` | **`flan dev`: a session, the program running beside it, and a socket** | | `lib/prelude.ml` | printers + `rand-f32`, written in Flan | | `lib/emit.ml` | typed IR → LLVM IR text | | `lib/build.ml` | `.ll` + the shim + the packages' C → clang → executable | @@ -40,12 +42,13 @@ reader ✅ → parse ✅ → load ✅ → check ✅ → emit ✅ → clang ✅ | `vendor/raylib/` | **the raylib package: `raylib.flan`, `shim.c`, `link`** | | `vendor/agent/` | **the dev agent: a socket, a loader thread, install at a frame boundary** | | `sand-sim/` | **the falling-sand simulation, with no raylib in it** | -| `bin/main.ml` | `flan read \| parse \| check \| emit \| build \| run \| reload` | +| `bin/main.ml` | `flan read \| parse \| check \| emit \| build \| run \| reload \| dev` | | `test/test_flan.ml` | reader, parser and checker | | `test/test_acceptance.ml` | expression/result pairs + whole programs + the traps | | `test/test_reload.ml` | **the reload primitive: recompile one function, load it, call it** | | `test/test_agent.ml` | **a running program taking a redefinition over a socket** | | `test/test_session.ml` | **what a running process cannot be told, and recovering from a typo** | +| `test/test_dev.ml` | **the daemon, driven the way an editor drives it** | | `test/reload_host.c` | the C host that loads and installs two rebuilds, in one process | ``` @@ -566,22 +569,59 @@ And `Session.eval`'s `origin` defaults to ``, so an error in forms sent without one reports positions in a file that does not exist — the daemon has to pass the real buffer path, which is the same key CIDER's `eval` carries. +### The daemon — `flan dev` + +`flan dev ` holds one `Session`, builds the program, launches it, +and listens on `.flan-dev.sock` beside the source. What it adds over `flan +reload` is that the session *persists* — a `defvar` added by one evaluation is +part of what the next one is checked against — and that it **owns the build**, +which is what makes its layout rules describe the process that is actually +running rather than a guess about it. + +**The protocol is s-expressions, not bencode.** nREPL was the plan and the +argument for it evaporated once the client became ours too: there is no CIDER +to be compatible with, `eval` is string-in/string-out with no slot for *which +form, from which file*, and Emacs already has `read` and `prin1`. So it is one +sexp per message — no parsing code on the editor side, and on this side the +parser is the language's own reader, where `:op` is already a keyword and a +payload of Flan source is already a string literal. Framing is a decimal byte +count and a newline, because the payload contains newlines. An nREPL front end +can sit on the same `Session` later; it should not have gated the editor. + +``` +(:op "describe") → (:status "ok" :fns (…) :globals (…) :alive t) +(:op "eval" :code "…" :file "/buf.flan") → (:status "ok" :names (…) :fns (…) :ms 19.0) + → (:status "error" :message "…" :loc "/buf.flan:1:19") +(:op "close") +``` + +`:file` is not decoration: `Session.eval`'s origin defaults to ``, so +without it every error an editor shows points into a file that does not exist. + +Two things the daemon must not paper over, both of which would look like a +successful evaluation: + +- **The agent socket is chosen by the daemon**, not by the program. A program's + source has to name some path — sand.flan says `/tmp/flan-sand.sock` — and the + daemon overrides it through `FLAN_AGENT_SOCKET` before spawning. Guessing + instead fails silently: the module compiles, is built, and nobody receives + it. +- **Delivery is checked.** `agent/start` returning 0 means a socket was bound, + not that anyone connected. A failed connect or a reply that is not `ok` + becomes an error the editor sees. + +It waits for the program to bind before accepting an evaluation — one arriving +first would fail for a reason that reads like a compiler bug — and it accepts +with a timeout so that a program which has exited takes the daemon with it +rather than leaving an editor waiting on a socket nobody is serving. + ### What is left `C-c C-c` works end to end today; what is missing is the two hops between an editor and it. -- **The daemon.** One long-lived process holding one `Session` per program, - building the module and handing the path to the agent. Everything it needs - exists — `Session.eval` returns the IR, `Build.shared` makes the `.so`, one - line on a socket installs it. What it adds is a protocol, and nREPL is the - one to pick: bencode over a socket, a designed op set (`clone`, `describe`, - `eval`, `close`, `interrupt`), and no need to re-litigate session identity or - partial output. `eval` is string-in/string-out and does not describe *which - form, from which file*; that goes in the op's extra keys, as CIDER does. -- **The Emacs client**, ~3–5k lines, not a CIDER fork. Deliberately last: the - protocol is mechanical once the daemon exists, and the client is where the - taste is. +- **The Emacs client**, not a CIDER fork. Deliberately last: the protocol is + mechanical once the daemon exists, and the client is where the taste is. - **Expression eval** (`C-x C-e`) is a *different primitive* and is not built. Redefining a name installs a body; evaluating an expression means synthesizing a function around a form, calling it, and rendering the value. diff --git a/bin/main.ml b/bin/main.ml index ed97c8d..6c35efa 100644 --- a/bin/main.ml +++ b/bin/main.ml @@ -109,6 +109,20 @@ let () = ignore (Flan.Build.executable ~opts:{ Flan.Build.default with checks; dev } ~csrcs:l.csrcs ~lflags:l.lflags p ~out)) + (* The daemon an editor talks to: one session, the program it belongs to + running beside it, and a socket. Unlike [flan reload] the session persists, + so a defvar added by one evaluation is part of what the next one is checked + against — and it owns the build, which is what makes its layout rules + describe the process that is actually running. *) + | _ :: "dev" :: path :: rest -> + let sock = + match rest with + | [ "-s"; s ] -> s + | [] -> Filename.concat (Filename.dirname path) ".flan-dev.sock" + | _ -> prerr_endline "usage: flan dev [-s socket]"; exit 2 + in + with_errors path (fun () -> Flan.Dev.start ~file:path ~sock) + (* One redefinition, built the way an editor will ask for it: a session over the program the process was built from, and a file of the forms that changed. The session works out which names are new and whether the change @@ -151,5 +165,6 @@ let () = "usage: flan (read|parse|check|emit) ...\n\ \ flan build [-o out] [--no-bounds-checks] [--dev]\n\ \ flan run [args...]\n\ - \ flan reload [-o out.so]"; + \ flan reload [-o out.so]\n\ + \ flan dev [-s socket]"; exit 2 diff --git a/lib/dev.ml b/lib/dev.ml new file mode 100644 index 0000000..7ec30dd --- /dev/null +++ b/lib/dev.ml @@ -0,0 +1,211 @@ +(** [flan dev]: one long-lived session, the program it belongs to running + beside it, and a socket an editor talks to. + + This is the piece between an editor and everything else. What it adds over + [flan reload] is that the session *persists*: a [defvar] added by one + evaluation is part of the program the next one is checked against, and the + set of names the running process was built with is the one from the build + this daemon actually made. A CLI that rebuilds its session from source each + time cannot have either. + + It owns the build, which is what makes its layout rules mean anything: a + session's struct layouts and global types describe the memory of a process + only if it is the session that compiled it. So the daemon launches the + program rather than attaching to one. *) + +type t = { + session : Session.t; + child : int; (* the running program *) + agent : string; (* where it listens for modules *) + dir : string; (* modules are built here, one per eval *) + mutable n : int; (* dlopen caches by path: never reuse one *) +} + +let await ?(ms = 5000) f = + let rec go ms = + if f () then true + else if ms <= 0 then false + else begin ignore (Unix.select [] [] [] 0.005); go (ms - 5) end + in + go ms + +(* ── Delivery ──────────────────────────────────────────────────────── *) + +(* The agent answers "ok" when it has queued a module, and anything else is a + refusal with a reason. Reporting that back rather than swallowing it is what + keeps a failed delivery from looking like a successful evaluation — the + whole class of bug this socket makes possible. *) +let deliver t path = + let s = Unix.socket Unix.PF_UNIX Unix.SOCK_STREAM 0 in + Fun.protect + ~finally:(fun () -> try Unix.close s with Unix.Unix_error _ -> ()) + (fun () -> + Unix.connect s (Unix.ADDR_UNIX t.agent); + let msg = path ^ "\n" in + ignore (Unix.write_substring s msg 0 (String.length msg)); + let b = Bytes.create 1024 in + let buf = Buffer.create 64 in + let rec drain () = + match Unix.read s b 0 1024 with + | 0 -> () + | n -> Buffer.add_subbytes buf b 0 n; drain () + | exception Unix.Unix_error _ -> () + in + drain (); + String.trim (Buffer.contents buf)) + +let alive t = + match Unix.waitpid [ Unix.WNOHANG ] t.child with + | 0, _ -> true + | _ -> false + | exception Unix.Unix_error _ -> false + +(* ── Ops ───────────────────────────────────────────────────────────── *) + +(* Every reply is a plist with a :status, so an editor can dispatch on one key + and never has to guess whether a missing field means failure. *) +let ok fields = + "(:status \"ok\"" ^ String.concat "" (List.map (fun f -> " " ^ f) fields) ^ ")" + +let error ?loc msg = + "(:status \"error\" :message " ^ Wire.quote msg + ^ (match loc with None -> "" | Some l -> " :loc " ^ Wire.quote l) + ^ ")" + +let eval t ~code ~origin = + if not (alive t) then error "the program exited; restart flan dev" + else + match Session.eval ~origin t.session code with + | c -> + t.n <- t.n + 1; + let out = Filename.concat t.dir (Printf.sprintf "m%d.so" t.n) in + (match Build.shared ~opts:{ Build.default with Build.dev = true } + ~ir:c.Session.ir ~out () with + | timing -> + (match deliver t out with + | "ok" -> + ok + [ ":names " ^ Wire.strings c.Session.names; + ":fns " ^ Wire.strings c.Session.fns; + Printf.sprintf ":ms %.1f" + (timing.Build.llc_ms +. timing.Build.link_ms) ] + | reply -> error ("the program refused the module: " ^ reply) + | exception Unix.Unix_error (e, _, _) -> + error + ("cannot reach the program on " ^ t.agent ^ ": " + ^ Unix.error_message e)) + | exception Failure m -> error m) + | exception Loc.Error (l, msg) -> error ~loc:(Loc.to_string l) msg + +let describe t = + ok + [ ":fns " + ^ Wire.strings + (List.map (fun (f : Tast.fn) -> f.Tast.name) + t.session.Session.program.Tast.fns); + ":globals " + ^ Wire.strings + (List.map (fun (g : Tast.global) -> g.Tast.gname) + t.session.Session.program.Tast.globals); + ":alive " ^ (if alive t then "t" else "nil") ] + +let handle t req = + match Wire.string_field req "op" with + | Some "eval" -> + (match Wire.string_field req "code" with + | Some code -> + let origin = + match Wire.string_field req "file" with Some f -> f | None -> "" + in + eval t ~code ~origin + | None -> error "eval needs :code") + | Some "describe" -> describe t + | Some "close" -> ok [] + | Some op -> error ("unknown op: " ^ op) + | None -> error "no :op" + +(* ── The loop ──────────────────────────────────────────────────────── *) + +(* One connection at a time. An editor is one client, evaluations are + sequential by nature — each one is checked against the program the last one + left behind — and a second concurrent evaluation would be racing for the + same session anyway. *) +(* Returns whether the client asked to end the session. One editor per daemon, + so [close] shuts the whole thing down rather than waiting for another + connection nobody is going to make. *) +let serve t fd = + let rec go () = + match Wire.recv fd with + | src -> + let op, reply = + match Wire.parse src with + | req -> (Wire.string_field req "op", handle t req) + | exception Loc.Error (_, m) -> (None, error ("bad request: " ^ m)) + in + Wire.send fd reply; + if op = Some "close" then true else go () + | exception Wire.Closed -> false + | exception Unix.Unix_error _ -> false + in + go () + +let start ~file ~sock = + let t0 = Unix.gettimeofday () in + let session, l = Session.create ~file in + let dir = + Filename.concat (Filename.get_temp_dir_name ()) + (Printf.sprintf "flan-dev-%d" (Unix.getpid ())) + in + (try Unix.mkdir dir 0o700 with Unix.Unix_error (Unix.EEXIST, _, _) -> ()); + let exe = Filename.concat dir "program" in + ignore + (Build.executable ~opts:{ Build.default with Build.dev = true } + ~csrcs:l.Load.csrcs ~lflags:l.Load.lflags session.Session.host ~out:exe); + let agent = Filename.concat dir "agent.sock" in + + (* The program's source names some socket path; the daemon is the one that + knows where it wants to talk to it, so it overrides through the + 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 + + (* Wait for it to bind before accepting an evaluation. One that arrives first + would fail for a reason that reads like a compiler bug. *) + if not (await (fun () -> Sys.file_exists agent)) then begin + (try Unix.kill child Sys.sigterm with Unix.Unix_error _ -> ()); + failwith + ("the program never listened on " ^ agent + ^ " — does it call (agent/start ...)?") + end; + + let t = { session; child; agent; dir; 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); + Unix.listen ls 4; + Printf.eprintf "flan dev: %s ready on %s (%.0fms)\n%!" file sock + ((Unix.gettimeofday () -. t0) *. 1000.); + (* [accept] would block past the program's own exit, so it is waited on with + a timeout and the child checked each time round: a daemon whose program + has finished has nothing left to do, and an editor waiting on it would + wait forever. *) + let rec accept_loop () = + if alive t then + match Unix.select [ ls ] [] [] 0.2 with + | [], _, _ -> accept_loop () + | _ -> + (match Unix.accept ls with + | fd, _ -> + let closed = serve t fd in + (try Unix.close fd with Unix.Unix_error _ -> ()); + if not closed then accept_loop () + | exception Unix.Unix_error (Unix.EINTR, _, _) -> accept_loop ()) + | exception Unix.Unix_error (Unix.EINTR, _, _) -> accept_loop () + in + Fun.protect + ~finally:(fun () -> + (try Unix.kill child Sys.sigterm with Unix.Unix_error _ -> ()); + (try Unix.close ls with Unix.Unix_error _ -> ()); + (try Unix.unlink sock with Unix.Unix_error _ -> ())) + accept_loop diff --git a/lib/wire.ml b/lib/wire.ml new file mode 100644 index 0000000..d2d4b23 --- /dev/null +++ b/lib/wire.ml @@ -0,0 +1,95 @@ +(** The editor protocol: one s-expression per message, length framed. + + Not bencode and not nREPL, and the reason is that both ends are ours. There + is no CIDER to be compatible with, nREPL's [eval] is string-in/string-out + with no slot for *which form, from which file*, and Emacs already has + [read] and [prin1] — so a sexp protocol is no parsing code on that side and + a few lines here, where the reader that parses it is the language's own. + An nREPL server can be a second front end on the same [Session] later; it + should not gate the editor. + + Framing is a decimal byte count, a newline, then that many bytes. A message + carries Flan source, which contains newlines, so a line-oriented protocol + would need an escape layer that this does not. *) + +(* Elisp's [read] understands \\n and \\t but not OCaml's \\ddd, so this + escapes the two characters that must be escaped and passes everything else + through as itself. Both readers take a raw newline inside a string. *) +let quote s = + let b = Buffer.create (String.length s + 8) in + Buffer.add_char b '"'; + String.iter + (fun c -> + if c = '"' || c = '\\' then Buffer.add_char b '\\'; + Buffer.add_char b c) + s; + Buffer.add_char b '"'; + Buffer.contents b + +let list items = "(" ^ String.concat " " items ^ ")" +let strings ss = list (List.map quote ss) + +let send fd payload = + let framed = Printf.sprintf "%d\n%s" (String.length payload) payload in + let n = String.length framed in + let rec go i = + if i < n then + match Unix.write_substring fd framed i (n - i) with + | 0 -> () + | k -> go (i + k) + in + go 0 + +exception Closed + +let read_exactly fd n = + let b = Bytes.create n in + let rec go i = + if i = n then Bytes.to_string b + else + match Unix.read fd b i (n - i) with + | 0 -> raise Closed + | k -> go (i + k) + in + go 0 + +(* The header is short and read a byte at a time, which keeps the payload + boundary exact without a buffer that would have to be carried between + calls. *) +let recv fd = + let b = Bytes.create 1 in + let buf = Buffer.create 16 in + let rec header () = + match Unix.read fd b 0 1 with + | 0 -> raise Closed + | _ -> + if Bytes.get b 0 = '\n' then Buffer.contents buf + else begin Buffer.add_char buf (Bytes.get b 0); header () end + in + let n = + match int_of_string_opt (String.trim (header ())) with + | Some n when n >= 0 -> n + | _ -> raise Closed + in + read_exactly fd n + +(* A request is read by the language's own reader, so [:op] is a keyword and a + payload of Flan source is an ordinary string literal. *) +let field (form : Form.t) key = + let rec go = function + | { Form.v = Form.Kw k; _ } :: v :: rest -> + if String.equal k key then Some v else go rest + | _ :: rest -> go rest + | [] -> None + in + match form.Form.v with Form.List l -> go l | _ -> None + +let string_field form key = + match field form key with + | Some { Form.v = Form.Str s; _ } -> Some s + | _ -> None + +let parse src = + match Reader.read_all ~file:"" src with + | [ f ] -> f + | _ -> Loc.fail Loc.unknown "one form per message" diff --git a/test/dune b/test/dune index a9242b5..6242eb5 100644 --- a/test/dune +++ b/test/dune @@ -1,5 +1,5 @@ (tests - (names test_flan test_acceptance test_reload test_agent test_session) + (names test_flan test_acceptance test_reload test_agent test_session test_dev) (libraries flan unix) ; The acceptance programs are part of the test corpus: if the reader, the ; parser or the checker regresses on them we want to know here, not at the CLI. @@ -14,4 +14,6 @@ (glob_files %{workspace_root}/vendor/agent/*) (glob_files programs/*.flan) ; The reload primitive's host: a C main that dlopens what Build.shared made. - (file reload_host.c))) + (file reload_host.c) + ; test_dev runs the compiler itself: flan dev launches and owns a program. + (file %{workspace_root}/bin/main.exe))) diff --git a/test/programs/dev-loop.flan b/test/programs/dev-loop.flan new file mode 100644 index 0000000..d86c34f --- /dev/null +++ b/test/programs/dev-loop.flan @@ -0,0 +1,19 @@ +;;;; What [flan dev] launches: a program with a loop, a function to redefine, +;;;; and a way to stop. The daemon overrides the socket path through the +;;;; environment, so the one written here is only what it falls back to. +(import agent "vendor:agent") + +(defvar ticks i64) + +(defn step [] i64 + (set ticks (+ ticks 1)) + ticks) + +(defn main [] i32 + (agent/start "/tmp/flan-dev-fallback.sock") + (print-i64 (step)) (newline) + (while (= (agent/wait 100) 0) 0) + (print-i64 (step)) (newline) + (while (= (agent/wait 100) 0) 0) + (print-i64 (step)) (newline) + 0) diff --git a/test/test_dev.ml b/test/test_dev.ml new file mode 100644 index 0000000..ac6a39b --- /dev/null +++ b/test/test_dev.ml @@ -0,0 +1,133 @@ +(* [flan dev]: the daemon an editor talks to (NEXT.md, the dev loop). + + What it adds over [flan reload] is that the session persists between + evaluations and that the daemon owns the build, so its idea of the running + process is not a guess. Both are tested here by sending a sequence: a name + the program was never built with, then a second evaluation that uses it. If + the session were rebuilt per request the second one would not even check. *) + +open Flan + +let failures = ref 0 +let fail fmt = Printf.ksprintf (fun s -> incr failures; print_endline ("FAIL " ^ s)) fmt + +let scratch = Filename.get_temp_dir_name () +let tmp n = Filename.concat scratch ("flan-devtest-" ^ n) + +let rec await ?(ms = 5000) f = + if f () then true + else if ms <= 0 then false + else begin ignore (Unix.select [] [] [] 0.005); await ~ms:(ms - 5) f end + +let rec connect ?(ms = 5000) path = + let s = Unix.socket Unix.PF_UNIX Unix.SOCK_STREAM 0 in + match Unix.connect s (Unix.ADDR_UNIX path) with + | () -> s + | exception Unix.Unix_error (_, _, _) when ms > 0 -> + Unix.close s; + ignore (Unix.select [] [] [] 0.005); + connect ~ms:(ms - 5) path + +let request fd sexp = Wire.send fd sexp; Wire.parse (Wire.recv fd) + +let status r = + match Wire.string_field r "status" with Some s -> s | None -> "" + +let () = + match Sys.command "command -v clang > /dev/null 2>&1 && command -v llc > /dev/null 2>&1" with + | 0 -> + let sock = tmp "dev.sock" in + let out = tmp "prog.out" in + (try Sys.remove sock with Sys_error _ -> ()); + let fd = Unix.openfile out [ Unix.O_WRONLY; Unix.O_CREAT; Unix.O_TRUNC ] 0o600 in + (* The daemon is run as a subprocess rather than in-process because that is + how an editor meets it, and because it launches and owns a program of + its own. Its child's stdout is what we read the result off. *) + let flan = "../bin/main.exe" in + let pid = + Unix.create_process flan + [| flan; "dev"; "programs/dev-loop.flan"; "-s"; sock |] + Unix.stdin fd Unix.stderr + in + Unix.close fd; + + if not (await (fun () -> Sys.file_exists sock)) then + fail "the daemon never listened" + else begin + (* 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 + + (* describe: what the daemon believes about the program it launched. *) + let r = request c "(:op \"describe\")" in + if status r <> "ok" then fail "describe: %s" (status r); + + (* A form that does not check comes back as an error with a location, + and must not disturb the session. *) + let r = request c "(:op \"eval\" :code \"(defn step [] i64 nonsense)\" :file \"/tmp/buf.flan\")" in + if status r <> "error" then fail "a bad form was accepted"; + (match Wire.string_field r "loc" with + | Some l when String.length l > 0 -> () + | _ -> fail "an error carried no location"); + + (* A name the program was never built with, then a second evaluation + that uses it. The second one only checks at all because the session + kept the first. *) + let r = + request c + "(:op \"eval\" :code \"(defvar extra i64) (defn step [] i64 (set extra (+ extra 5)) extra)\" :file \"/tmp/buf.flan\")" + in + if status r <> "ok" then + fail "adding a var: %s" + (Option.value ~default:"" (Wire.string_field r "message")); + (* Wait for the program to have installed it before sending the next. + 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"; + let r = + request c + "(:op \"eval\" :code \"(defn step [] i64 (set extra (+ extra 100)) extra)\" :file \"/tmp/buf.flan\")" + in + if status r <> "ok" then + fail "reusing a var added earlier: %s" + (Option.value ~default:"" (Wire.string_field r "message")); + + (* A change the running process cannot be told, refused with the reason + rather than delivered. *) + let r = request c "(:op \"eval\" :code \"(defvar ticks i32)\" :file \"/tmp/buf.flan\")" in + if status r <> "error" + || not + (match Wire.string_field r "message" with + | Some m -> String.length m > 0 + | None -> false) + then fail "retyping a global was not refused"; + + if not (await (fun () -> lines () >= 3)) then + fail "the second reload was never installed"; + ignore (request c "(:op \"close\")"); + Unix.close c; + (* Closing the connection ends the program, and its transcript is the + 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 + if text <> "1\n5\n105\n" then + fail "program transcript\n got: %S\n wanted: %S" text "1\n5\n105\n" + end; + + List.iter (fun f -> try Sys.remove f with Sys_error _ -> ()) [ sock; out ]; + if !failures = 0 then print_endline "dev: all tests passed" + else begin + Printf.printf "\n%d failure(s)\n" !failures; + exit 1 + end + | _ -> print_endline "dev: skipped (no clang or llc on PATH)" diff --git a/vendor/agent/flan_agent.c b/vendor/agent/flan_agent.c index 41b27c5..a01cb92 100644 --- a/vendor/agent/flan_agent.c +++ b/vendor/agent/flan_agent.c @@ -27,6 +27,7 @@ #include #include +#include #include #include #include @@ -150,10 +151,21 @@ static void *accept_loop(void *arg) { } } -/* [path] is a Flan string: ptr and len, not NUL-terminated. */ +/* [path] is a Flan string: ptr and len, not NUL-terminated. + * + * FLAN_AGENT_SOCKET overrides it. A program's source has to name some path, + * and the daemon that launches the program is the one that knows where it + * wants to talk to it — without the override the daemon would have to guess, + * and guessing wrong fails silently: everything compiles, the module is built, + * and nothing ever receives it. */ int32_t flan_agent_start(const uint8_t *path, int64_t len) { struct sockaddr_un addr; + const char *env = getenv("FLAN_AGENT_SOCKET"); if (atomic_exchange(&started, 1)) return 0; + if (env != NULL && env[0] != '\0') { + path = (const uint8_t *)env; + len = (int64_t)strlen(env); + } if (len <= 0 || (size_t)len >= sizeof addr.sun_path) return -1; memset(&addr, 0, sizeof addr); addr.sun_family = AF_UNIX;