Joseph Ferano
b438a71031
A generic defn produces no Tast.fn, so the editor was told nothing had been installed and nothing had gone wrong. eval now expands a redefined generic name to its copies, and picks up any copy the running process was never built with - which is how a redefined caller reaching a generic at a new element type gets that copy built and loaded. C-x C-e is the path that could really go stale, and did: it checks against the live environment, so an expression naming a generic at an unused type generated a copy that existed in no program and the thunk called a symbol nothing defined. Marked and spliced. There was no cache to invalidate. program_with_env builds a fresh env every evaluation, so the instantiation cache cannot survive one; the test pins that rather than inventing machinery for it. A signature change reaches the session as a refusal about put!-i32, a name the source does not contain. It now says which generic it is a copy of, at which types, and that every copy changed together.
414 lines
22 KiB
OCaml
414 lines
22 KiB
OCaml
(* 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
|
|
|
|
(* The watchdog first: a hang is the one failure mode that reports
|
|
nothing at all. See watchdog.ml. *)
|
|
let () = Watchdog.arm ~seconds:600 "test_session"
|
|
|
|
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 checked_program file =
|
|
Check.program
|
|
(Load.program ~file (Parse.program (Reader.read_file file))).Load.decls
|
|
|
|
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 { Loc.dmsg = 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. *)
|
|
(* A defconst the *checker* consumed is in the shape of the program — an
|
|
array length is decided before any type resolves — so no store can reach
|
|
it. One that is only read at run time is a different matter; see below. *)
|
|
refuses "a changed defconst used at compile time"
|
|
"(defconst folded i64 8)"
|
|
"used at compile time";
|
|
(* An enum member is erased to an i32 literal in the caller, so the same
|
|
applies. It is compared over declarations because Tast.program carries no
|
|
enums at all, for exactly that reason. *)
|
|
refuses "a changed enum member"
|
|
"(defenum Colour [red 0 green 2])"
|
|
"changes its members";
|
|
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 not c.Session.installs then fail "a redefined function had nothing to install";
|
|
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 rand-seed
|
|
through a registry cell nobody ever publishes. *)
|
|
if not (has c.Session.ir "@\"flan.cell.rand-seed\" = 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";
|
|
|
|
(* DWARF in a redefinition module, which is a property of the session and
|
|
not of the call. [Emit.redefinition] has taken a ~debug argument all
|
|
along and was tested with it; what was missing was anyone passing it, so
|
|
every body installed by C-c C-c lost its debug info in a running process.
|
|
The defect was one unpassed argument, so the test is that the argument
|
|
arrives — asserted on the emitted text, which is the only place it shows.
|
|
|
|
Both directions matter. A session that always emitted debug info would
|
|
force -O0 on every reloaded body ([Build.shared] does that, and must),
|
|
which would change the frame time of the one function being iterated on.
|
|
Off unless asked for is the behaviour, so off is asserted too. *)
|
|
let dt, _ = Session.create ~debug:true ~file:"programs/reload.flan" () in
|
|
let dc =
|
|
Session.eval dt
|
|
"(defn bump [] i64 (let [step (i64 5)] (set counter (+ counter step)) counter))"
|
|
in
|
|
if not (has dc.Session.ir "!DILocalVariable(name: \"step\"") then
|
|
fail "a debug session's redefinition carries no name for its local";
|
|
if not (has dc.Session.ir "!DISubprogram(name: \"bump\"") then
|
|
fail "a debug session's redefinition carries no subprogram";
|
|
let pt, _ = Session.create ~file:"programs/reload.flan" () in
|
|
let pc =
|
|
Session.eval pt
|
|
"(defn bump [] i64 (let [step (i64 5)] (set counter (+ counter step)) counter))"
|
|
in
|
|
if has pc.Session.ir "!DILocalVariable" then
|
|
fail "a plain session's redefinition carries debug info it was not asked for";
|
|
|
|
(* The same for an expression evaluation, which takes the other path out of
|
|
the session and so can lose the flag on its own. *)
|
|
let ec = Session.eval_expr dt "(+ counter 1)" in
|
|
if not (has ec.Session.ir "!DISubprogram") then
|
|
fail "a debug session's eval thunk carries no debug info";
|
|
|
|
(* 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 { Loc.dmsg = m; _ } -> fail "the session was poisoned by a typo: %s" m);
|
|
|
|
(* A declaration the program already has, with no body and no new storage,
|
|
is accepted and has nothing to send. Building a module for it would report
|
|
success for a change that cannot have taken effect, and would cost the
|
|
program a reload it did not need. *)
|
|
(match Session.eval t "(defvar counter i64)" with
|
|
| c -> if c.Session.installs then fail "an empty change claimed to install"
|
|
| exception Loc.Error { Loc.dmsg = m; _ } -> fail "redeclaring a var unchanged: %s" m);
|
|
|
|
(* A constant that is only ever read at run time is just bytes in the
|
|
program's memory. A dev build emits it as a mutable global and the module
|
|
stores the new value at the frame boundary, which is how a colour table
|
|
gets tuned live. *)
|
|
(match Session.eval t "(defconst palette [2 u32] [9 9])" with
|
|
| c ->
|
|
if not c.Session.installs then
|
|
fail "a changed run-time constant had nothing to install";
|
|
if not (has c.Session.ir "store [2 x i32]") then
|
|
fail "a changed run-time constant published no new value"
|
|
| exception Loc.Error { Loc.dmsg = m; _ } -> fail "changing a run-time constant: %s" m);
|
|
(* And in a dev build its storage is writable, where a release build keeps
|
|
it immutable and gets all the folding back. *)
|
|
let host = checked_program "programs/reload.flan" in
|
|
if not (has (Emit.program ~dev:true host) "@\"flan.palette\" = global") then
|
|
fail "a dev build left a constant immutable";
|
|
if not (has (Emit.program host) "@\"flan.palette\" = constant") then
|
|
fail "a release build made a constant mutable";
|
|
|
|
(* A new global carries its declared initial value, copied once when the
|
|
storage is allocated and never again — calloc alone would make it zero. *)
|
|
let c = Session.eval t "(defvar started i64 42) (defn read-started [] i64 started)" in
|
|
if not (has c.Session.ir "@\".init.") then
|
|
fail "a new global's initialiser was dropped";
|
|
if not c.Session.installs then fail "adding a global had nothing to install";
|
|
|
|
(* 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 { Loc.dmsg = 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
|
|
(* [~origin] is the buffer's own path and both editor paths send it
|
|
(flan-dev.el's `:file (or buffer-file-name "<buffer>")`). Omitting it here
|
|
was testing a request the editor never sends. It used to matter to this
|
|
case for a second reason — sand.flan embedded brush.png, and an embedded
|
|
path resolves relative to the file the form is written in, so the default
|
|
origin of "<eval>" found nothing. sand.flan has no embed any more; the
|
|
first reason is the one that stands. *)
|
|
(match Session.eval ~origin:"../sand.flan" 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 { Loc.dmsg = m; _ } ->
|
|
fail "reloading a file with imports failed: %s" m);
|
|
|
|
(* A form typed into a file that is *imported as a package* has to be
|
|
qualified the way the import qualified it, or it splices as a brand-new
|
|
unrelated name: the evaluation reports success and the running program
|
|
goes on calling the one it already had. The alias is chosen by the
|
|
importer and written nowhere in the file, so the path is the only thing
|
|
that can decide it — which is why it is derived here and not sent by the
|
|
editor. *)
|
|
let t, _ = Session.create ~file:"../sand.flan" () in
|
|
(match
|
|
Session.eval ~origin:"../vendor/agent/agent.flan" t
|
|
"(defn poll [] i32 (poll-raw))"
|
|
with
|
|
| c ->
|
|
if c.Session.fns <> [ "agent/poll" ] then
|
|
fail "a form from a package file reported %s, wanted agent/poll"
|
|
(String.concat " " c.Session.fns)
|
|
| exception Loc.Error { Loc.dmsg = m; _ } -> fail "redefining agent/poll: %s" m);
|
|
(* A package that is a single file, which is what sand.flan is to the
|
|
headless driver. The file being edited *is* the package rather than a
|
|
member of a directory, so matching on the directory alone would answer
|
|
"not a package" — and the failure is the silent one above: the form
|
|
splices as a bare [step] and the running program keeps the one it had. *)
|
|
let t2, _ = Session.create ~file:"programs/sand-headless.flan" () in
|
|
(match Session.eval ~origin:"../sand.flan" t2 "(defn step [] () (do))" with
|
|
| c ->
|
|
if c.Session.fns <> [ "sand/step" ] then
|
|
fail "a form from a single-file package reported %s, wanted sand/step"
|
|
(String.concat " " c.Session.fns)
|
|
| exception Loc.Error { Loc.dmsg = m; _ } -> fail "redefining sand/step: %s" m);
|
|
|
|
(* And a file that is not a package keeps its names as written. *)
|
|
(match Session.eval ~origin:"../sand.flan" t "(defn game-draw [] () (do))" with
|
|
| c ->
|
|
if c.Session.fns <> [ "game-draw" ] then
|
|
fail "a form from the program's own file reported %s"
|
|
(String.concat " " c.Session.fns)
|
|
| exception Loc.Error { Loc.dmsg = m; _ } -> fail "redefining game-draw: %s" m);
|
|
|
|
(* An expression's thunk leaves nothing behind, and the module says so, which
|
|
is what lets the agent unload it: nothing may point into its text
|
|
afterwards. So it is called directly rather than through a cell, and it
|
|
must not take a registry slot either — there are 4096 of those and an
|
|
expression evaluated in a loop would exhaust them. A module that publishes
|
|
a body can never say this; its whole purpose is to leave a pointer. *)
|
|
let t, _ = Session.create ~file:"programs/reload.flan" () in
|
|
let e = Session.eval_expr t "(+ 1 2)" in
|
|
if not (has e.Session.ir "@flan_reload_transient") then
|
|
fail "an expression's module did not declare itself unloadable";
|
|
if not (has e.Session.ir "define void @flan_reload_call") then
|
|
fail "an expression's module carried no thunk to run";
|
|
if has e.Session.ir "flan.cellp.eval" then
|
|
fail "an expression's thunk took a registry slot";
|
|
if has e.Session.ir "call ptr @flan_dev_cell" then
|
|
fail "an expression's thunk was looked up by name";
|
|
let c = Session.eval t "(defn bump [] i64 (set counter (+ counter 1)) counter)" in
|
|
if has c.Session.ir "@flan_reload_transient" then
|
|
fail "a module that publishes a body claimed to be unloadable";
|
|
|
|
(* And a third condition, about data rather than text. A string literal lives
|
|
in the evaluating module's own image, and an expression may store one
|
|
anywhere: [(set msg "x")] on a string global would leave that global
|
|
pointing into a mapping the agent then drops — and since the next thunk can
|
|
be mapped at the same address, the result is silent garbage rather than a
|
|
fault. A module carrying any string constant keeps its mapping. *)
|
|
let str = Session.eval_expr t "(println \"tuned\")" in
|
|
if not (has str.Session.ir ".str.0") then
|
|
fail "the fixture stopped carrying a string constant, so it proves nothing";
|
|
if has str.Session.ir "@flan_reload_transient" then
|
|
fail "an expression holding a string claimed to be unloadable";
|
|
|
|
(* ── Generics in the dev loop ─────────────────────────────────────────
|
|
A generic [defn] produces no [Tast.fn] of its own — only its copies do —
|
|
so every one of these is a question the editor asks that the ordinary
|
|
name-to-body path cannot answer. *)
|
|
let gen () = fst (Session.create ~file:"programs/reload-generic.flan" ()) in
|
|
|
|
(* 1. [C-c C-c] on a generic used to report [installs=false, fns=[]]: it
|
|
installed nothing and did not say anything had gone wrong. Both copies
|
|
have to be named, and the copy of [put!] that [hold!] pulls in has to be
|
|
there too, which is transitivity. *)
|
|
(match Session.eval (gen ()) "(defn hold! [xs [$t] v $t] () {:where (copyable? $t)} (put! xs 0 v) (put! xs 0 v))" with
|
|
| c ->
|
|
if not c.Session.installs then
|
|
fail "redefining a generic installed nothing";
|
|
List.iter
|
|
(fun want ->
|
|
if not (List.mem want c.Session.fns) then
|
|
fail "redefining a generic did not install %s; it installed %s"
|
|
want (String.concat " " c.Session.fns))
|
|
[ "hold!-i32"; "hold!-f64" ];
|
|
(* And only its own copies: [put!] did not change, and its copies are
|
|
reached through their cells, so reinstalling them would be work with
|
|
no effect. *)
|
|
if List.mem "put!-i32" c.Session.fns then
|
|
fail "redefining a generic reinstalled an unchanged generic's copies"
|
|
| exception Loc.Error { Loc.dmsg = m; _ } ->
|
|
fail "redefining a generic: %s" m);
|
|
|
|
(* The callee side of the same rule: redefining [put!] reinstalls the copies
|
|
of [put!], which exist only because [hold!] asked for them — the
|
|
instantiation that generated them was transitive, and finding them again
|
|
is one table lookup rather than a walk, because a whole-program check has
|
|
already regenerated all of them. *)
|
|
(match Session.eval (gen ()) "(defn put! [xs [$t] i i32 v $t] () {:where (copyable? $t)} (set (at xs i) v))" with
|
|
| c ->
|
|
List.iter
|
|
(fun want ->
|
|
if not (List.mem want c.Session.fns) then
|
|
fail "redefining a called generic did not install %s; it \
|
|
installed %s" want (String.concat " " c.Session.fns))
|
|
[ "put!-i32"; "put!-f64" ]
|
|
| exception Loc.Error { Loc.dmsg = m; _ } ->
|
|
fail "redefining a generic: %s" m);
|
|
|
|
(* 2. Staleness, and the answer is that there is none to have. The
|
|
instantiation cache lives in the [Check.env] that [Check.program_with_env]
|
|
builds *fresh* on every evaluation, so a redefined generic's copies are
|
|
regenerated from the new body and there is no cached copy of the old one
|
|
anywhere to invalidate. Pinned here because the alternative — a cache that
|
|
survived between evaluations — would make [C-c C-c] appear to succeed
|
|
while the program kept running the old body, which is the quiet version
|
|
of failure (1). *)
|
|
(let t = gen () in
|
|
let c =
|
|
Session.eval t
|
|
"(defn pick [xs [$t]] $t {:where (ordered? $t)} (let [m (at xs 0)] \
|
|
(dotimes [i (len xs)] (set m (max m (at xs i)))) m))"
|
|
in
|
|
if not (List.mem "pick-i32" c.Session.fns) then
|
|
fail "redefining a generic did not reinstall pick-i32";
|
|
(* The new body is the one that got emitted, not a cached copy of the old:
|
|
[max] lowers to a [>] where [min] lowered to a [<]. *)
|
|
if not (has c.Session.ir "icmp sgt") then
|
|
fail "the reinstalled copy carried the old body";
|
|
(* And again, to show the second evaluation is not served from a cache the
|
|
first one left behind. *)
|
|
let c2 = Session.eval t "(defn pick [xs [$t]] $t {:where (ordered? $t)} (at xs 0))" in
|
|
if not (List.mem "pick-i32" c2.Session.fns) then
|
|
fail "a second redefinition of a generic installed nothing");
|
|
|
|
(* 3. A redefinition that needs a copy the process was never built with. The
|
|
fixture never calls [pick] at f64, so [pick-f64] exists in no program
|
|
anywhere; redefining the *caller* to ask for it has to build and install
|
|
it. Nothing in the form names [pick-f64] — it is found by being an
|
|
instantiation the host lacks. *)
|
|
(match
|
|
Session.eval (gen ())
|
|
"(defn step [] () (let [ns [5 3 9 1] fs [2.5 0.5 1.5]] \
|
|
(set counter (+ counter (i64 (pick (slice ns 0 4)))) ) \
|
|
(set counter (+ counter (i64 (pick (slice fs 0 3)))))))"
|
|
with
|
|
| c ->
|
|
if not (List.mem "pick-f64" c.Session.fns) then
|
|
fail "a redefinition needing a new instantiation did not install \
|
|
pick-f64; it installed %s" (String.concat " " c.Session.fns)
|
|
| exception Loc.Error { Loc.dmsg = m; _ } ->
|
|
fail "a redefinition needing a new instantiation: %s" m);
|
|
|
|
(* 4. A signature change on a generic is refused, and the refusal is about a
|
|
name the source does not contain: the mangling carries only the type
|
|
variables, so every copy changes signature at once and under the same
|
|
name. It has to say where that name came from. *)
|
|
(* The change has to be one the *checker* accepts, which is the narrow case
|
|
and worth saying why. A generic whose arity or variable positions move is
|
|
refused at its call sites, in the checker, with the call site's own
|
|
location — a better error than this one and the reason this path is
|
|
reached less often than it looks. What reaches here is a change every
|
|
call site still accepts and every *copy* does not: widening the index
|
|
from i32 to i64 leaves [(put! xs 0 v)] checking, because the literal
|
|
adapts, and changes [put!-i32]'s signature underneath every compiled
|
|
caller. *)
|
|
(match
|
|
Session.eval (gen ())
|
|
"(defn put! [xs [$t] i i64 v $t] () {:where (copyable? $t)} \
|
|
(set (at xs (i32 i)) v))"
|
|
with
|
|
| _ -> fail "a generic's changed parameter type was accepted"
|
|
| exception Loc.Error { Loc.dmsg = m; _ } ->
|
|
if not (has m "changes signature") then
|
|
fail "a generic's changed parameter type: %S" m;
|
|
if not (has m "the copy of the generic put!") then
|
|
fail "the refusal did not say the name came from put!: %S" m;
|
|
if not (has m "every copy of it at once") then
|
|
fail "the refusal did not say every copy changed together: %S" m);
|
|
|
|
(* And what is *not* refused, which the notes expected to be: adding a
|
|
[where] clause changes no signature at all. What it changes is which call
|
|
sites are legal, and an illegal one is a checker refusal at the call site
|
|
long before the session is asked anything. *)
|
|
(match
|
|
Session.eval (gen ())
|
|
"(defn pick [xs [$t]] $t {:where [(ordered? $t) (copyable? $t)]} (at xs 0))"
|
|
with
|
|
| c ->
|
|
if not (List.mem "pick-i32" c.Session.fns) then
|
|
fail "adding a where predicate did not reinstall the copies"
|
|
| exception Loc.Error { Loc.dmsg = m; _ } ->
|
|
fail "adding a where predicate was refused: %s" m);
|
|
|
|
(* [C-x C-e] checks against the *live* environment rather than re-checking
|
|
the program, so an expression that instantiates a generic at a type
|
|
nothing has used generates a copy that exists in no program. The module
|
|
has to carry it, or the thunk calls a symbol nothing defines. *)
|
|
(let t = gen () in
|
|
match Session.eval_expr t "(println (pick (slice [1.5 0.5] 0 2)))" with
|
|
| e ->
|
|
if not (has e.Session.ir "pick-f64") then
|
|
fail "an expression that instantiated a generic did not carry the copy"
|
|
| exception Loc.Error { Loc.dmsg = m; _ } ->
|
|
fail "an expression that instantiates a generic: %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
|