From a420bb1b1d3a4ee070ebf20946377786ced4c7db Mon Sep 17 00:00:00 2001 From: Joseph Ferano Date: Thu, 10 Sep 2026 21:48:45 +0700 Subject: [PATCH] The session: a program as a live thing lib/session.ml holds the declarations a running process was built from plus every change accepted since, which is what an editor needs and what a one-shot compiler cannot have. Transactionality came for free. Check.program builds a fresh environment from a declaration list on every call, so a form that fails to check mutates nothing and the accumulated list is simply not replaced - no scratch-environment machinery, which is what I was about to build. Re-checking the whole program each evaluation costs the frontend, under 10ms, less than the llc after it. There is a test for the case that matters: a typo, then a good form, in the same session. Which names the process was built with comes from the checked program, not from any accumulated AST, because Check.program prepends the prelude and no AST contains it. Derive it from declarations and print-line reads as new, gets a registry cell nobody publishes, and the first call jumps to null. Three changes are refused with a reason rather than loaded. A function's signature, because a cell is a bare ptr and every call site compiled before the change still passes the old arguments through it. A global's type, because the storage exists and has a shape - reusing it reads at the wrong offsets, and replacing it discards the state the reload exists to preserve. A struct's fields, because the values the process is holding have the old layout. Note what the checker already catches on its own: change a parameter type and the caller fails to type check first, loudly. These rules only get a turn on a change the checker accepts, which is a name nothing else in the program uses - exactly where the silent version lives. Hence an unused defvar and a C-called defn in the fixtures. The accumulated list is the post-Load one, so an evaluated import is spliced as its expansion. Otherwise re-evaluating a file that imports something appends a second import, Load expands it again, and the duplicate-name pass rejects it. C-c C-k on sand.flan's own text is the test. flan reload now takes a program and a file of changed forms rather than a list of function names and a --new list: the session works out which names are new, which is the thing a bare CLI could not. Also fixed, found by running the agent test under load: the agent took SIGPIPE when a sender read part of a reply and closed. Replies go out with MSG_NOSIGNAL, per call rather than by installing a handler, because the signal disposition belongs to the program the agent is embedded in. --- NEXT.md | 89 ++++++++++++++-- bin/main.ml | 52 ++++------ lib/session.ml | 196 ++++++++++++++++++++++++++++++++++++ test/dune | 2 +- test/programs/agent-v2.flan | 32 ------ test/programs/reload.flan | 6 ++ test/test_agent.ml | 41 ++++---- test/test_session.ml | 106 +++++++++++++++++++ vendor/agent/flan_agent.c | 8 +- 9 files changed, 436 insertions(+), 96 deletions(-) create mode 100644 lib/session.ml delete mode 100644 test/programs/agent-v2.flan create mode 100644 test/test_session.ml diff --git a/NEXT.md b/NEXT.md index 705d346..1c760c2 100644 --- a/NEXT.md +++ b/NEXT.md @@ -31,6 +31,7 @@ reader ✅ → parse ✅ → load ✅ → check ✅ → emit ✅ → clang ✅ | `lib/types.ml` | resolved types; structural equality, `Never` fits anywhere | | `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/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 | @@ -44,6 +45,7 @@ reader ✅ → parse ✅ → load ✅ → check ✅ → emit ✅ → clang ✅ | `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/reload_host.c` | the C host that loads and installs two rebuilds, in one process | ``` @@ -504,18 +506,83 @@ module the way the daemon will. `--new` is the names the host was *not* built with; it is the one thing the command cannot work out for itself, and it is exactly what the session will track automatically. -### Still missing for `C-c C-c` +### The session -- **A session that holds the checker environment.** `Check.program` builds a - `new_env ()`, prepends the prelude, mutates it through `collect` and throws - it away. A REPL keeps it — and has to check each new form into a scratch copy - and commit only on success, or one typo leaves a half-declared name behind - and every later eval sees it. -- **Layout drift has to be rejected.** Editing a `defstruct` or retyping a - `defvar` changes the shape of memory the running process already laid out. - The house rule below says compare against the declaration the session was - built with and refuse with a reason, rather than load a module that reads a - field at the wrong offset. Nothing does this yet. +`lib/session.ml` is the program as a live thing: the declarations the running +process was built from, plus every change accepted since. + +**Transactionality came for free and needed no machinery.** `Check.program` +builds a fresh environment from a declaration list on every call, so a form +that fails to check mutates nothing — the accumulated list is simply not +replaced. Re-checking the whole program each evaluation costs the entire +frontend, under 10ms, less than the `llc` that follows. There is a test for the +case that actually matters: a typo, then a good form, in the same session. + +Two things the session knows that no single evaluation could: + +- **Which names the running process was built with.** It comes from the + *checked* program, not from any accumulated AST, because `Check.program` + prepends the prelude and no AST contains it. Derive it from declarations and + `print-line` reads as new, gets a registry cell nobody publishes, and the + first call jumps to null with no diagnostic. +- **What that process's memory looks like.** Three changes are refused with a + reason rather than loaded: + + | Change | What it would have broken | + |---|---| + | a function's signature | a cell is a bare `ptr`; every call site compiled before the change still passes the old arguments through it | + | a global's type | the storage exists and has a shape — reuse reads at the wrong offsets, replacement discards the state the reload exists to preserve | + | a struct's fields | the values the process is holding have the old layout | + + Note what the checker catches on its own: change `helper`'s parameter type + and the *caller* fails to type check first, loudly. The session's rules only + get a turn on a change the checker accepts — one to a name nothing else in + the program uses, which is exactly where the silent version lives. The + fixtures carry an unused `defvar` and a C-called `defn` for that reason. + +The accumulated list is the **post-`Load`** one, so an evaluated `(import …)` +is spliced as its expansion. Otherwise re-evaluating a file that imports +something appends a second import, `Load` expands it again, and the +duplicate-name pass rejects it. `C-c C-k` on sand.flan's own text is the test. + +`flan reload ` is that path from the command line: a +session over the program the process was built from, and a file of the forms +that changed. Verified against a running sand under Xvfb — a one-form +`game-draw` and 910 consecutive frames drew it. + +### 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. +- **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. + +**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 +talking to, which is only guaranteed if it is the session that compiled the +running binary. Attaching to a process someone else built is not a thing to +support by default. ## Where build time goes diff --git a/bin/main.ml b/bin/main.ml index b3d0707..ed97c8d 100644 --- a/bin/main.ml +++ b/bin/main.ml @@ -109,39 +109,29 @@ let () = ignore (Flan.Build.executable ~opts:{ Flan.Build.default with checks; dev } ~csrcs:l.csrcs ~lflags:l.lflags p ~out)) - (* One redefinition, built the way the daemon will build it: the forms named - become a module the running process can install. [--new] is the names the - host was *not* built with, which is the one thing this command cannot work - out for itself — a session tracks it, a CLI has to be told. *) - | _ :: "reload" :: path :: rest when rest <> [] -> - let rec split acc out news = function - | "-o" :: o :: r -> split acc (Some o) news r - | "--new" :: n :: r -> - split acc out (news @ String.split_on_char ',' n) r - | f :: r -> split (acc @ [ f ]) out news r - | [] -> (acc, out, news) - in - let fns, out, news = split [] None [] rest in + (* 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 + is one a running process can be told at all — neither of which a command + given only a list of function names could. *) + | _ :: "reload" :: prog :: forms :: rest -> let out = - match out with - | Some o -> o - | None -> Filename.remove_extension (Filename.basename path) ^ ".so" + match rest with + | [ "-o"; o ] -> o + | [] -> Filename.remove_extension (Filename.basename forms) ^ ".so" + | _ -> + prerr_endline "usage: flan reload [-o out.so]"; + exit 2 in - if fns = [] then begin - prerr_endline - "usage: flan reload ... [-o out.so] [--new name,...]"; - exit 2 - end; - with_errors path (fun () -> - let p = Flan.Check.program (load path).decls in - let known n = not (List.exists (String.equal n) news) in + with_errors forms (fun () -> + let t, _ = Flan.Session.create ~file:prog in + let src = In_channel.with_open_bin forms In_channel.input_all in + let c = Flan.Session.eval ~origin:forms t src in let opts = { Flan.Build.default with dev = true } in - let t = - Flan.Build.shared ~opts - ~ir:(Flan.Emit.redefinition ~dev:true ~known p ~fns) ~out () - in - Printf.eprintf "%s llc %.1fms ld %.1fms\n" out t.Flan.Build.llc_ms - t.Flan.Build.link_ms) + let timing = Flan.Build.shared ~opts ~ir:c.Flan.Session.ir ~out () in + Printf.eprintf "%s %s llc %.1fms ld %.1fms\n" out + (String.concat " " c.Flan.Session.fns) timing.Flan.Build.llc_ms + timing.Flan.Build.link_ms) | _ :: "run" :: path :: args -> with_errors path (fun () -> let exe = @@ -161,5 +151,5 @@ 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] [--new name,...]"; + \ flan reload [-o out.so]"; exit 2 diff --git a/lib/session.ml b/lib/session.ml new file mode 100644 index 0000000..0544f40 --- /dev/null +++ b/lib/session.ml @@ -0,0 +1,196 @@ +(** A live program: the declarations a running process was built from, plus + every change accepted since. + + This is what makes an editor possible. [Check.program] builds a fresh + environment from a declaration list on every call, which is exactly the + property a session needs and the reason there is no scratch-environment + machinery here: a form that fails to check leaves nothing behind, because + nothing was mutated. The list is only replaced once the check has + succeeded. Re-checking the whole program each time costs the whole frontend, + which is under 10ms — less than the [llc] that follows it. + + Two things the session knows that no single evaluation could: + + - **which names the running process was built with.** A name it has is a + symbol the loaded module binds to; a name it lacks goes through the + by-name registry in runtime/flan_dev.c. Getting this wrong is silent: + treating [print-line] as new gives it a registry cell nobody publishes, + and the first call jumps to null. It has to come from the *checked* + program, because [Check.program] prepends the prelude and no accumulated + AST contains it. + - **what the memory of that process looks like.** A cell is a bare pointer + and carries no signature, so a redefined function whose parameters + changed is called by every existing call site with the old ones — no link + error, no trap, a wrong number. Struct fields and global types are the + same class. Those are refused here, with the reason, rather than loaded. + + Not here, and deliberately: evaluating an expression. That is a separate + primitive — synthesize a function around the form, call it, render the + value — and it is not what redefining a name is. *) + +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 *) + host : Tast.program; (* what the process was built from *) +} + +let fail = Loc.fail + +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 }, l) + +(* A name the running process exports. Everything else is looked up by name at + install time — see [Emit.redefinition]'s [known]. *) +let known t n = + List.exists (fun (f : Tast.fn) -> String.equal f.Tast.name n) t.host.Tast.fns + || List.exists + (fun (g : Tast.global) -> String.equal g.Tast.gname n) + t.host.Tast.globals + +(* ── What a running process cannot be told ─────────────────────────── *) + +(* Everything here is a change that would load cleanly and then be wrong. The + house rule (NEXT.md, Watch for) says recognise it and refuse with the + reason, so each one names what it would have broken. *) +let compatible ~loc (old_ : Tast.program) (new_ : Tast.program) = + let find_fn p n = + List.find_opt (fun (f : Tast.fn) -> String.equal f.Tast.name n) p.Tast.fns + in + List.iter + (fun (f : Tast.fn) -> + match find_fn old_ f.Tast.name with + | None -> () + | Some g -> + let same = + List.length f.Tast.params = List.length g.Tast.params + && List.for_all2 Types.equal f.Tast.params g.Tast.params + && Types.equal f.Tast.ret g.Tast.ret + in + (* A cell holds a bare pointer. Every call site compiled before this + change still passes the old arguments through it. *) + if not same then + fail loc + "%s changes signature, from (Fn [%s] %s) to (Fn [%s] %s); \ + the calls already compiled into the running program pass the old \ + one. Restart to change it." + f.Tast.name + (String.concat " " (List.map Types.to_string g.Tast.params)) + (Types.to_string g.Tast.ret) + (String.concat " " (List.map Types.to_string f.Tast.params)) + (Types.to_string f.Tast.ret)) + new_.Tast.fns; + List.iter + (fun (g : Tast.global) -> + match + List.find_opt + (fun (h : Tast.global) -> String.equal h.Tast.gname g.Tast.gname) + old_.Tast.globals + with + | Some h when not (Types.equal g.Tast.gty h.Tast.gty) -> + (* The storage exists and has a shape. Reusing it for another one + reads fields at the wrong offsets; allocating fresh storage would + silently discard the state the reload exists to preserve. *) + fail loc + "%s changes type, from %s to %s; the running program already laid \ + that storage out. Restart to change it." + g.Tast.gname (Types.to_string h.Tast.gty) (Types.to_string g.Tast.gty) + | _ -> ()) + new_.Tast.globals; + List.iter + (fun (s : Tast.structure) -> + match + List.find_opt + (fun (r : Tast.structure) -> String.equal r.Tast.sname s.Tast.sname) + old_.Tast.structs + with + | Some r -> + let fields (x : Tast.structure) = + List.map (fun (f : Tast.field) -> (f.Tast.fname, f.Tast.fty)) + x.Tast.fields + in + let same = + List.length s.Tast.fields = List.length r.Tast.fields + && List.for_all2 + (fun (an, at) (bn, bt) -> String.equal an bn && Types.equal at bt) + (fields s) (fields r) + in + (* Every value of this type in the running program has the old layout, + including ones held in globals that the reload is preserving. *) + if not same then + fail loc + "%s changes layout; the values the running program is holding have \ + the old one. Restart to change it." + s.Tast.sname + | None -> ()) + new_.Tast.structs + +(* ── Accepting a change ────────────────────────────────────────────── *) + +(* The redefinition unit is a list of top-level forms, so this is one path for + both editor commands: C-c C-c sends one form, C-c C-k sends a file. *) +type change = { + ir : string; (* the module to build and send *) + names : string list; (* everything the forms declared *) + fns : string list; (* the subset that has a body to install *) +} + +let eval ?(origin = "") t src : change = + let forms = Reader.read_all ~file:origin src in + (* Through [Load] like any other source, so an evaluated (import ...) means + what it means in a file. Its expansion is what gets spliced, which is also + why the accumulated list is the post-Load one: re-evaluating a file that + imports something would otherwise append a second copy of the import and + the duplicate-name pass would reject it. *) + let incoming = (Load.program ~file:t.file (Parse.program forms)).Load.decls in + let loc = + match incoming with d :: _ -> d.Ast.dloc | [] -> Loc.unknown + in + let names = List.filter_map Ast.declared_name incoming in + let replacement n = + List.find_opt + (fun (d : Ast.decl) -> Ast.declared_name d = Some n) + incoming + in + (* Replaced in place and appended only when genuinely new, so declaration + order — which is emission order for globals — does not shuffle on every + evaluation. *) + let replaced = ref [] in + let kept = + List.map + (fun (d : Ast.decl) -> + match Ast.declared_name d with + | Some n -> + (match replacement n with + | Some nd -> replaced := n :: !replaced; nd + | None -> d) + | None -> d) + t.decls + in + let added = + List.filter + (fun (d : Ast.decl) -> + match Ast.declared_name d with + | Some n -> not (List.exists (String.equal n) !replaced) + | None -> false) + incoming + in + 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 + compatible ~loc t.program program; + let fns = + List.filter + (fun n -> + List.exists + (fun (f : Tast.fn) -> String.equal f.Tast.name n) + program.Tast.fns) + names + in + let ir = Emit.redefinition ~dev:true ~known:(known t) program ~fns in + t.decls <- decls; + t.program <- program; + { ir; names; fns } diff --git a/test/dune b/test/dune index 7b1dad6..a9242b5 100644 --- a/test/dune +++ b/test/dune @@ -1,5 +1,5 @@ (tests - (names test_flan test_acceptance test_reload test_agent) + (names test_flan test_acceptance test_reload test_agent test_session) (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/agent-v2.flan b/test/programs/agent-v2.flan deleted file mode 100644 index e112ebb..0000000 --- a/test/programs/agent-v2.flan +++ /dev/null @@ -1,32 +0,0 @@ -;;;; agent.flan with [tick] changed, and nothing else. Only [tick] is compiled -;;;; into the module that gets sent over the socket; the rest of this file is -;;;; here because a redefinition is checked against the whole program it -;;;; belongs to, not against itself. -;;;; -;;;; [tick] is the function that gets redefined. It is called once before the -;;;; reload and once after, and nothing else in this file changes, so the two -;;;; numbers are the whole result. -;;;; -;;;; It waits rather than polling on a timer because a test that races the -;;;; frame rate is a test that fails on a loaded machine. A game loop calls -;;;; poll at the top of the frame and ignores the answer; the split is in -;;;; vendor/agent/agent.flan. -(import agent "vendor:agent") - -(defvar ticks i64) - -(defn tick [] i64 - (set ticks (+ ticks 1000)) - ticks) - -(defn main [args [string]] i32 - (if (< (len args) 2) - (do (print-line "usage: agent ") 2) - (do - (if (< (agent/start (at args 1)) 0) - (do (print-line "cannot listen") 1) - (do - (print-i64 (tick)) (newline) - (while (= (agent/wait 100) 0) 0) - (print-i64 (tick)) (newline) - 0))))) diff --git a/test/programs/reload.flan b/test/programs/reload.flan index 96cf2cb..234d256 100644 --- a/test/programs/reload.flan +++ b/test/programs/reload.flan @@ -12,6 +12,12 @@ ;;;; its own constants, and a one-function module usually has none. (defvar counter i64) +;;; Unused, and that is the point: the session's compatibility rules only get a +;;; chance to speak about a change the *checker* accepts, and retyping a var +;;; something else reads is an ordinary type error long before it is a layout +;;; question. +(defvar spare i64) + (defn helper [x i64] i64 (* x 2)) (defn bump [] i64 diff --git a/test/test_agent.ml b/test/test_agent.ml index 9bdfb66..a85b1bf 100644 --- a/test/test_agent.ml +++ b/test/test_agent.ml @@ -20,9 +20,6 @@ let fail fmt = Printf.ksprintf (fun s -> incr failures; print_endline ("FAIL " let scratch = Filename.get_temp_dir_name () let tmp name = Filename.concat scratch ("flan-agent-" ^ name) -let load path = Load.program ~file:path (Parse.program (Reader.read_file path)) -let checked path = Check.program (load path).Load.decls - (* Poll for a condition rather than sleeping a fixed time: the program has to bind its socket before there is anything to connect to, and how long that takes is not ours to predict. *) @@ -49,37 +46,41 @@ let send path line = let s = connect path in let msg = line ^ "\n" in ignore (Unix.write_substring s msg 0 (String.length msg)); + (* Read to EOF, not once: a reply arrives in several pieces, and closing + after the first one is what made the agent take SIGPIPE. *) let buf = Bytes.create 512 in - let n = try Unix.read s buf 0 512 with Unix.Unix_error _ -> 0 in + let b = Buffer.create 512 in + let rec drain () = + match Unix.read s buf 0 512 with + | 0 -> () + | n -> Buffer.add_subbytes b buf 0 n; drain () + | exception Unix.Unix_error _ -> () + in + drain (); Unix.close s; - Bytes.sub_string buf 0 n + Buffer.contents b let () = match Sys.command "command -v clang > /dev/null 2>&1 && command -v llc > /dev/null 2>&1" with | 0 -> - let l = load "programs/agent.flan" in - let p = Check.program l.Load.decls in - let p2 = checked "programs/agent-v2.flan" in + (* The session is the program the process is about to be built from. Going + through it rather than calling Emit directly is the point: it is what + knows [tick] is a name the host has, so the module binds to its cell as + a symbol instead of inventing a registry entry nobody publishes. *) + let t, l = Session.create ~file:"programs/agent.flan" in (* A dev build, because that is what has cells to install into and exports them. The agent's own C and its -lpthread come from the package. *) let dev = { Build.default with Build.dev = true } in let exe = tmp "prog" in ignore - (Build.executable ~opts:dev ~csrcs:l.Load.csrcs ~lflags:l.Load.lflags p - ~out:exe); + (Build.executable ~opts:dev ~csrcs:l.Load.csrcs ~lflags:l.Load.lflags + t.Session.host ~out:exe); - (* What the running process was built with; [tick] is in it, so the module - reaches its cell as a symbol rather than through the registry. *) - let known n = - List.exists (fun (f : Tast.fn) -> f.Tast.name = n) p.Tast.fns - || List.exists (fun (g : Tast.global) -> g.Tast.gname = n) p.Tast.globals - in + (* One form, which is what C-c C-c sends. *) + let c = Session.eval t "(defn tick [] i64 (set ticks (+ ticks 1000)) ticks)" in let so = tmp "tick.so" in - ignore - (Build.shared ~opts:dev - ~ir:(Emit.redefinition ~dev:true ~known p2 ~fns:[ "tick" ]) - ~out:so ()); + ignore (Build.shared ~opts:dev ~ir:c.Session.ir ~out:so ()); let sock = tmp "sock" in let out = tmp "out" in diff --git a/test/test_session.ml b/test/test_session.ml new file mode 100644 index 0000000..bdaa9fa --- /dev/null +++ b/test/test_session.ml @@ -0,0 +1,106 @@ +(* The session: the declarations a running process was built from, plus every + change accepted since (NEXT.md, the dev loop). + + Two halves. First, what a session refuses — every case here is a change that + would compile, load, install, and then be wrong, because a cell is a bare + pointer and storage that already exists already has a shape. Second, that + refusing leaves the session usable, which is the failure people actually hit: + one typo must not poison every later evaluation. *) + +open Flan + +let failures = ref 0 +let fail fmt = Printf.ksprintf (fun s -> incr failures; print_endline ("FAIL " ^ s)) fmt + +let has hay needle = + let n = String.length needle and h = String.length hay in + let rec go i = i + n <= h && (String.sub hay i n = needle || go (i + 1)) in + go 0 + +(* Every rejection is asserted on its reason, not just on the failure: the + reason is the part that has to survive a refactor. *) +let refuses ?(file = "programs/reload.flan") name src reason = + let t, _ = Session.create ~file in + match Session.eval t src with + | _ -> fail "%s was accepted" name + | exception Loc.Error (_, msg) -> + if not (has msg reason) then + fail "%s\n said: %S\n wanted it to mention: %S" name msg reason + +let () = + (* A cell carries no signature, so every call site compiled before the change + still passes the old arguments through it. *) + (* [outer] is called only from C, and [spare] is read by nothing, so the + checker has no complaint about either change and the session is the only + thing that can refuse them. A change something else in the program uses is + an ordinary type error first, which is a different and louder failure. *) + refuses "a changed parameter type" + "(defn outer [x i64] i64 (bump))" + "changes signature"; + refuses "a changed return type" + "(defn outer [] i32 (i32 (bump)))" + "changes signature"; + refuses "a changed arity" + "(defn outer [a i64 b i64] i64 (bump))" + "changes signature"; + (* The storage exists and has a shape: reusing it reads at the wrong offsets, + and replacing it discards the state the reload exists to preserve. *) + refuses "a retyped global" + "(defvar spare i32)" + "changes type"; + (* Values of the type are already in the running program's memory. *) + refuses ~file:"programs/values.flan" "a restructured struct" + "(defstruct P [x i32 y i32])" + "changes layout"; + + (* An ordinary redefinition, and what the session works out about it. *) + let t, _ = Session.create ~file:"programs/reload.flan" in + let c = Session.eval t "(defn bump [] i64 (set counter (+ counter 5)) counter)" in + if c.Session.fns <> [ "bump" ] then + fail "redefining bump reported %s" (String.concat " " c.Session.fns); + (* The prelude is in the checked program and in no accumulated AST, so a + session that derived [known] from declarations would call print-line + through a registry cell nobody ever publishes. *) + if not (has c.Session.ir "@\"flan.cell.print-line\" = external global ptr") then + fail "the prelude was treated as new"; + if has c.Session.ir "flan_dev_cell" then + fail "a name the host has went through the registry"; + + (* A form that does not check must leave the session exactly as it was. This + is the one that decides whether a REPL survives a typo. *) + (match Session.eval t "(defn bump [] i64 nonsense)" with + | _ -> fail "an unresolvable name was accepted" + | exception Loc.Error _ -> ()); + (match Session.eval t "(defn bump [] i64 (set counter (+ counter 6)) counter)" with + | c -> if c.Session.fns <> [ "bump" ] then fail "the session did not recover" + | exception Loc.Error (_, m) -> fail "the session was poisoned by a typo: %s" m); + + (* Names the process was never built with go through the registry instead of + binding to a symbol, and adding one is allowed where retyping one is not. *) + let c = Session.eval t "(defvar fresh i64) (defn use-fresh [] i64 (set fresh 3) fresh)" in + if not (List.mem "fresh" c.Session.names && List.mem "use-fresh" c.Session.fns) then + fail "adding a var and a function reported %s" (String.concat " " c.Session.names); + if not (has c.Session.ir "call ptr @flan_dev_global") then + fail "a new global did not go through the registry"; + (* And once added, it is part of the session: a later form can use it. *) + (match Session.eval t "(defn use-fresh [] i64 (set fresh 4) fresh)" with + | _ -> () + | exception Loc.Error (_, m) -> fail "a name added earlier was forgotten: %s" m); + + (* A file with imports, re-evaluated whole — the C-c C-k case. The session + keeps the *expanded* declarations, so the package's names are replaced in + place rather than appended a second time and rejected as duplicates. *) + let t, _ = Session.create ~file:"../sand.flan" in + let src = In_channel.with_open_bin "../sand.flan" In_channel.input_all in + (match Session.eval t src with + | c -> + if not (List.mem "game-draw" c.Session.fns) then + fail "reloading sand.flan did not include its own functions" + | exception Loc.Error (_, m) -> + fail "reloading a file with imports failed: %s" m); + + if !failures = 0 then print_endline "session: all tests passed" + else begin + Printf.printf "\n%d failure(s)\n" !failures; + exit 1 + end diff --git a/vendor/agent/flan_agent.c b/vendor/agent/flan_agent.c index afa1182..41b27c5 100644 --- a/vendor/agent/flan_agent.c +++ b/vendor/agent/flan_agent.c @@ -87,10 +87,16 @@ int32_t flan_agent_wait(int32_t ms) { return flan_agent_poll(); } +/* MSG_NOSIGNAL rather than write(2). A reply goes out in more than one piece, + * and a sender that has read enough and closed leaves the rest of it writing + * into a closed socket — which is SIGPIPE, whose default action would kill the + * program the agent is embedded in. Suppressing it per call rather than + * installing a handler, because the disposition belongs to the program and not + * to us. */ static void reply(int fd, const char *s) { size_t n = strlen(s); while (n > 0) { - ssize_t k = write(fd, s, n); + ssize_t k = send(fd, s, n, MSG_NOSIGNAL); if (k <= 0) return; s += k; n -= (size_t)k;