1321 lines
72 KiB
OCaml
1321 lines
72 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 fail fmt = Test_support.fail fmt
|
|
let has = Test_support.contains
|
|
|
|
(* sand.flan is the workspace's own program, edited by hand and not by this
|
|
suite, and three cases below read it: it is the file with imports, and it is
|
|
the single-file package. While it calls the randomness functions by names
|
|
the prelude does not have it does not check at all, and those three would be
|
|
reporting that rather than anything about a session. The fixture decides,
|
|
so there is nothing to undo once sand.flan is brought up to date. *)
|
|
let sand_checks =
|
|
match In_channel.with_open_bin "../sand.flan" In_channel.input_all with
|
|
(* The open paren and not the bare name — see test_acceptance.ml, which
|
|
guards on the same file for the same reason: sand.flan names rand-f32 in
|
|
a comment as well, and matching that would leave these skipped for ever.
|
|
*)
|
|
| src -> not (has src "(rand-f32")
|
|
| exception _ -> false
|
|
|
|
(* 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 = Test_support.checked
|
|
|
|
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";
|
|
(* Dyn-ness is part of a signature like anything else, and this falls out of
|
|
[compatible] rather than being added to it: the comparison is
|
|
[Types.equal] over the parameters and the return, and dyn is equal to
|
|
itself and to nothing else. Pinned anyway, because it is the one place the
|
|
word "signature" covers a change the source does not spell out — the
|
|
return type here went from [i64] to [dyn] by being written differently,
|
|
and a parameter can change the same way by a *type* being declared
|
|
elsewhere in the program. *)
|
|
refuses "a return type that became dyn"
|
|
"(defn outer [] dyn (bump))"
|
|
"changes signature";
|
|
refuses "a parameter that became dyn"
|
|
"(defn outer [x] 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"
|
|
"(defonce 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);
|
|
|
|
(* "Exactly as it was" is about every field the session holds, not only the
|
|
declarations, and the imported macro set is the one that used to be
|
|
written before the checker ran rather than after it. A refused form that
|
|
brought an import with it would have left the session holding the
|
|
package's macros while holding none of its declarations — accepting half
|
|
of a change it reported as refused, which is the state a daemon that
|
|
answers and has lost track of the program is made of.
|
|
|
|
Asserted from the other side, because the set itself is private: after the
|
|
refusal, a form that calls the package's macro has to be an unknown name.
|
|
If the macros had been kept, this would instead build a macro module and
|
|
expand — and the expansion would name [mac/twice], which the session has
|
|
no declaration for. *)
|
|
(let mt, _ = Session.create ~file:"programs/reload.flan" () in
|
|
(match Session.eval mt "(import mac \"pkgs/mac\") (defn bump [] i64 nonsense)" with
|
|
| _ -> fail "an import beside an unresolvable name was accepted"
|
|
| exception Loc.Error _ -> ());
|
|
match Session.eval mt "(defn bump [] i64 (mac/twice 3))" with
|
|
| _ ->
|
|
fail "a refused evaluation left the session holding the import's macros"
|
|
| exception Loc.Error { Loc.dmsg = m; _ } ->
|
|
(* By name, so that this cannot pass on some other refusal: what is being
|
|
asserted is that [mac/twice] never became a name here. *)
|
|
if not (has m "mac/twice") then
|
|
fail "the refusal after a rolled-back import was about something \
|
|
else: %S" m);
|
|
|
|
(* And the same question asked of [eval_expr], which keeps state of its own:
|
|
a copy of a generic it instantiated stays in the session's program,
|
|
because the module that carries it is about to be built and loaded. A
|
|
refusal must add nothing — the session would otherwise believe it holds a
|
|
body no module was ever written for, and would not emit it again.
|
|
|
|
What this reaches is the refusal every REPL meets, which is the checker's,
|
|
and the checker's is *before* any copy is generated. The window after one
|
|
is generated is closed by where the assignment sits — below [Emit], the
|
|
last thing in [eval_expr] that can raise — and not by anything here: an
|
|
[Emit] that raised would be a compiler bug, and there is no way to ask for
|
|
one from out here. What is left uncovered by both is [Check.expression]'s
|
|
own mutation: the copy is recorded in the env whether or not the rest
|
|
succeeds, and nothing rolls that back. *)
|
|
(let xt, _ = Session.create ~file:"programs/reload-generic.flan" () in
|
|
let count () = List.length xt.Session.program.Tast.fns in
|
|
let before = count () in
|
|
(match Session.eval_expr xt "(pick (slice [1.5 0.5] 0 2) nonsense)" with
|
|
| _ -> fail "a bad expression was accepted"
|
|
| exception Loc.Error _ -> ());
|
|
if count () <> before then
|
|
fail "a refused expression left %d functions in the session, not %d"
|
|
(count ()) before;
|
|
(* Still usable, and still able to generate the copy the refused one did
|
|
not: the recovery half of the same claim. *)
|
|
match Session.eval_expr xt "(println (pick (slice [1.5 0.5] 0 2)))" with
|
|
| e ->
|
|
if not (has e.Session.ir "pick-f64") then
|
|
fail "the expression after a refused one carried no copy"
|
|
| exception Loc.Error { Loc.dmsg = m; _ } ->
|
|
fail "the session was poisoned by a bad expression: %s" m);
|
|
|
|
(* The other half of "a refusal costs nothing", and the half that used to be
|
|
missing: a form can check and *then* fail, in the build or at the agent,
|
|
and the session that already accepted it has no way to hear about it
|
|
unless the caller puts it back. [Session.held] and [Session.restore] are
|
|
that way, and this is the crash they close.
|
|
|
|
Rehearsed rather than simulated: neither llc nor a full reload ring can be
|
|
summoned from here, and what matters is not which of them failed but what
|
|
the session does afterwards. So the declaration is accepted, shown to be
|
|
callable — the module for an expression that calls it names it, which is
|
|
the name a later install prologue would intern a cell for and never store
|
|
a body into — and then the session is put back and asked again.
|
|
|
|
Both sides are asserted. Without the first, a test that only checked the
|
|
refusal would pass on a session that had never accepted the [defn] at
|
|
all. *)
|
|
(let rt, _ = Session.create ~file:"programs/reload.flan" () in
|
|
let h = Session.held rt in
|
|
(match Session.eval rt "(defn stranded [] i64 7)" with
|
|
| c ->
|
|
if c.Session.fns <> [ "stranded" ] then
|
|
fail "a new declaration did not offer its body to install"
|
|
| exception Loc.Error { Loc.dmsg = m; _ } ->
|
|
fail "a new declaration was refused: %s" m);
|
|
(match Session.eval_expr rt "(println (stranded))" with
|
|
| e ->
|
|
if not (has e.Session.ir "stranded") then
|
|
fail "an expression calling a fresh declaration did not name it"
|
|
| exception Loc.Error { Loc.dmsg = m; _ } ->
|
|
fail "a fresh declaration was not callable: %s" m);
|
|
Session.restore rt h;
|
|
(* The module that would have jumped to address 0. After the restore the
|
|
name is simply not one this session has, which is the whole of the
|
|
fix: a refusal in the editor instead of a segfault in the program. *)
|
|
(match Session.eval_expr rt "(println (stranded))" with
|
|
| _ ->
|
|
fail "a restored session still let an undelivered declaration be called"
|
|
| exception Loc.Error { Loc.dmsg = m; _ } ->
|
|
if not (has m "stranded") then
|
|
fail "the refusal after a restore was about something else: %S" m);
|
|
(* And it is a restore, not a poisoning: the same form offered again is
|
|
accepted again, which is what an editor does after reading the error. *)
|
|
match Session.eval rt "(defn stranded [] i64 7)" with
|
|
| c ->
|
|
if c.Session.fns <> [ "stranded" ] then
|
|
fail "a re-sent declaration did not offer its body to install"
|
|
| exception Loc.Error { Loc.dmsg = m; _ } ->
|
|
fail "the session was poisoned by a restore: %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 "(defonce 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 "(defonce 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";
|
|
|
|
(* A *computed* initialiser is the other half of the same rule and answers
|
|
the opposite way: it runs at startup, from main, and a module is loaded
|
|
rather than started — so a name the program is meeting for the first time
|
|
starts as ZII rather than re-running anything. The null is what says so,
|
|
and the absence of a second image is what proves the initialiser did not
|
|
travel as code. Re-running one is exactly what would wipe the state a
|
|
reload exists to preserve. *)
|
|
let c = Session.eval t "(defonce computed i64 (+ 20 2)) (defn read-computed [] i64 computed)" in
|
|
if not (has c.Session.ir "to i64), ptr null)") then
|
|
fail "a new computed global did not start zeroed";
|
|
if not c.Session.installs then fail "adding a computed global had nothing to install";
|
|
|
|
(* And the same claim for the form that makes it hard. Every [def]
|
|
initialiser is lifted into [global/<n>] so a re-evaluation can swap it
|
|
through the function cell, so a def's own [ginit] is a call and never a
|
|
constant — and asking [Tast.const_init] about it would hand a brand-new
|
|
(def n i64 42) calloc's zero for the life of the process, with no
|
|
startup in the host to ever put 42 there. [Emit.initial_image] reads the
|
|
constant back out of the lifted body, which is where it went. The
|
|
defonce two rows above is what this is being compared against. *)
|
|
let c = Session.eval t "(def started-def i64 42) (defn read-sd [] i64 started-def)" in
|
|
if not (has c.Session.ir "@\".init.") then
|
|
fail "a new def's initial value was dropped";
|
|
if has c.Session.ir "@\"flan.started-def\"), i64 ptrtoint (ptr getelementptr (i64, ptr null, i32 1) to i64), ptr null)"
|
|
then fail "a new def was allocated with a null image";
|
|
(* The def's own half of the computed rule, which answers the same way the
|
|
defonce's does: nothing to write, so the storage is ZII. *)
|
|
let c =
|
|
Session.eval t
|
|
"(defn seed-def [] i64 22) (def computed-def i64 (seed-def)) \
|
|
(defn read-cd [] i64 computed-def)"
|
|
in
|
|
if not (has c.Session.ir "to i64), ptr null)") then
|
|
fail "a new computed def did not start zeroed";
|
|
|
|
(* Which of the two mutable forms declared a global is in the *startup
|
|
function*, compiled when the process started — the guard a defonce has
|
|
and a def does not. A reload republishes the initialiser and cannot
|
|
republish that, so swapping the keyword would load cleanly and then keep
|
|
doing what the old keyword said. Refused, both ways.
|
|
|
|
The host's own globals, both of them read by nothing, so the checker has
|
|
no complaint and the session is the only thing that can refuse: [spare]
|
|
is a defonce and [paint] is a def. *)
|
|
(match Session.eval t "(def spare i64 0)" with
|
|
| _ -> fail "defonce became def without a word"
|
|
| exception Loc.Error { Loc.dmsg = m; _ } ->
|
|
if not (has m "spare changes from defonce to def") then
|
|
fail "the defonce-to-def refusal says: %s" m;
|
|
if not (has m "Restart to change it") then
|
|
fail "the form-change refusal does not say what to do: %s" m);
|
|
(match Session.eval t "(defonce paint i64 7)" with
|
|
| _ -> fail "def became defonce without a word"
|
|
| exception Loc.Error { Loc.dmsg = m; _ } ->
|
|
if not (has m "paint changes from def to defonce") then
|
|
fail "the def-to-defonce refusal says: %s" m);
|
|
(* The constant is the third form and the same fact, and the direction
|
|
into it is the one that does damage rather than nothing: a constant the
|
|
checker never folded is republished *by value* at the frame boundary, so
|
|
accepting this would store 7 over storage holding whatever the running
|
|
program has put there since — "edit the code, keep the sand" undone by a
|
|
keyword. The other direction gets no store at all, because the host's
|
|
startup has none for a name that was an image when it was compiled. *)
|
|
(match Session.eval t "(defconst paint i64 7)" with
|
|
| _ -> fail "def became defconst without a word"
|
|
| exception Loc.Error { Loc.dmsg = m; _ } ->
|
|
if not (has m "paint changes from def to defconst") then
|
|
fail "the def-to-defconst refusal says: %s" m);
|
|
(* [palette] is the host's *unfolded* constant — the one a dev build emits
|
|
as mutable storage and the [consts] list republishes — so it is exactly
|
|
the one where the form change would reach live bytes. *)
|
|
(match Session.eval t "(defonce palette [2 u32] [1 2])" with
|
|
| _ -> fail "defconst became defonce without a word"
|
|
| exception Loc.Error { Loc.dmsg = m; _ } ->
|
|
if not (has m "palette changes from defconst to defonce") then
|
|
fail "the defconst-to-defonce refusal says: %s" m);
|
|
(* Editing the *value* of a def is the workflow and stays allowed: same
|
|
form, same type, a new initialiser, and the lifted [global/paint]
|
|
republished through its cell so the next re-run stores the edited value.
|
|
This is the one the whole form exists for. *)
|
|
(match Session.eval t "(def paint i64 9)" with
|
|
| c ->
|
|
if not (List.mem "global/paint" c.Session.fns) then
|
|
fail "editing a def's value did not republish its initialiser: %s"
|
|
(String.concat " " c.Session.fns)
|
|
| exception Loc.Error { Loc.dmsg = m; _ } ->
|
|
fail "editing a def's value was refused: %s" m);
|
|
(* A def is storage like any other, so retyping one is the same refusal a
|
|
defonce gets — reasoned when the form landed, exercised here. *)
|
|
(match Session.eval t "(def paint i32 9)" with
|
|
| _ -> fail "a def was retyped without a word"
|
|
| exception Loc.Error { Loc.dmsg = m; _ } ->
|
|
if not (has m "paint changes type") then
|
|
fail "retyping a def says: %s" m);
|
|
(* A def initialiser that reads another global at run time, which is a
|
|
different claim from the static ordering the checker sorts on: the
|
|
lifted function loads [counter] when it runs, so re-evaluating it is an
|
|
ordinary republish and the read is the running program's storage. *)
|
|
(match Session.eval t "(def paint i64 (+ counter 1))" with
|
|
| c ->
|
|
if not (List.mem "global/paint" c.Session.fns) then
|
|
fail "a def initialiser reading a global was not republished"
|
|
| exception Loc.Error { Loc.dmsg = m; _ } ->
|
|
fail "a def initialiser reading a global was refused: %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 "(defonce 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 method added to a running program ────────────────────────
|
|
The dev loop is what classes were built for, so this is the case that
|
|
decides whether the feature is usable at all. A generic function is one
|
|
top-level name whose body dispatches, and a method is a branch of it —
|
|
so adding a method has to install the *generic's* body, not a function
|
|
of the method's own, and it has to do it through the cell the call site
|
|
already goes through. If it reported only the method's own declaration
|
|
name, [report]'s compiled call to [area] would go on running the body it
|
|
was built with and the new method would be invisible. *)
|
|
let t, _ = Session.create ~file:"programs/dev-class.flan" () in
|
|
let c = Session.eval t "(defmethod area circle [c] (* 3 (* (get c :r) (get c :r))))" in
|
|
if not c.Session.installs then
|
|
fail "adding a method had nothing to install";
|
|
if not (List.mem "area" c.Session.fns) then
|
|
fail "adding a method installed %s, not the generic's body"
|
|
(String.concat " " c.Session.fns);
|
|
(* Redefining one is the same path, and the declaration is replaced rather
|
|
than appended: a second (defmethod area circle ...) is not a duplicate
|
|
method, it is this one again. *)
|
|
let c = Session.eval t "(defmethod area circle [c] 0)" in
|
|
if not (List.mem "area" c.Session.fns) then
|
|
fail "redefining a method installed %s" (String.concat " " c.Session.fns);
|
|
(* And it stays in the session: the class the method dispatches on, the
|
|
generic it extends, and the method itself are all still there for the
|
|
next form to check against. *)
|
|
(match Session.eval t "(defmethod area point [p] (+ (get p :x) (get p :y)))" with
|
|
| _ -> ()
|
|
| exception Loc.Error { Loc.dmsg = m; _ } ->
|
|
fail "a method added earlier left the session broken: %s" m);
|
|
(* A method for a class that is not there is refused, and refusing leaves
|
|
the session exactly as it was — the same rule every other refusal here
|
|
follows. *)
|
|
(match Session.eval t "(defmethod area square [s] 1)" with
|
|
| _ -> fail "a method dispatching on an unknown class was accepted"
|
|
| exception Loc.Error _ -> ());
|
|
(* A whole new class and a method for it, in one form — the shape of
|
|
actually growing a program in the loop. The constructor is a name the
|
|
process was never built with, so it goes through the registry the way
|
|
any added function does, and the generic is redefined around it. *)
|
|
let c =
|
|
Session.eval t
|
|
"(do (defclass square [s]) (defmethod area square [q] (* (get q :s) (get q :s))))"
|
|
in
|
|
if not (List.mem "square" c.Session.fns && List.mem "area" c.Session.fns) then
|
|
fail "adding a class and a method installed %s"
|
|
(String.concat " " c.Session.fns);
|
|
|
|
(* 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. *)
|
|
if not sand_checks then
|
|
print_endline
|
|
"session: skipping the cases that read sand.flan — it calls rand-f32, \
|
|
which is not a name"
|
|
else begin
|
|
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.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)
|
|
end;
|
|
|
|
(* 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);
|
|
|
|
(* ── And the file's own macro, which used to be pinned as refused ──────
|
|
[Macro.program] collects macros by scanning the forms it is handed, and
|
|
the forms handed to an evaluation are the one thing that was sent — so
|
|
[tenfold], declared in the buffer being edited, was an unknown name at
|
|
both C-x C-e and C-c C-c while the prelude's and a package's both worked.
|
|
The session holds it now, seeded in [Session.create] from the same read
|
|
that produced [decls].
|
|
|
|
On the IR, not on the absence of an exception: an expression that did not
|
|
expand raises, but one that expanded to the wrong thing does not, and the
|
|
arithmetic is the only witness. [tenfold] multiplies its argument by
|
|
ten. *)
|
|
(match Session.eval_expr ~origin:"programs/pkg-macro.flan" tm "(tenfold 7)" with
|
|
| c ->
|
|
if not (has c.Session.ir "7, 10") then
|
|
fail "the file's own macro through C-x C-e did not expand to its body"
|
|
| exception Loc.Error { Loc.dmsg = m; _ } ->
|
|
fail "the file's own macro through C-x C-e: %s" m);
|
|
(* The other path, which is a different expander wrap: [Parse.decl]'s. *)
|
|
(match Session.eval ~origin:"programs/pkg-macro.flan" tm
|
|
"(defn tenfolded [] i32 (tenfold 7))"
|
|
with
|
|
| c ->
|
|
if not (List.mem "tenfolded" c.Session.fns) then
|
|
fail "the file's own macro through C-c C-c reported %s"
|
|
(String.concat " " c.Session.fns);
|
|
if not (has c.Session.ir "7, 10") then
|
|
fail "the file's own macro through C-c C-c did not expand to its body"
|
|
| exception Loc.Error { Loc.dmsg = m; _ } ->
|
|
fail "the file's own macro through C-c C-c: %s" m);
|
|
|
|
(* A [defmacro] the file never had, typed at the editor. This is the shape
|
|
the fix chose — a macro evaluated into the session *joins* it, exactly as
|
|
a [defn] does, and the next evaluation can call it — and it is the only
|
|
case here that the create-time seed cannot explain. Two evaluations,
|
|
because that is what the claim is about. *)
|
|
(match Session.eval ~origin:"programs/pkg-macro.flan" tm
|
|
"(defmacro thrice [& args] `(* ~(at args 0) 3))"
|
|
with
|
|
| _ -> ()
|
|
| exception Loc.Error { Loc.dmsg = m; _ } ->
|
|
fail "evaluating a defmacro: %s" m);
|
|
(match Session.eval_expr ~origin:"programs/pkg-macro.flan" tm "(thrice 5)" with
|
|
| c ->
|
|
if not (has c.Session.ir "5, 3") then
|
|
fail "a defmacro evaluated into the session did not expand to its body"
|
|
| exception Loc.Error { Loc.dmsg = m; _ } ->
|
|
fail "a defmacro evaluated into the session: %s" m);
|
|
(* And re-evaluating it over the top expands with the *new* body. Left-wins
|
|
in [Session.eval]'s union and in [Macro.program]'s merge, which is the
|
|
ordinary editing action and the one that would have reached
|
|
[Check.program] as a duplicate declaration without the second of those. *)
|
|
(match Session.eval ~origin:"programs/pkg-macro.flan" tm
|
|
"(defmacro thrice [& args] `(* ~(at args 0) 4))"
|
|
with
|
|
| _ -> ()
|
|
| exception Loc.Error { Loc.dmsg = m; _ } ->
|
|
fail "re-evaluating a defmacro: %s" m);
|
|
(match Session.eval_expr ~origin:"programs/pkg-macro.flan" tm "(thrice 5)" with
|
|
| c ->
|
|
if has c.Session.ir "5, 3" then
|
|
fail "an edited defmacro expanded with its old body"
|
|
else if not (has c.Session.ir "5, 4") then
|
|
fail "an edited defmacro did not expand to its new body"
|
|
| exception Loc.Error { Loc.dmsg = m; _ } ->
|
|
fail "an edited defmacro: %s" m);
|
|
|
|
(* The robustness lane's property, held for macros too: the commit is below
|
|
the checker, so a [defmacro] that does not check leaves the session
|
|
holding nothing of it. The body calls an unknown name, so the form parses
|
|
and fails at the checker — which is the only interesting place to fail,
|
|
because a parse failure never reaches the union either. *)
|
|
(match Session.eval ~origin:"programs/pkg-macro.flan" tm
|
|
"(defmacro nope [& args] (no-such-function args))"
|
|
with
|
|
| _ -> fail "a defmacro whose body does not check was accepted"
|
|
| exception Loc.Error _ -> ());
|
|
(match Session.eval_expr ~origin:"programs/pkg-macro.flan" tm "(nope 1)" with
|
|
| _ -> fail "a refused defmacro was left in the session's macro set"
|
|
| 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 "cannot be used as an expression here") then
|
|
fail "a declaration as an expression said %S" m);
|
|
(match Session.eval_expr ~origin:"programs/pkg-macro.flan" tm "(do 1 (defonce g i64))" with
|
|
| _ -> fail "a nested declaration was accepted as an expression"
|
|
| exception Loc.Error { Loc.dmsg = m; _ } ->
|
|
if not (has m "cannot be used as an expression here") 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);
|
|
|
|
(* ── C-c C-m: what a macro call expands to ─────────────────────────
|
|
|
|
The verb that compiles nothing and sends nothing. What it has to get right
|
|
is the set it expands against: whatever *this session* holds, which is the
|
|
prelude's macros, the ones its imports brought in, and every [defmacro]
|
|
the buffer has evaluated since it started. A fresh read of the file would
|
|
answer with a different set and with whatever is saved rather than what is
|
|
typed, and an expansion that disagreed with an evaluation is the quietest
|
|
wrongness there is — a macro decides what the code *is*.
|
|
|
|
Asserted on the printed text, because the printed text is the whole of
|
|
what a person is shown. There is no IR to read here and nothing to compare
|
|
structurally: a [Form] carries a [Loc.t] and [Loc.from_macro] stamps a
|
|
name onto every node a macro answers, so even an identity expansion is
|
|
structurally unequal to its input. *)
|
|
let expands ?(all = false) name src want =
|
|
match Session.macroexpand ~origin:"programs/pkg-macro.flan" ~all tm src with
|
|
| x ->
|
|
let got = Form.to_source x.Session.xafter in
|
|
if got <> want then
|
|
fail "%s\n got: %S\n wanted: %S" name got want
|
|
| exception Loc.Error { Loc.dmsg = m; _ } -> fail "%s: %s" name m
|
|
in
|
|
(* A prelude macro: ambient, in every session, and the set that worked before
|
|
any of this existed. *)
|
|
expands "a prelude macro, one step" "(unless false 1 2)"
|
|
"(if (not false) (do 1 2))";
|
|
(* An imported package's, arriving qualified. This is most of the argument
|
|
for the feature: the definition is in another directory and cannot be read
|
|
beside the call site any more. *)
|
|
expands "an imported package macro, one step" "(mac/twice 4)" "(+ 4 4)";
|
|
(* The buffer's own, which is the set a session had to start holding before
|
|
an editor could ask anything about it. *)
|
|
expands "the file's own macro, one step" "(tenfold 7)" "(* 7 10)";
|
|
(* And the one that makes the two commands different rather than one with a
|
|
flag: [quad] quasiquotes a call to [twice], so a single step stops with a
|
|
macro call still in it and the full expansion does not. Both are true and
|
|
they answer different questions. *)
|
|
expands "a macro that expands to a call to another macro, one step"
|
|
"(mac/quad 3)" "(mac/twice (mac/twice 3))";
|
|
expands ~all:true "a macro that expands to a call to another macro, all the way"
|
|
"(mac/quad 3)" "(+ (+ 3 3) (+ 3 3))";
|
|
(* Outermost-only, which is where one step and the compiler's own first move
|
|
deliberately differ: [expand_form] expands a call's *arguments* before
|
|
calling it, so the compiler's first move here is [(mac/twice (+ 3 3))].
|
|
Same fixpoint, different intermediate, and the intermediate is the whole
|
|
of what one step is for. *)
|
|
expands "one step does not expand the arguments first"
|
|
"(mac/twice (mac/twice 3))" "(+ (mac/twice 3) (mac/twice 3))";
|
|
(* One macro written both ways, expanded to the same text. [tenfold] picks
|
|
its argument out of the slice by hand and [tenfold-listed] names it in the
|
|
parameter list; there is one grammar under both, so the two expansions
|
|
have to be the same string and not merely the same shape.
|
|
|
|
This is the migration's evidence. Every [defmacro] in the tree was
|
|
rewritten from [args] to [& args] when the list stopped meaning "the whole
|
|
call" and started meaning "the first argument", and what makes that a
|
|
spelling change rather than a behaviour change is exactly this. *)
|
|
expands "a macro that picks its argument out by hand" "(tenfold 7)" "(* 7 10)";
|
|
expands "the same macro with a parameter list" "(tenfold-listed 7)" "(* 7 10)";
|
|
|
|
(* And the call-site check on this path, which is the editor's rather than a
|
|
build's. [Macro.checked_call] is one function for all four ways in — the
|
|
walk, [settle], C-c C-m's one step and its fixpoint — so C-c C-m over a
|
|
miscounted call refuses with the sentence a build would give. *)
|
|
(match Session.macroexpand ~origin:"programs/pkg-macro.flan" ~all:false tm
|
|
"(tenfold-listed 1 2)"
|
|
with
|
|
| _ -> fail "C-c C-m expanded a macro call with the wrong arity"
|
|
| exception Loc.Error { Loc.dmsg = m; _ } ->
|
|
if not (has m "tenfold-listed takes 1 argument and this call gives 2")
|
|
then fail "C-c C-m over a miscounted call said: %s" m);
|
|
|
|
(* Not a macro call at all. The form comes back as it was, and the answer
|
|
that matters is [xmacro]: nothing ran. *)
|
|
(match Session.macroexpand ~origin:"programs/pkg-macro.flan" ~all:false tm
|
|
"(+ 1 2)"
|
|
with
|
|
| x ->
|
|
if x.Session.xchanged || x.Session.xmacro <> None then
|
|
fail "a form whose head is not a macro reported a macro"
|
|
| exception Loc.Error { Loc.dmsg = m; _ } ->
|
|
fail "expanding a form that is not a macro call: %s" m);
|
|
(* And the name of the macro that ran, which is the one thing the text cannot
|
|
carry: [Loc.from_macro] is outermost-wins, so a full expansion is stamped
|
|
with the macro the author wrote and every intermediate name is gone. *)
|
|
(match Session.macroexpand ~origin:"programs/pkg-macro.flan" ~all:false tm
|
|
"(mac/quad 3)"
|
|
with
|
|
| x when x.Session.xmacro = Some "mac/quad" -> ()
|
|
| x ->
|
|
fail "expanding (mac/quad 3) named %s"
|
|
(match x.Session.xmacro with None -> "nothing" | Some n -> n)
|
|
| exception Loc.Error { Loc.dmsg = m; _ } -> fail "naming the macro: %s" m);
|
|
|
|
(* The session is not touched by having been asked. [eval] commits
|
|
[t.macros], [eval_expr] bumps [t.thunks] and [t.program]; this writes
|
|
nothing, so a [defmacro] handed to C-c C-m must not join the session by
|
|
having been looked at. C-c C-c is where a declaration goes.
|
|
|
|
The head is not a macro, so nothing expands; the claim is about the
|
|
*aftermath*, and it is checked the only way it can be — by calling the
|
|
name and requiring it to still be unknown. *)
|
|
(match Session.macroexpand ~origin:"programs/pkg-macro.flan" ~all:false tm
|
|
"(defmacro looked-at [& args] `(* ~(at args 0) 5))"
|
|
with
|
|
| _ -> ()
|
|
| exception Loc.Error { Loc.dmsg = m; _ } ->
|
|
fail "expanding a defmacro: %s" m);
|
|
(match Session.eval_expr ~origin:"programs/pkg-macro.flan" tm "(looked-at 3)" with
|
|
| _ -> fail "a defmacro joined the session by being macroexpanded"
|
|
| exception Loc.Error _ -> ());
|
|
|
|
(* Non-termination, on this path, in both directions.
|
|
|
|
One step makes exactly one call and does not look at what comes back, so
|
|
[(s/spin)] one-stepped is a fact about the macro and terminates — the
|
|
bound must be where it is needed and nowhere else, or the command would
|
|
refuse to show anybody the thing they are trying to see.
|
|
|
|
All the way is the path with the fuel on it, and what has to be true is
|
|
that the bound is *reached* rather than the daemon hanging: a hang here
|
|
wedges the editor with the program still running and no way to say so.
|
|
[Loc.Error] out of this call is what [Dev.serve]'s guard answers as a
|
|
reply. *)
|
|
(match Session.macroexpand ~origin:"programs/pkg-macro-idle.flan" ~all:false ti
|
|
"(s/spin)"
|
|
with
|
|
| x ->
|
|
if Form.to_source x.Session.xafter <> "(s/spin)" then
|
|
fail "one step of a macro that does not settle answered %S"
|
|
(Form.to_source x.Session.xafter)
|
|
else if x.Session.xchanged then
|
|
fail "one step of a macro that expands to itself reported a change"
|
|
else if x.Session.xmacro <> Some "s/spin" then
|
|
fail "one step of a macro that does not settle did not name it"
|
|
| exception Loc.Error { Loc.dmsg = m; _ } ->
|
|
fail "one step of a macro that does not settle was refused: %s" m);
|
|
(match Session.macroexpand ~origin:"programs/pkg-macro-idle.flan" ~all:true ti
|
|
"(s/spin)"
|
|
with
|
|
| _ -> fail "a macro that does not settle was expanded all the way"
|
|
| exception Loc.Error { Loc.dmsg = m; _ } ->
|
|
if not (has m "did not settle") then
|
|
fail "expanding a macro that does not settle all the way said %S" m);
|
|
(* And the session survives the refusal, as it does after an evaluation that
|
|
was refused. *)
|
|
(match Session.macroexpand ~origin:"programs/pkg-macro-idle.flan" ~all:true ti
|
|
"(mac/twice 21)"
|
|
with
|
|
| x ->
|
|
if Form.to_source x.Session.xafter <> "(+ 21 21)" then
|
|
fail "after a refused expansion, (mac/twice 21) expanded to %S"
|
|
(Form.to_source x.Session.xafter)
|
|
| exception Loc.Error { Loc.dmsg = m; _ } ->
|
|
fail "a session that refused an expansion could not expand afterwards: %s" m);
|
|
|
|
(* ── A type provider, expanded ─────────────────────────────────────
|
|
Two claims, and they are the two halves of the live-tuning loop.
|
|
|
|
The first is the path. A macro that reads a data file resolves it the way
|
|
(embed "...") does — against the directory of the source file the *form*
|
|
is written in — and a macro cannot know where that is, because a Form
|
|
carries no location. The compiler pokes the call site's directory in
|
|
before every expansion, and the call site here is an origin the editor
|
|
sent, not a file on a command line. "assets/edn/tuning.edn" is beside
|
|
programs/edn-provide.flan and nowhere near this process's directory, so an
|
|
expansion that answered anything at all read the right file.
|
|
|
|
The second is that the answer is readable. `C-c C-m` over a provider is
|
|
the only way to see what it decided, and a provider whose output nobody
|
|
can look at is a plugin. So this asserts on text a person would recognise:
|
|
the struct with its fields and derived types, the nested struct named for
|
|
its path, and the reader's dispatch on a key. Asserted as substrings
|
|
rather than in full — the expansion is some hundreds of characters and a
|
|
golden copy of it would fail on every comment reflowed in the derivation.
|
|
|
|
It also re-reads on every expansion, which is what makes editing the .edn
|
|
and hitting C-c C-m a loop: nothing is cached but the macro module, and
|
|
that holds the macro's code, not the data. *)
|
|
(let pt, _ = Session.create ~file:"programs/edn-provide.flan" () in
|
|
match
|
|
Session.macroexpand ~origin:"programs/edn-provide.flan" ~all:false pt
|
|
"(edn/defedn Tuning \"assets/edn/tuning.edn\")"
|
|
with
|
|
| x ->
|
|
let got = Form.to_source x.Session.xafter in
|
|
List.iter
|
|
(fun want ->
|
|
if not (has got want) then
|
|
fail "expanding a defedn: %S is not in\n%s" want got)
|
|
[ (* The struct, with a type per field derived from the value. *)
|
|
"(defstruct Tuning [name string hp i64 speed f64 boss? bool";
|
|
(* The vector, and the constructor that states its type so that
|
|
(vec-new) has something to take it from. *)
|
|
"drops (Vec i64)";
|
|
(* The nested map, named for the path that reaches it, and the one
|
|
nested inside that. *)
|
|
"(defstruct Tuning-hitbox-offset [x i64 y i64])";
|
|
"hitbox Tuning-hitbox";
|
|
(* And the reader, dispatching on a key onto a field. *)
|
|
"(edn/keyword=? k \"speed\")";
|
|
"(set (.speed out) (edn/need-float c))" ]
|
|
| exception Loc.Error { Loc.dmsg = m; _ } ->
|
|
fail "expanding a defedn through a session: %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. *)
|
|
if sand_checks then begin
|
|
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)
|
|
end;
|
|
|
|
(* 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-at] that [hold] pulls in has to be
|
|
there too, which is transitivity. *)
|
|
(match Session.eval (gen ()) "(defn hold [xs [$t] v $t] () (put-at xs 0 v) (put-at 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-at] did not change, and its copies are
|
|
reached through their cells, so reinstalling them would be work with
|
|
no effect. *)
|
|
if List.mem "put-at-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-at] reinstalls the copies
|
|
of [put-at], 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-at [xs [$t] i i32 v $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-at-i32"; "put-at-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-at xs 0 v)] checking, because the literal
|
|
adapts, and changes [put-at-i32]'s signature underneath every compiled
|
|
caller. *)
|
|
(match
|
|
Session.eval (gen ())
|
|
"(defn put-at [xs [$t] i i64 v $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-at") then
|
|
fail "the refusal did not say the name came from put-at: %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)} (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);
|
|
|
|
(* ── A class whose slots changed ────────────────────────────────
|
|
The dev loop's half of CLHS 4.3.6. Three things have to be true of the
|
|
session for the runtime's migration to ever be reached: a changed slot
|
|
list has to be *accepted*, the module has to carry the registration that
|
|
tells the runtime about it, and the case where accepting it would be
|
|
unsound has to stay refused. test_dev.ml runs the protocol against a
|
|
real program; these are the decisions taken before any of it is built.
|
|
|
|
Accepted first. A slot added is a constructor taking one more argument,
|
|
which is the signature change [compatible] refuses by default — and
|
|
rightly, since a call site compiled to pass two dyn words into a
|
|
three-parameter body leaves the third holding a register. Nothing in
|
|
dev-class.flan calls [point], so there is no such call site and the
|
|
refusal has nothing to protect. *)
|
|
(let t, _ = Session.create ~file:"programs/dev-class.flan" () in
|
|
match Session.eval t "(defclass point [x y z])" with
|
|
| c ->
|
|
if not (List.mem "point" c.Session.fns) then
|
|
fail "adding a slot to a class installed %s"
|
|
(String.concat " " c.Session.fns);
|
|
(* The registration, and the thunk that runs it. Without the first the
|
|
runtime never hears that the class changed; without the second the
|
|
module defines a function nothing calls.
|
|
|
|
[call void @] and not the bare symbol, which is the difference
|
|
between a pin and a decoration: [emit.ml]'s declare block names
|
|
every runtime entry point in every module it writes, so
|
|
"flan_dyn_class_def" on its own is in the text of a module that
|
|
registers nothing. Checked by mutation — the bare needle passes with
|
|
the thunk deleted. *)
|
|
if not (has c.Session.ir "call void @flan_dyn_class_def") then
|
|
fail "a redefined class did not register its slots";
|
|
if not (has c.Session.ir "define void @flan_reload_call") then
|
|
fail "the class registration had nothing to run it";
|
|
(* And the slot names, in the packed form the runtime splits — which is
|
|
what says the call carries *this* class's new list and not some
|
|
other module's leftovers. *)
|
|
if not (has c.Session.ir "c\"x\\0Ay\\0Az\"") then
|
|
fail "the registration did not carry the new slot list"
|
|
| exception Loc.Error { Loc.dmsg = m; _ } ->
|
|
fail "adding a slot to a class was refused: %s" m);
|
|
(* A slot removed is the same decision in the other direction, and it is
|
|
worth its own case: the refusal compares signatures and does not care
|
|
which way the arity moved. *)
|
|
(let t, _ = Session.create ~file:"programs/dev-class.flan" () in
|
|
match Session.eval t "(defclass point [y])" with
|
|
| c ->
|
|
if not (List.mem "point" c.Session.fns) then
|
|
fail "removing a slot from a class installed %s"
|
|
(String.concat " " c.Session.fns)
|
|
| exception Loc.Error { Loc.dmsg = m; _ } ->
|
|
fail "removing a slot from a class was refused: %s" m);
|
|
(* A class that did not change registers anyway — the runtime ignores a
|
|
re-registration of the same list, and something has to tell it the list
|
|
in the first place. This is the C-c C-k shape: every class in the file
|
|
arrives, whether or not any of them moved.
|
|
|
|
The needles are the same two discriminating ones, and the slot list is
|
|
the *old* one, which is what says the registration is of this class as
|
|
it currently stands rather than a leftover from the case above. That
|
|
the runtime then declines to bump the generation is flan_dyn.c's half
|
|
and is pinned where it happens: dyn_ops.c's [classes] mode writes a
|
|
value and re-registers the same list under it, and test_dev.ml does the
|
|
same against a live program. Neither is visible in IR text, which is
|
|
why neither is asserted here. *)
|
|
(let t, _ = Session.create ~file:"programs/dev-class.flan" () in
|
|
match Session.eval t "(defclass point [x y])" with
|
|
| c ->
|
|
if not (has c.Session.ir "call void @flan_dyn_class_def") then
|
|
fail "an unchanged class definition registered nothing";
|
|
if not (has c.Session.ir "c\"x\\0Ay\"") then
|
|
fail "an unchanged class registered some other slot list"
|
|
| exception Loc.Error { Loc.dmsg = m; _ } ->
|
|
fail "re-evaluating an unchanged class was refused: %s" m);
|
|
(* Now the refusal that stands, which is the whole reason the relaxation
|
|
above is safe. A function of the running program calls the constructor
|
|
and this evaluation is not recompiling it, so accepting the edit would
|
|
leave a call site passing two dyn words into a three-parameter body —
|
|
and the third would hold whatever was in the register, which is a wild
|
|
pointer rather than a wrong answer.
|
|
|
|
The sentence a reader gets is the *checker's*: the whole declaration
|
|
list is re-checked against the new constructor before the session's
|
|
compatibility rules are consulted at all, so the complaint lands at the
|
|
call site with a line number rather than at the class. [session.ml]'s
|
|
own walk over the callers is the backstop behind it and is not what
|
|
fires here; its comment says so. *)
|
|
(let t, _ = Session.create ~file:"programs/dev-class.flan" () in
|
|
ignore (Session.eval t "(defn origin [] dyn (point 0 0))");
|
|
match Session.eval t "(defclass point [x y z])" with
|
|
| _ -> fail "a class with a compiled caller changed its slots anyway"
|
|
| exception Loc.Error { Loc.dmsg = m; _ } ->
|
|
if not (has m "point takes 3 arguments") then
|
|
fail "the refusal was not about the call that would be left behind: %s"
|
|
m);
|
|
(* And the same edit accepted when the caller comes with it, which is what
|
|
C-c C-k sends: the class and everything that constructs one are
|
|
recompiled in the same module, so no call site is left passing the old
|
|
arguments. *)
|
|
(let t, _ = Session.create ~file:"programs/dev-class.flan" () in
|
|
ignore (Session.eval t "(defn origin [] dyn (point 0 0))");
|
|
match
|
|
Session.eval t
|
|
"(do (defclass point [x y z]) (defn origin [] dyn (point 0 0 0)))"
|
|
with
|
|
| c ->
|
|
if not (List.mem "point" c.Session.fns && List.mem "origin" c.Session.fns)
|
|
then
|
|
fail "a class and its caller together installed %s"
|
|
(String.concat " " c.Session.fns)
|
|
| exception Loc.Error { Loc.dmsg = m; _ } ->
|
|
fail "a class and its caller evaluated together: %s" m);
|
|
|
|
(* ── What a slot is shown as ──────────────────────────────────────────
|
|
[strip_rebind] takes only a trailing ~N — [~] is the reader's delimiter
|
|
and a synthesized name like [destructure~nth] carries it for another
|
|
reason — and [shown_names] hides the unnamed temps while keeping both
|
|
raw spellings when a strip would put one name on two slots. The clean
|
|
strip is pinned here because end to end it is nearly unreachable: a
|
|
rebind's base name is almost always on the same list. *)
|
|
if Session.strip_rebind "r~2" <> "r" then
|
|
fail "r~2 did not strip to r";
|
|
if Session.strip_rebind "destructure~nth" <> "destructure~nth" then
|
|
fail "a non-numeric ~ suffix was stripped";
|
|
if Session.strip_rebind "r~" <> "r~" then fail "a bare trailing ~ was stripped";
|
|
if Session.strip_rebind "~2" <> "~2" then fail "a name that is only a suffix was stripped";
|
|
(let fn snames : Tast.fn =
|
|
{ Tast.name = "f"; params = []; ret = Types.Unit; body = [];
|
|
fdefers = []; fparent = None; floc = Loc.unknown;
|
|
slots = Array.make (Array.length snames) (Types.Int Types.I32);
|
|
snames }
|
|
in
|
|
(match Session.shown_names (fn [| Some "k~2"; None |]) with
|
|
| [| Some "k"; None |] -> ()
|
|
| _ -> fail "a lone rename did not show under its written name, temp hidden");
|
|
(match Session.shown_names (fn [| Some "v"; Some "v~2" |]) with
|
|
| [| Some "v"; Some "v~2" |] -> ()
|
|
| _ ->
|
|
fail "two slots that strip to one name did not keep their raw spellings"));
|
|
|
|
Test_support.report ~label:"session" ()
|