Joseph Ferano
8ca63a7717
C-u C-x C-e was never tried on a macro call. Ast.pause_call takes the expanded loc, which Loc.from_macro has stamped -- it sets a name and leaves file, line and column the call site's, so the frame the break loop reports is the line the reader is looking at. Asserted rather than argued. Also: the ring rule stated generally (refused at the parse of whichever file first has both members in scope, always before a session exists), and the declaration refusal's sentence made build-neutral, since the arm fires in an ordinary file parse too.
619 lines
33 KiB
OCaml
619 lines
33 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 (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 macro that came in with an import is still there on the *second*
|
|
evaluation, which is the C-c C-c case and the one that can quietly break.
|
|
A package's macros are collected by [Load.program] from the import forms
|
|
it is handed, and the single form an editor sends has no import in it —
|
|
so a session that replaced its set instead of adding to it would expand
|
|
[mac/twice] on the build and answer "unknown function" on the reload.
|
|
Two evaluations, because one proves nothing: the first is the C-c C-k
|
|
that could have re-supplied the set, the second is the one that has to
|
|
work without it.
|
|
|
|
An unexpanded macro call is an unknown function and therefore an
|
|
exception, so reaching the assertions at all is what says the expansion
|
|
happened. *)
|
|
let tm, _ = Session.create ~file:"programs/pkg-macro.flan" () in
|
|
(match Session.eval ~origin:"programs/pkg-macro.flan" tm
|
|
"(defn twiced [] i32 (mac/twice 21))"
|
|
with
|
|
| c ->
|
|
if not (List.mem "twiced" c.Session.fns) then
|
|
fail "a package macro on the first evaluation reported %s"
|
|
(String.concat " " c.Session.fns)
|
|
| exception Loc.Error { Loc.dmsg = m; _ } ->
|
|
fail "a package macro on the first evaluation: %s" m);
|
|
(match Session.eval ~origin:"programs/pkg-macro.flan" tm
|
|
"(defn quaded [] i32 (mac/quad 3))"
|
|
with
|
|
| c ->
|
|
if not (List.mem "quaded" c.Session.fns) then
|
|
fail "a package macro on the second evaluation reported %s"
|
|
(String.concat " " c.Session.fns)
|
|
| exception Loc.Error { Loc.dmsg = m; _ } ->
|
|
fail "a package macro was forgotten by the second evaluation: %s" m);
|
|
(* And the rule holds in the session as it does in a build: the bare name is
|
|
not a name here either. *)
|
|
(match Session.eval ~origin:"programs/pkg-macro.flan" tm
|
|
"(defn bare [] i32 (twice 21))"
|
|
with
|
|
| _ -> fail "an unqualified package macro was accepted in a session"
|
|
| exception Loc.Error { Loc.dmsg = m; _ } ->
|
|
if not (has m "twice") then
|
|
fail "an unqualified package macro said %S" m);
|
|
|
|
(* And editing the macro itself, in the package, then reloading the file
|
|
that imports it. The session is holding a copy of that macro from when it
|
|
was created, so the union has to prefer what [Load] has just read off
|
|
disk — keeping the held one would go on expanding the old body and say
|
|
nothing about it, which is the quietest failure in this whole area.
|
|
|
|
Written into a temporary package rather than into the corpus because the
|
|
point is the *second* read of a file that changed underneath. [+] first
|
|
and [*] after, because the expansion is visible in the IR: what is
|
|
asserted is the operator the macro chose, not that the reload succeeded.
|
|
*)
|
|
let tmp = Filename.temp_file "flan-macro" "" in
|
|
Sys.remove tmp;
|
|
Unix.mkdir tmp 0o755;
|
|
let pkg = Filename.concat tmp "p" in
|
|
Unix.mkdir pkg 0o755;
|
|
let write path text =
|
|
Out_channel.with_open_bin path (fun oc -> Out_channel.output_string oc text)
|
|
in
|
|
let macro op =
|
|
Printf.sprintf "(defmacro grow [args]
|
|
`(%s ~(at args 0) ~(at args 0)))
|
|
" op
|
|
in
|
|
write (Filename.concat pkg "p.flan") (macro "+");
|
|
let entry = Filename.concat tmp "use.flan" in
|
|
let text = "(import p \"p\")
|
|
|
|
(defn grown [] i32 (p/grow 21))
|
|
|
|
(defn main [] i32 0)
|
|
" in
|
|
write entry text;
|
|
let te, _ = Session.create ~file:entry () in
|
|
(match Session.eval ~origin:entry te text with
|
|
| c ->
|
|
if not (has c.Session.ir "add i32 21, 21") then
|
|
fail "a package macro's first expansion was not the one it declared"
|
|
| exception Loc.Error { Loc.dmsg = m; _ } ->
|
|
fail "reloading a file importing a macro package: %s" m);
|
|
write (Filename.concat pkg "p.flan") (macro "*");
|
|
(match Session.eval ~origin:entry te text with
|
|
| c ->
|
|
if not (has c.Session.ir "mul i32 21, 21") then
|
|
fail "an edited package macro reloaded as its old body";
|
|
if has c.Session.ir "add i32 21, 21" then
|
|
fail "an edited package macro kept the session's stale copy"
|
|
| exception Loc.Error { Loc.dmsg = m; _ } ->
|
|
fail "reloading an edited package macro: %s" m);
|
|
(* And the C-c C-c after that reload, which is the one that reads the set the
|
|
session *kept* rather than the one [Load] just handed it. Both unions have
|
|
to prefer the new copy or this is where the old body reappears. *)
|
|
(match Session.eval ~origin:entry te "(defn grown [] i32 (p/grow 21))" with
|
|
| c ->
|
|
if not (has c.Session.ir "mul i32 21, 21") then
|
|
fail "a form evaluated after an edited package reloaded used the old macro"
|
|
| exception Loc.Error { Loc.dmsg = m; _ } ->
|
|
fail "a form evaluated after an edited package reloaded: %s" m);
|
|
List.iter
|
|
(fun f -> try Sys.remove f with Sys_error _ -> ())
|
|
[ Filename.concat pkg "p.flan"; entry ];
|
|
List.iter
|
|
(fun d -> try Unix.rmdir d with Unix.Unix_error _ -> ())
|
|
[ pkg; tmp ];
|
|
|
|
(* ── C-x C-e expands, which it never used to ────────────────────────
|
|
[Parse.expr] did not call the expander at all, so an expression typed at
|
|
the REPL saw no macros — not a package's and not the prelude's, which is
|
|
what said the gap was older than importable macros and not theirs. Both
|
|
halves are asserted here, in the session that [Dev.eval_expr] drives.
|
|
|
|
Asserting on the IR and not merely on the absence of an exception: an
|
|
expression that did not expand is an unknown name and therefore raises,
|
|
but an expression that expanded to the wrong thing does not, and the
|
|
arithmetic the macro chose is the only witness of which happened. *)
|
|
(match Session.eval_expr ~origin:"programs/pkg-macro.flan" tm "(mac/twice 21)" with
|
|
| c ->
|
|
if not (has c.Session.ir "21, 21") then
|
|
fail "a package macro through C-x C-e did not expand to its body"
|
|
| exception Loc.Error { Loc.dmsg = m; _ } ->
|
|
fail "a package macro through C-x C-e: %s" m);
|
|
(* The prelude's, which is the case that says this was always broken. *)
|
|
(match Session.eval_expr ~origin:"programs/pkg-macro.flan" tm "(unless false 1 2)" with
|
|
| _ -> ()
|
|
| exception Loc.Error { Loc.dmsg = m; _ } ->
|
|
fail "a prelude macro through C-x C-e: %s" m);
|
|
(* And with a pause on it, which is C-u C-x C-e. [Ast.pause_call] takes the
|
|
*expanded* expression's location, and expansion stamps every node a macro
|
|
answered with [Loc.from_macro] — which sets a name and leaves the file,
|
|
line and column the call site's, so the frame the break loop reports is
|
|
still the line the reader is looking at. Untested until now because every
|
|
pause case was an expression no macro touched. *)
|
|
(match Session.eval_expr ~origin:"programs/pkg-macro.flan" ~pause:true tm
|
|
"(mac/twice 21)" with
|
|
| _ -> ()
|
|
| exception Loc.Error { Loc.dmsg = m; _ } ->
|
|
fail "C-u C-x C-e on a macro call: %s" m);
|
|
|
|
(* Not the file's own macro, and deliberately not: [Macro.program] collects
|
|
those by scanning the forms it is handed, and the forms handed to an
|
|
evaluation are the one thing that was sent. That limit is the session's
|
|
and not this path's — C-c C-c has always had it too, for the same reason —
|
|
so it is left where it is rather than half-fixed here. Pinned so that the
|
|
day it changes, it changes on purpose. *)
|
|
(match Session.eval_expr ~origin:"programs/pkg-macro.flan" tm "(tenfold 7)" with
|
|
| _ -> fail "the file's own macro expanded in a session — a welcome change, \
|
|
but BUILT.md says it does not"
|
|
| exception Loc.Error _ -> ());
|
|
|
|
(* An expression that expands to a declaration. A macro may build one as a
|
|
value — that is what a quasiquote is for — but nothing can evaluate one,
|
|
so it is refused by name rather than arriving at the checker as an unknown
|
|
function called [defn]. Hand-typed here; the expanded case is the same
|
|
arm, because [Parse.expr] recurses and the head is the head either way. *)
|
|
(match Session.eval_expr ~origin:"programs/pkg-macro.flan" tm "(defn f [] i32 1)" with
|
|
| _ -> fail "a declaration was accepted as an expression"
|
|
| exception Loc.Error { Loc.dmsg = m; _ } ->
|
|
if not (has m "top-level declaration") then
|
|
fail "a declaration as an expression said %S" m);
|
|
(match Session.eval_expr ~origin:"programs/pkg-macro.flan" tm "(do 1 (defvar g i64))" with
|
|
| _ -> fail "a nested declaration was accepted as an expression"
|
|
| exception Loc.Error { Loc.dmsg = m; _ } ->
|
|
if not (has m "top-level declaration") then
|
|
fail "a nested declaration as an expression said %S" m);
|
|
|
|
(* The two non-termination refusals. They matter more here than in a build:
|
|
[eval_expr] runs inside the daemon, and a hang there wedges the editor
|
|
with the program still on screen and no way to say so. What has to be true
|
|
is that neither can loop before the wait in [Dev.eval_expr] begins — both
|
|
come back as [Loc.Error], which the daemon already answers as an error.
|
|
|
|
The spin is the one that fires on this path. [pkg-macro-idle.flan] imports
|
|
its package and calls nothing, so the session is created without expanding
|
|
anything — a fixture that called it would fail at [Session.create] and
|
|
prove nothing about an expression. The macro compiles, runs, and is
|
|
stopped by the fuel, here and not earlier.
|
|
|
|
The ring is the one that cannot be reached from here, and finding out why
|
|
is the useful part: a ring is refused while the *package it lives in* is
|
|
parsed, because that file's own bodies name each other. So no importer of
|
|
a ring can be loaded and no session over one can exist — the refusal is in
|
|
front of this path rather than on it, which is the stronger place for it.
|
|
Asserted at creation, so that a change moving the check later would be
|
|
caught here rather than becoming a hang in the daemon. *)
|
|
(match Session.create ~file:"programs/pkg-macro-ring.flan" () with
|
|
| _ -> fail "a session over a ring of package macros was created"
|
|
| exception Loc.Error { Loc.dmsg = m; _ } ->
|
|
if not (has m "call each other") then
|
|
fail "creating a session over a macro ring said %S" m);
|
|
let ti, _ = Session.create ~file:"programs/pkg-macro-idle.flan" () in
|
|
(match Session.eval_expr ~origin:"programs/pkg-macro-idle.flan" ti "(s/spin)" with
|
|
| _ -> fail "a macro that does not settle was accepted through C-x C-e"
|
|
| exception Loc.Error { Loc.dmsg = m; _ } ->
|
|
if not (has m "did not settle") then
|
|
fail "a macro that does not settle, through C-x C-e, said %S" m);
|
|
(* And the session is still usable afterwards, which is the property the
|
|
whole of this file is about: a refusal that killed it would wedge the
|
|
editor just as thoroughly as the hang it is preventing. *)
|
|
(match Session.eval_expr ~origin:"programs/pkg-macro-idle.flan" ti "(mac/twice 21)" with
|
|
| _ -> ()
|
|
| exception Loc.Error { Loc.dmsg = m; _ } ->
|
|
fail "a session that refused a macro could not evaluate afterwards: %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
|