From 7ce1d09900d12b635d3e01a061d8aec9ecc458a1 Mon Sep 17 00:00:00 2001 From: Joseph Ferano Date: Fri, 11 Sep 2026 07:00:58 +0700 Subject: [PATCH] C-x C-e: an expression, evaluated inside the running program A different primitive from redefining a name. There is no name to install a body into, so the expression is wrapped in a function with nowhere to be called from; the module exports flan_reload_call to say "run this once", and the agent calls it after the install - on the game thread, at a frame boundary, so an expression that reads the program's state sees a point the program agrees is consistent. Nothing is marshalled back because nothing could be. A Flan value carries no header, so no code at run time can say what it is; the compiler knows the type and renders it there, in the thunk. That is the layout decision's bill, and it is why the printer set is the scalars rather than everything. The rendering does not go through stdout. Stdout belongs to the program, it is in the hot path for anything that prints, and a dev-only feature must not put a branch in it - so flan_rt.c is untouched and the value goes to flan_dev_result, read back over the agent's socket. Safe without a handshake because the generation counter is bumped last: the daemon waits for it to move rather than assuming the program has reached a frame boundary. u64 refuses by name, because i64->bytes is signed and anything past 2^63 would come back negative. Everything without a derived printer refuses the same way. A number that is quietly wrong is the failure this whole thing exists to prevent. An evaluation is not a declaration: the thunk is built against the program and never spliced into it, so describe does not fill up with an eval/N for every expression ever typed. The test that matters is the same expression twice. The fixture increments ticks every frame, so two evaluations must disagree - a value computed in the compiler, or read from a copy of the program's state, would not. --- NEXT.md | 59 ++++++++++++---- emacs/flan-dev.el | 32 +++++++-- emacs/flan-mode.el | 2 + lib/check.ml | 25 +++++-- lib/dev.ml | 79 +++++++++++++++++++++ lib/emit.ml | 15 +++- lib/session.ml | 94 ++++++++++++++++++++++++- runtime/flan_dev.c | 33 +++++++++ test/dune | 2 +- test/programs/dev-repl.flan | 21 ++++++ test/test_dev.ml | 8 +++ test/test_repl.ml | 137 ++++++++++++++++++++++++++++++++++++ vendor/agent/flan_agent.c | 43 +++++++++-- 13 files changed, 515 insertions(+), 35 deletions(-) create mode 100644 test/programs/dev-repl.flan create mode 100644 test/test_repl.ml diff --git a/NEXT.md b/NEXT.md index 95694dc..16d4172 100644 --- a/NEXT.md +++ b/NEXT.md @@ -55,6 +55,7 @@ reader ✅ → parse ✅ → load ✅ → check ✅ → emit ✅ → clang ✅ | `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/test_repl.ml` | **`C-x C-e`: an expression evaluated inside a running program** | | `test/test_emacs.ml` | **the client, driven against a real daemon and a real program** | | `test/reload_host.c` | the C host that loads and installs two rebuilds, in one process | @@ -674,6 +675,7 @@ of the protocol choice: `prin1` writes a request and `read` reads a reply. |---|---| | `C-c C-c` | the top-level form at point, recompiled and installed | | `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-d` | what the running program currently defines | @@ -693,20 +695,51 @@ 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. +### `C-x C-e` — evaluating an expression + +A different primitive from redefining a name, and the difference is the whole +design. There is no name to install a body into, so the expression is wrapped +in a function with nowhere to be called from; the module says *run this once* +by exporting `flan_reload_call`, and the agent calls it after the install — on +the game thread, at a frame boundary, so an expression reading the program's +state sees a point the program agrees is consistent. + +**Nothing is marshalled back, because nothing could be.** A Flan value carries +no header, so no code at run time can say what it is. The compiler knows the +type and renders it *there*, in the thunk, into `flan_dev_result`. That is the +layout decision's bill, and it is why the printer set is small rather than +universal. + +It does not go through stdout. Stdout belongs to the program, it is in the hot +path for anything that prints, and a dev-only feature must not put a branch in +it — so `flan_rt.c` is untouched and the value is read back over the agent's +socket. The read is safe without a handshake because `flan_dev_result` bumps a +generation counter last; the daemon waits for it to move rather than assuming +the program has reached a frame boundary. + +What renders: the integers, the floats, `bool`, `string`, `[u8]`, `Unit`, and +an enum (as its number — enum members are erased to `i32` before the backend +sees them). What refuses, by name: everything else, and **`u64` specifically**, +because `i64->bytes` is signed and anything past 2⁶³ would come back negative. +Refusing beats a number that is quietly wrong. + +A caveat inherited from the language, not introduced here: `3.0` renders as +`3`, indistinguishable from the integer. `flan run calc-me.flan "1.5 * 2.0"` +has always said `3`. + +An evaluation is **not** a declaration: the thunk is built against the program +and never spliced into it, so `describe` does not fill up with `eval/N` for +every expression ever typed. + +The test that matters is the same expression twice: the fixture increments +`ticks` every frame, so two evaluations must disagree. A value computed in the +compiler, or read out of a copy of the program's state, would not. + ### What is left -- **A REPL buffer.** There is no `C-c C-z`-to-a-prompt, because there is - nothing to type into it until expression eval exists. -- **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. - It needs no cells — wrap, compile as a redefinition module, `dlsym`, call — - so it is not downstream of any of the above. The open question is the value: - the compiler knows the type, so emit the print call into the thunk and - capture the output rather than marshalling anything. The prelude prints - `i64`, `f64`, bytes and strings, and nothing else; a struct, an `(Option T)` - or a slice of structs has no printer. Either derive one per type in the - checker or restrict v1 to scalars and say so. That choice is the difference - between eval feeling like Lisp and feeling like gdb. +- **A REPL buffer.** `C-x C-e` echoes into the minibuffer; there is no prompt + to type at and no history. +- **Printers beyond the scalars.** See below — a struct, an `(Option T)` or a + slice of structs still refuses by name. **Session identity is the daemon that owns the build.** A session's struct layouts and global types have to describe the memory of the process it is diff --git a/emacs/flan-dev.el b/emacs/flan-dev.el index 4d472eb..065fa67 100644 --- a/emacs/flan-dev.el +++ b/emacs/flan-dev.el @@ -12,10 +12,13 @@ ;; The protocol is one s-expression per message, length framed. That is why ;; there is no parser here: `prin1' writes a request and `read' reads a reply. ;; -;; Not implemented, because it does not exist on the other side: evaluating an -;; expression. Redefining a name installs a body; evaluating an expression -;; means synthesising a function around a form, calling it, and rendering the -;; value, which is a different primitive. +;; C-x C-e evaluates the expression before point *in the running program* and +;; shows its value. That is a different primitive from redefining a name: +;; there is nothing to install a body into, so the expression is wrapped in a +;; thunk the program runs at its next frame boundary. Only scalars, bool and +;; strings render so far — a Flan value carries no header, so a printer has to +;; be derived per type at compile time, and the ones that are not derived yet +;; say so rather than guessing. ;;; Code: @@ -150,8 +153,13 @@ With no argument, look for `flan-dev-socket-name' up from this buffer." (if (equal (plist-get reply :status) "ok") (let ((fns (plist-get reply :fns)) (names (plist-get reply :names)) - (note (plist-get reply :note))) + (note (plist-get reply :note)) + (value (plist-get reply :value))) (when flan-dev-echo-result + (if value + ;; An expression's value, rendered inside the running program — + ;; nothing was marshalled back, because nothing could be. + (message "=> %s" value) (if note ;; The daemon accepted it and had nothing to send. Say so rather ;; than claiming an install that did not happen. @@ -159,7 +167,7 @@ With no argument, look for `flan-dev-socket-name' up from this buffer." (message "%s installed in %.0fms" (if fns (string-join fns ", ") (if names (string-join names ", ") what)) - (or (plist-get reply :ms) 0))))) + (or (plist-get reply :ms) 0)))))) ;; The daemon reports where, so put point there when it is this buffer. (let ((loc (plist-get reply :loc)) (msg (plist-get reply :message))) @@ -205,6 +213,18 @@ arrive in the same load or the first refers to storage that does not exist." (flan-dev--eval (buffer-substring-no-properties (point-min) (point-max)) (buffer-name))) +;;;###autoload +(defun flan-eval-last-sexp () + "Evaluate the expression before point in the running program and show it." + (interactive) + (let ((code (buffer-substring-no-properties + (save-excursion (backward-sexp) (point)) + (point)))) + (flan-dev--report + (flan-dev--request + (list :op "eval-expr" :code code :file (or buffer-file-name ""))) + "expression"))) + ;;;###autoload (defun flan-eval-region (start end) "Recompile the top-level forms between START and END." diff --git a/emacs/flan-mode.el b/emacs/flan-mode.el index 3180b9f..8e2156d 100644 --- a/emacs/flan-mode.el +++ b/emacs/flan-mode.el @@ -13,6 +13,7 @@ ;; may well edit Flan without ever connecting to a running program. (declare-function flan-eval-defun "flan-dev") (declare-function flan-eval-buffer "flan-dev") +(declare-function flan-eval-last-sexp "flan-dev") (declare-function flan-connect "flan-dev") (declare-function flan-disconnect "flan-dev") (declare-function flan-describe "flan-dev") @@ -71,6 +72,7 @@ ;; Autoloaded from flan-dev.el, so the client loads on first use. (define-key map (kbd "C-c C-c") #'flan-eval-defun) (define-key map (kbd "C-c C-k") #'flan-eval-buffer) + (define-key map (kbd "C-x C-e") #'flan-eval-last-sexp) (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) diff --git a/lib/check.ml b/lib/check.ml index 4cf4ad8..b598707 100644 --- a/lib/check.ml +++ b/lib/check.ml @@ -1309,7 +1309,11 @@ let check_main env = fail Loc.unknown "main returns i32 or nothing, not %s" (Types.to_string ret) -let program (decls : Ast.decl list) : Tast.program = +(* The environment as well as the program. A session needs it to check an + expression typed at a REPL against the program the process is running — and + it has to be this one rather than anything rebuilt from declarations, + because [program] prepends the prelude and no accumulated AST contains it. *) +let program_with_env (decls : Ast.decl list) : Tast.program * env = let env = new_env () in let decls = Parse.program (Prelude.forms ()) @ decls in collect env decls; @@ -1338,6 +1342,19 @@ let program (decls : Ast.decl list) : Tast.program = env.externs [] |> List.sort (fun (a : Tast.extern) b -> String.compare a.Tast.esym b.Tast.esym) in - { Tast.structs = values (fun (s : Tast.structure) -> s.Tast.sname) env.structs; - unions = values (fun (u : Tast.union) -> u.Tast.uname) env.unions; - globals; externs; fns } + ({ Tast.structs = values (fun (s : Tast.structure) -> s.Tast.sname) env.structs; + unions = values (fun (u : Tast.union) -> u.Tast.uname) env.unions; + globals; externs; fns }, + env) + +let program (decls : Ast.decl list) : Tast.program = fst (program_with_env decls) + +(* One expression, checked against a program that is already running. The + frame is empty — a REPL expression has no parameters and no enclosing + function — so the slots it needs are whatever its own [let]s allocate. *) +let expression env (e : Ast.expr) : Tast.expr * Types.t array = + let ctx = + { env; ret = Types.Unit; slots = 0; slot_tys = []; scope = []; defers = [] } + in + let t = check ctx e in + (t, Array.of_list (List.rev ctx.slot_tys)) diff --git a/lib/dev.ml b/lib/dev.ml index dcda915..e7bc3ce 100644 --- a/lib/dev.ml +++ b/lib/dev.ml @@ -54,6 +54,40 @@ let deliver t path = drain (); String.trim (Buffer.contents buf)) +(* Read back the value of the last expression evaluated, with the counter that + says whether it is a new one. The thunk runs on the game thread whenever the + program next reaches a frame boundary, which is not a moment the daemon gets + to know about, so this waits for the counter to move rather than assuming it + has. *) +let result t = + 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); + ignore (Unix.write_substring s "result\n" 0 7); + let b = Bytes.create 4096 in + let buf = Buffer.create 256 in + let rec drain () = + match Unix.read s b 0 4096 with + | 0 -> () + | n -> Buffer.add_subbytes buf b 0 n; drain () + | exception Unix.Unix_error _ -> () + in + drain (); + let text = Buffer.contents buf in + match String.index_opt text '\n' with + | None -> None + | Some i -> + let header = String.sub text 0 i in + let body = String.sub text (i + 1) (String.length text - i - 1) in + (match String.split_on_char ' ' header with + | [ g; _ ] -> + (match Int64.of_string_opt g with + | Some g -> Some (g, body) + | None -> None) + | _ -> None)) + let alive t = match Unix.waitpid [ Unix.WNOHANG ] t.child with | 0, _ -> true @@ -105,6 +139,43 @@ let eval t ~code ~origin = | exception Failure m -> error m) | exception Loc.Error (l, msg) -> error ~loc:(Loc.to_string l) msg +(* Redefining a name installs a body; evaluating an expression has no name to + install into, so the module carries a thunk the agent runs once. The value + comes back through the runtime rather than through this reply, because the + frame boundary it runs at is the program's to choose. *) +let eval_expr t ~code ~origin = + if not (alive t) then error "the program exited; restart flan dev" + else + match Session.eval_expr ~origin t.session code with + | c -> + let before = match result t with Some (g, _) -> g | None -> 0L in + t.n <- t.n + 1; + let out = Filename.concat t.dir (Printf.sprintf "e%d.so" t.n) in + (match Build.shared ~opts:{ Build.default with Build.dev = true } + ~ir:c.Session.ir ~out () with + | _ -> + (match deliver t out with + | "ok" -> + let rec wait ms = + match result t with + | Some (g, v) when Int64.compare g before > 0 -> Some v + | _ when ms <= 0 -> None + | _ -> + ignore (Unix.select [] [] [] 0.005); + if alive t then wait (ms - 5) else None + in + (match wait 5000 with + | Some v -> ok [ ":value " ^ Wire.quote v ] + | None -> + error + "the program did not reach a frame boundary; is it calling \ + (agent/poll)?") + | reply -> error ("the program refused the module: " ^ reply) + | exception Unix.Unix_error (e, _, _) -> + error ("cannot reach the program: " ^ 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 " @@ -127,6 +198,14 @@ let handle t req = in eval t ~code ~origin | None -> error "eval needs :code") + | Some "eval-expr" -> + (match Wire.string_field req "code" with + | Some code -> + let origin = + match Wire.string_field req "file" with Some f -> f | None -> "" + in + eval_expr t ~code ~origin + | None -> error "eval-expr needs :code") | Some "describe" -> describe t | Some "close" -> ok [] | Some op -> error ("unknown op: " ^ op) diff --git a/lib/emit.ml b/lib/emit.ml index d57bc45..5d1a686 100644 --- a/lib/emit.ml +++ b/lib/emit.ml @@ -992,7 +992,7 @@ let program ?(checks = true) ?(dev = false) (p : Tast.program) : string = String literals still have to come along: they are this module's own constants, and omitting them is an undefined [@.str.N] at link time. *) let redefinition ?(checks = true) ?(dev = false) ?(known = fun _ -> true) - (p : Tast.program) ~fns : string = + ?call (p : Tast.program) ~fns : string = let target name = match List.find_opt (fun (f : Tast.fn) -> f.Tast.name = name) p.Tast.fns with | Some f -> f @@ -1101,6 +1101,17 @@ let redefinition ?(checks = true) ?(dev = false) ?(known = fun _ -> true) targets; Buffer.add_string m.out (Printf.sprintf "\ndefine void @flan_reload_install() {\nentry:\n%s ret void\n}\n" - (Buffer.contents b)) + (Buffer.contents b)); + (* An expression evaluation compiles to a function with nowhere to be + called from, so the module says so and the agent runs it once — after + the install, on the game thread, so it sees both the bodies this module + just published and a program state the program agrees is consistent. *) + match call with + | Some fn -> + Buffer.add_string m.out + (Printf.sprintf + "\ndefine void @flan_reload_call() {\nentry:\n call %s %s()\n \ + ret void\n}\n" (ll Types.Unit) (fname fn)) + | None -> () end; finish m diff --git a/lib/session.ml b/lib/session.ml index 03b16d7..3ed97f8 100644 --- a/lib/session.ml +++ b/lib/session.ml @@ -32,8 +32,10 @@ type t = { file : string; (* resolves an import's relative path *) mutable decls : Ast.decl list; (* post-Load: flat, one namespace *) mutable program : Tast.program; (* the last thing that checked *) + mutable env : Check.env; (* the same, as the checker sees it *) host : Tast.program; (* what the process was built from *) pkgs : Load.pkg list; (* alias, directory, names owned *) + mutable thunks : int; (* expression evaluations so far *) } let fail = Loc.fail @@ -59,8 +61,9 @@ let rec same_const (a : Tast.expr) (b : Tast.expr) = let create ~file = let l = Load.program ~file (Parse.program (Reader.read_file file)) in - let p = Check.program l.Load.decls in - ({ file; decls = l.Load.decls; program = p; host = p; pkgs = l.Load.pkgs }, l) + let p, env = Check.program_with_env l.Load.decls in + ({ file; decls = l.Load.decls; program = p; env; host = p; pkgs = l.Load.pkgs; + thunks = 0 }, l) (* Which package a file being edited belongs to, if any. @@ -296,7 +299,7 @@ let eval ?(origin = "") t src : change = let decls = kept @ added in (* Nothing above this line has changed the session. A [Loc.Error] from here leaves it exactly as it was. *) - let program = Check.program decls in + let program, env = Check.program_with_env decls in compatible ~loc t.program program; compatible_enums ~loc t.decls decls; let fns = @@ -315,4 +318,89 @@ let eval ?(origin = "") t src : change = in t.decls <- decls; t.program <- program; + t.env <- env; { ir; names; fns; installs = fns <> [] || allocates } + +(* ── Evaluating an expression ──────────────────────────────────────── *) + +(* [C-x C-e] is a different primitive from redefining a name, and this is where + the difference lives: there is no name to install a body into, so the + expression is wrapped in a function that has nowhere to be called from, and + the module says "run this once". The agent does, at a frame boundary. + + Getting the value back does not marshal anything. The compiler knows the + expression's type, so the thunk renders it to bytes here, at compile time, + and hands them to the runtime — which is the only thing that *can* work, + since a Flan value carries no header and nothing at run time could tell what + it is. That is the layout decision's bill, paid here. + + The rendering goes to [flan_dev_result], not to stdout: stdout belongs to + the program, it is in the hot path for anything that prints, and a dev-only + feature must not put a branch in it. *) + +let result_sym = "flan/dev-result" + +let result_extern : Tast.extern = + { Tast.ename = result_sym; esym = "flan_dev_result"; + eparams = [ Types.Slice (Types.Int Types.U8) ]; eret = Types.Unit } + +(* The scalars, and nothing else yet. A struct, an (Option T) or a slice of + structs needs a printer derived per type, which is real work; refusing by + name is the house rule, and a wrong rendering would be the silent kind. *) +let render (e : Tast.expr) : Tast.expr = + let loc = e.Tast.loc in + let bytes = Types.Slice (Types.Int Types.U8) in + let cast t x = { Tast.e = Tast.Prim (Tast.Cast t, [ x ]); ty = t; loc } in + let prim p x = { Tast.e = Tast.Prim (p, [ x ]); ty = bytes; loc } in + let str s = { Tast.e = Tast.Str s; ty = Types.String; loc } in + match e.Tast.ty with + | Types.Int Types.U64 -> + (* i64->bytes is signed, so anything above 2^63 would render negative. + Refusing beats a number that is quietly wrong. *) + fail loc "no printer for u64 yet — its rendering would be signed" + | Types.Int _ -> prim Tast.I64ToBytes (cast (Types.Int Types.I64) e) + | Types.Enum _ -> + (* An enum is an i32 at run time and its members are not carried into the + backend, so this is the number and not the name. *) + prim Tast.I64ToBytes (cast (Types.Int Types.I64) e) + | Types.Float _ -> prim Tast.F64ToBytes (cast (Types.Float Types.F64) e) + | Types.Bool -> + { Tast.e = Tast.If (e, prim Tast.Bytes (str "true"), prim Tast.Bytes (str "false")); + ty = bytes; loc } + | Types.String -> prim Tast.Bytes e + | Types.Slice (Types.Int Types.U8) -> e + | Types.Unit -> prim Tast.Bytes (str "()") + | t -> + fail loc "no printer for %s yet — only the scalars, bool and strings render" + (Types.to_string t) + +let eval_expr ?(origin = "") t src : change = + let form = + match Reader.read_all ~file:origin src with + | [ f ] -> f + | [] -> fail Loc.unknown "nothing to evaluate" + | _ :: f :: _ -> fail f.Form.loc "one expression at a time" + in + let checked, slots = Check.expression t.env (Parse.expr form) in + let body = + [ { Tast.e = Tast.Call (result_sym, [ render checked ]); + ty = Types.Unit; loc = checked.Tast.loc } ] + in + t.thunks <- t.thunks + 1; + let name = Printf.sprintf "eval/%d" t.thunks in + let thunk : Tast.fn = + { Tast.name; params = []; slots; ret = Types.Unit; body; + floc = checked.Tast.loc } + in + (* Built against the program but never spliced into it: an evaluation is not + a declaration, and adding one would leave the session carrying an eval/N + for every expression ever typed. *) + let program = + { t.program with + Tast.fns = t.program.Tast.fns @ [ thunk ]; + externs = t.program.Tast.externs @ [ result_extern ] } + in + let ir = + Emit.redefinition ~dev:true ~known:(known t) ~call:name program ~fns:[ name ] + in + { ir; names = []; fns = []; installs = true } diff --git a/runtime/flan_dev.c b/runtime/flan_dev.c index 91eed03..6a0e51f 100644 --- a/runtime/flan_dev.c +++ b/runtime/flan_dev.c @@ -12,6 +12,8 @@ * * flan_dev_cell(name) the cell a new function lives in * flan_dev_global(name, size, init) the storage a new global lives in + * flan_dev_result(bytes, len) where an evaluated expression's rendering + * goes, for the daemon to read back * * Both are idempotent: the second module to mention a name gets what the first * one got. That is the whole point. Two modules that each define their own @@ -101,3 +103,34 @@ void *flan_dev_global(const char *name, uint64_t size, const void *init) { if (e->size != (size_t)size) die("size changed; restart to retype", name); return e->cell; } + +/* ── The value of an evaluated expression ──────────────────────────── */ + +/* C-x C-e compiles a thunk that renders one expression and calls this with the + * text. It is not written to stdout: stdout belongs to the program, it is in + * the hot path for anything that prints, and a dev-only feature must not put a + * branch in it. The daemon reads this back over the agent's socket instead. + * + * [generation] is what makes the read safe without a handshake. The thunk runs + * on the game thread at a frame boundary, whenever that happens to be; the + * daemon waits for the counter to move rather than guessing it has. */ + +#define RESULT_MAX 4096 +static char result[RESULT_MAX]; +static size_t result_len; +static uint64_t generation; + +void flan_dev_result(const uint8_t *bytes, int64_t len) { + size_t n = len < 0 ? 0 : (size_t)len; + if (n > RESULT_MAX) n = RESULT_MAX; + memcpy(result, bytes, n); + result_len = n; + /* Last, so a reader that sees the new generation sees the whole value. */ + __atomic_store_n(&generation, generation + 1, __ATOMIC_RELEASE); +} + +const char *flan_dev_result_get(uint64_t *gen, uint64_t *len) { + *gen = __atomic_load_n(&generation, __ATOMIC_ACQUIRE); + *len = (uint64_t)result_len; + return result; +} diff --git a/test/dune b/test/dune index 6141837..6830b44 100644 --- a/test/dune +++ b/test/dune @@ -1,5 +1,5 @@ (tests - (names test_flan test_acceptance test_reload test_agent test_session test_dev test_emacs) + (names test_flan test_acceptance test_reload test_agent test_session test_dev test_emacs test_repl) (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. diff --git a/test/programs/dev-repl.flan b/test/programs/dev-repl.flan new file mode 100644 index 0000000..6813383 --- /dev/null +++ b/test/programs/dev-repl.flan @@ -0,0 +1,21 @@ +;;;; A program that just runs, for evaluating expressions against. +;;;; +;;;; Unlike dev-loop.flan it does not count reloads and stop: C-x C-e is a +;;;; thunk the agent runs at a frame boundary, so a program under test has to +;;;; keep reaching them. (agent/wait 5) is both the poll and the pacing — 5ms +;;;; of nothing, which is what a frame is when there is no frame. +(import agent "vendor:agent") + +(defvar ticks i64) +(defconst step-by i64 3) + +(defn step [] i64 + (set ticks (+ ticks step-by)) + ticks) + +(defn main [] i32 + (agent/start "/tmp/flan-dev-repl-fallback.sock") + (dotimes [i 4000] + (agent/wait 5) + (set ticks (step))) + 0) diff --git a/test/test_dev.ml b/test/test_dev.ml index ac6a39b..1383a69 100644 --- a/test/test_dev.ml +++ b/test/test_dev.ml @@ -113,6 +113,14 @@ let () = if not (await (fun () -> lines () >= 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 + comes back rendered. The program has stopped reaching frame boundaries + by now, so this only checks that the types that have no printer say so + rather than guessing — the live path is test_repl. *) + let r = request c "(:op \"eval-expr\" :code \"(defvar x i64)\" :file \"/tmp/buf.flan\")" in + if status r <> "error" then fail "a declaration was accepted as an expression"; ignore (request c "(:op \"close\")"); Unix.close c; (* Closing the connection ends the program, and its transcript is the diff --git a/test/test_repl.ml b/test/test_repl.ml new file mode 100644 index 0000000..7a466e9 --- /dev/null +++ b/test/test_repl.ml @@ -0,0 +1,137 @@ +(* C-x C-e: evaluating an expression inside a program that is running. + + A different primitive from redefining a name, and the difference is the + whole test: there is no name to install a body into, so the expression is + compiled into a thunk with nowhere to be called from, the module says "run + this once", and the agent does — at a frame boundary, on the game thread. + + Nothing is marshalled back. A Flan value carries no header, so nothing at + run time could say what it is; the compiler knows the type and renders it + there. That is the layout decision's bill, and it is why only the scalars + work so far. + + The case that matters most is the same expression evaluated twice with + different answers: that is what says it read the live process's state rather + than a copy of it. *) + +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-repl-" ^ n) + +let rec await ?(ms = 8000) 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 = 8000) 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 field r k = Wire.string_field r k +let status r = match field r "status" with Some s -> s | None -> "" + +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 () = + match Sys.command "command -v clang > /dev/null 2>&1 && command -v llc > /dev/null 2>&1" with + | 0 -> + let sock = tmp "dev.sock" and out = tmp "prog.out" in + List.iter (fun f -> try Sys.remove f with Sys_error _ -> ()) [ sock; out ]; + let fd = Unix.openfile out [ Unix.O_WRONLY; Unix.O_CREAT; Unix.O_TRUNC ] 0o600 in + let flan = "../bin/main.exe" in + let pid = + Unix.create_process flan + [| flan; "dev"; "programs/dev-repl.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 + let c = connect sock in + let evals code = + request c + (Printf.sprintf "(:op \"eval-expr\" :code %s :file \"/tmp/buf.flan\")" + (quote code)) + in + let value name code expected = + let r = evals code in + match field r "value" with + | Some v when v = expected -> () + | Some v -> fail "%s\n got: %S\n wanted: %S" name v expected + | None -> + fail "%s: %s" name (Option.value ~default:(status r) (field r "message")) + in + value "arithmetic" "(+ 1 2)" "3"; + value "a comparison" "(< 1 2)" "true"; + value "a string" "\"hi\"" "hi"; + (* A defconst: its value is in the program's rodata and this reads it. *) + value "a constant" "step-by" "3"; + + (* The one that proves it ran inside the process: the program increments + [ticks] every frame, so two evaluations of it must disagree. A copy + of the program's state, or a value computed here, would not. *) + let read () = + match field (evals "ticks") "value" with + | Some v -> int_of_string_opt v + | None -> None + in + (match (read (), read ()) with + | Some a, Some b when b > a -> () + | Some a, Some b -> + fail "ticks read %d then %d — the expression did not see the live \ + program advancing" a b + | _ -> fail "ticks did not evaluate"); + + (* Types with no printer derived yet refuse by name rather than render + something plausible and wrong. u64 is its own case: i64->bytes is + signed, so anything past 2^63 would come back negative. *) + let refuses name code reason = + let r = evals code in + match field r "message" with + | Some m when + (let n = String.length reason and h = String.length m in + let rec go i = i + n <= h && (String.sub m i n = reason || go (i + 1)) in + go 0) -> () + | Some m -> fail "%s said %S, wanted it to mention %S" name m reason + | None -> fail "%s was accepted" name + in + refuses "u64" "rand-state" "no printer for u64"; + refuses "a declaration" "(defvar nope i64)" ""; + refuses "an unknown name" "no-such-name" "unknown name"; + + (* And the session is untouched by all of it: an evaluation is not a + declaration, so nothing named eval/N accumulates in the program. *) + let r = request c "(:op \"describe\")" in + if status r <> "ok" then fail "describe after evaluating: %s" (status r); + + ignore (request c "(:op \"close\")"); + Unix.close c + end; + (try Unix.kill pid Sys.sigterm with Unix.Unix_error _ -> ()); + (try ignore (Unix.waitpid [] pid) with Unix.Unix_error _ -> ()); + List.iter (fun f -> try Sys.remove f with Sys_error _ -> ()) [ sock; out ]; + if !failures = 0 then print_endline "repl: all tests passed" + else begin + Printf.printf "\n%d failure(s)\n" !failures; + exit 1 + end + | _ -> print_endline "repl: skipped (no clang or llc on PATH)" diff --git a/vendor/agent/flan_agent.c b/vendor/agent/flan_agent.c index a01cb92..092594f 100644 --- a/vendor/agent/flan_agent.c +++ b/vendor/agent/flan_agent.c @@ -40,12 +40,23 @@ typedef void (*install_fn)(void); +/* A module may also carry a thunk to run once — that is C-x C-e, an expression + * compiled into a function with nowhere to be called from. It runs where the + * install happens, on the game thread between frames, because an expression + * that reads the program's state has to see it at a point the program agrees + * is consistent. */ +typedef void (*call_fn)(void); + +const char *flan_dev_result_get(uint64_t *gen, uint64_t *len); + /* A ring the listener writes and the game thread reads. One producer, one * consumer, so two atomics and no lock — the game thread must never block on * the loader. Overflow drops the oldest request rather than stalling; a dev * loop that queues 64 reloads between two frames has a bigger problem. */ #define QUEUE 64 -static install_fn queue[QUEUE]; +typedef struct { install_fn install; call_fn call; } job; + +static job queue[QUEUE]; static atomic_uint head; /* written by the listener */ static atomic_uint tail; /* written by the game thread */ @@ -53,9 +64,9 @@ static int listen_fd = -1; static pthread_t listener; static atomic_int started; -static void publish(install_fn f) { +static void publish(job j) { unsigned h = atomic_load_explicit(&head, memory_order_relaxed); - queue[h % QUEUE] = f; + queue[h % QUEUE] = j; /* Release: the store to the slot must be visible before the index that * advertises it. */ atomic_store_explicit(&head, h + 1, memory_order_release); @@ -67,9 +78,11 @@ int32_t flan_agent_poll(void) { unsigned h = atomic_load_explicit(&head, memory_order_acquire); int32_t n = 0; while (t != h) { - install_fn f = queue[t % QUEUE]; + job j = queue[t % QUEUE]; t++; - if (f != NULL) { f(); n++; } + if (j.install != NULL) { j.install(); n++; } + /* After the install, so a thunk sees the bodies its own module published. */ + if (j.call != NULL) { j.call(); } } atomic_store_explicit(&tail, t, memory_order_relaxed); return n; @@ -120,6 +133,22 @@ static void serve(int fd) { continue; } *nl = '\0'; + /* The one verb that is not a module: read back the value of the last + * expression evaluated, with the counter that says whether it is a new + * one. The daemon polls this rather than the agent holding a connection + * open across a frame boundary it does not control. */ + if (strcmp(line, "result") == 0) { + uint64_t gen = 0, len = 0; + const char *v = flan_dev_result_get(&gen, &len); + char hdr[64]; + int k = snprintf(hdr, sizeof hdr, "%llu %llu\n", (unsigned long long)gen, + (unsigned long long)len); + if (k > 0) { + send(fd, hdr, (size_t)k, MSG_NOSIGNAL); + if (len > 0) send(fd, v, (size_t)len, MSG_NOSIGNAL); + } + return; + } void *h = dlopen(line, RTLD_NOW | RTLD_LOCAL); if (h == NULL) { reply(fd, "err "); @@ -129,6 +158,8 @@ static void serve(int fd) { } install_fn f = (install_fn)(uintptr_t)dlsym(h, "flan_reload_install"); if (f == NULL) { reply(fd, "err no flan_reload_install\n"); return; } + /* Optional: only an expression evaluation has one. */ + call_fn c = (call_fn)(uintptr_t)dlsym(h, "flan_reload_call"); /* Answer before queueing, not after. The game thread can install and run * to completion between the two, and a program that exits there would tear * down this connection with the reply still unwritten — which reaches the @@ -136,7 +167,7 @@ static void serve(int fd) { reply(fd, "ok\n"); /* "queued", not "installed": the store happens on the game thread, at a * time this thread does not get to choose. */ - publish(f); + publish((job){ f, c }); return; } }