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;