1768 lines
94 KiB
OCaml
1768 lines
94 KiB
OCaml
(* The session: the declarations a running process was built from, plus every
|
|
change accepted since (docs/BUILT.md, "The session").
|
|
|
|
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 signature change installs ─────────────────────────────────
|
|
A dev cell carries its body's signature word, and a call site compiled
|
|
against another one stops on StaleCall rather than passing the old
|
|
arguments — so a changed signature is accepted, and what the session owes
|
|
is the list of callers left compiled against the old one.
|
|
|
|
[outer] is called only from C, so nothing in the program is left behind:
|
|
each of these installs and names no stale caller. Dyn-ness is part of a
|
|
signature like anything else; the last two are the changes the source
|
|
does not spell out as a type. *)
|
|
let installs name src =
|
|
let t, _ = Session.create ~file:"programs/reload.flan" () in
|
|
match Session.eval t src with
|
|
| c ->
|
|
if not (List.mem "outer" c.Session.fns) then
|
|
fail "%s installed %s" name (String.concat " " c.Session.fns);
|
|
if c.Session.stale <> [] then
|
|
fail "%s left a caller behind that nothing has" name
|
|
| exception Loc.Error { Loc.dmsg = m; _ } -> fail "%s was refused: %s" name m
|
|
in
|
|
installs "a changed parameter type" "(defn outer [x i64] i64 (bump))";
|
|
installs "a changed return type" "(defn outer [] i32 (i32 (bump)))";
|
|
installs "a changed arity" "(defn outer [a i64 b i64] i64 (bump))";
|
|
installs "a return type that became dyn" "(defn outer [] dyn (bump))";
|
|
installs "a parameter that became dyn" "(defn outer [x] i64 (bump))";
|
|
(* [main] is the exception: the startup code calls it, and that call was
|
|
compiled into the program when it started. *)
|
|
refuses ~file:"programs/dev-stale.flan" "a changed main"
|
|
"(defn main [] () (step))"
|
|
"main changes signature, from [] i32 to [] ()";
|
|
|
|
(* The callers. [step] calls [scale] and [pick] takes it as a value, and
|
|
neither is in the form — so both are named, at the line of the call and
|
|
with both signatures. [step]'s source no longer checks against the new
|
|
arity, and that is not a reason to refuse: it is not being recompiled. *)
|
|
(let t, _ = Session.create ~file:"programs/dev-stale.flan" () in
|
|
match Session.eval t "(defn scale [x i64 k i64] i64 (* x k))" with
|
|
| exception Loc.Error { Loc.dmsg = m; _ } ->
|
|
fail "a signature change with compiled callers was refused: %s" m
|
|
| c ->
|
|
if not (List.mem "scale" c.Session.fns) then
|
|
fail "the changed function was not installed";
|
|
let named =
|
|
List.map
|
|
(fun (x : Session.stale) ->
|
|
(x.Session.caller, x.Session.target, x.Session.compiled,
|
|
x.Session.current, x.Session.at.Loc.line))
|
|
c.Session.stale
|
|
in
|
|
let want =
|
|
[ ("step", "scale", "[i64] i64", "[i64 i64] i64", 23);
|
|
("pick", "scale", "[i64] i64", "[i64 i64] i64", 26);
|
|
(* The clause's call is named for the function it is written in,
|
|
not for the lifted function it became. *)
|
|
("guarded", "scale", "[i64] i64", "[i64 i64] i64", 45);
|
|
("guarded", "scale", "[i64] i64", "[i64 i64] i64", 46) ]
|
|
in
|
|
if named <> want then
|
|
fail "the stale callers were %s"
|
|
(String.concat "; "
|
|
(List.map
|
|
(fun (c, g, w, n, l) -> Printf.sprintf "%s->%s %s/%s @%d" c g w n l)
|
|
named));
|
|
(* Recompiling a stale caller clears it, and only it. *)
|
|
(match
|
|
Session.eval t
|
|
"(defn step [] i64 (set ticks (+ ticks 1)) (set seen (scale ticks 3)) seen)"
|
|
with
|
|
| c ->
|
|
(match c.Session.stale with
|
|
| [ a; b; c ] when a.Session.caller = "pick"
|
|
&& b.Session.caller = "guarded"
|
|
&& c.Session.caller = "guarded" -> ()
|
|
| l ->
|
|
fail "after recompiling step the stale callers were %s"
|
|
(String.concat ", "
|
|
(List.map (fun (x : Session.stale) -> x.Session.caller) l)))
|
|
| exception Loc.Error { Loc.dmsg = m; _ } ->
|
|
fail "recompiling a stale caller was refused: %s" m);
|
|
(* A body that is kept is the one that was compiled: an unrelated
|
|
evaluation still names [pick], and the session's program still holds
|
|
the [pick] the process is running rather than refusing to check. *)
|
|
(match Session.eval t "(defn lonely [x i64] i64 (+ x 1))" with
|
|
| c ->
|
|
if List.map (fun (x : Session.stale) -> x.Session.caller) c.Session.stale
|
|
<> [ "pick"; "guarded"; "guarded" ]
|
|
then fail "an unrelated evaluation lost track of the stale caller"
|
|
| exception Loc.Error { Loc.dmsg = m; _ } ->
|
|
fail "an evaluation after a signature change was refused: %s" m);
|
|
(* And the signature changed back is the one [pick] was compiled
|
|
against: nothing is stale, because the word is the signature and not
|
|
a count of changes. *)
|
|
(match Session.eval t "(defn scale [x i64] i64 (* x 2))" with
|
|
| c ->
|
|
(match c.Session.stale with
|
|
| [ x ] when x.Session.caller = "step" -> ()
|
|
| l ->
|
|
fail "after changing scale back the stale callers were %s"
|
|
(String.concat ", "
|
|
(List.map (fun (x : Session.stale) -> x.Session.caller) l)))
|
|
| exception Loc.Error { Loc.dmsg = m; _ } ->
|
|
fail "changing a signature back was refused: %s" m));
|
|
|
|
(* A stale call in [main] is one that evaluating [main] again cannot fix
|
|
while the program runs: its loop is the activation the call is in, and
|
|
it never returns to be called again. So the site is flagged, and when
|
|
[main] is compiled again the body the program started with stays on the
|
|
list until a re-run. With the program parked, compiling [main] again is
|
|
an ordinary fix. *)
|
|
(let t, _ = Session.create ~file:"programs/dev-stale.flan" () in
|
|
let mains (c : Session.change) =
|
|
List.filter_map
|
|
(fun (x : Session.stale) ->
|
|
if x.Session.caller = "main" then Some x.Session.running else None)
|
|
c.Session.stale
|
|
in
|
|
let main_src =
|
|
"(defn main [] i32 (agent/start \"/tmp/x.sock\") \
|
|
(dotimes [i 6000] (agent/wait 5) (restart-case (step 1) (skip-frame [] 0))) 0)"
|
|
in
|
|
(match Session.eval t "(defn step [x i64] i64 (set seen (scale x)) seen)" with
|
|
| c ->
|
|
if mains c <> [ true ] then fail "a stale call in main was not flagged as running"
|
|
| exception Loc.Error { Loc.dmsg = m; _ } -> fail "changing step: %s" m);
|
|
(match Session.eval t main_src with
|
|
| c ->
|
|
if mains c <> [ true ] then
|
|
fail "recompiling main while it runs cleared its stale call"
|
|
| exception Loc.Error { Loc.dmsg = m; _ } -> fail "recompiling main: %s" m);
|
|
Session.rerun t;
|
|
(match Session.eval t "(defn lonely [x i64] i64 (+ x 2))" with
|
|
| c -> if mains c <> [] then fail "a re-run did not clear main's stale call"
|
|
| exception Loc.Error { Loc.dmsg = m; _ } -> fail "after a re-run: %s" m));
|
|
(let t, _ = Session.create ~file:"programs/dev-stale.flan" () in
|
|
ignore
|
|
(Session.eval ~running:false t "(defn step [x i64] i64 (set seen (scale x)) seen)");
|
|
match
|
|
Session.eval ~running:false t
|
|
"(defn main [] i32 (dotimes [i 3] (restart-case (step 1) (skip-frame [] 0))) 0)"
|
|
with
|
|
| c ->
|
|
if List.exists (fun (x : Session.stale) -> x.Session.caller = "main")
|
|
c.Session.stale
|
|
then fail "recompiling main while parked left it stale"
|
|
| exception Loc.Error { Loc.dmsg = m; _ } -> fail "recompiling a parked main: %s" m);
|
|
|
|
(* What a tolerated caller's failed check made is taken back, generic copies
|
|
included, so a body in the same form that needs the same copy gets one
|
|
generated for it rather than a cached name. *)
|
|
(let t, _ = Session.create ~file:"programs/stale-generic.flan" () in
|
|
match
|
|
Session.eval t
|
|
"(defn scale [x i64] f64 (f64 (* x 2))) (defn other [] f64 (same 2.5))"
|
|
with
|
|
| c ->
|
|
if not (List.mem "same-f64" c.Session.fns) then
|
|
fail "a copy a tolerated caller asked for was not generated again: %s"
|
|
(String.concat " " c.Session.fns);
|
|
if List.map (fun (x : Session.stale) -> x.Session.caller) c.Session.stale
|
|
<> [ "through" ]
|
|
then fail "the generic fixture named the wrong stale callers"
|
|
| exception Loc.Error { Loc.dmsg = m; _ } ->
|
|
fail "a stale caller that instantiates a generic: %s" m);
|
|
|
|
(* A caller whose source fails for some other reason is still refused: the
|
|
tolerance is for a body compiled against a signature that changed, and
|
|
[twice] here is new, in the form, and wrong. *)
|
|
refuses ~file:"programs/dev-stale.flan" "a form that is wrong on its own"
|
|
"(defn scale [x i64 k i64] i64 (* x k)) (defn twice [] i64 (scale 1))"
|
|
"scale";
|
|
|
|
(* 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, i64, 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 ];
|
|
|
|
(* ── A defn- through the dev loop ──────────────────────────────────
|
|
C-c C-c on a [defn-] in its package's own file redefines it under the
|
|
qualified name and the session keeps it private: the package's callers
|
|
still reach the new body, and a form evaluated in the importer's buffer
|
|
is still refused. A [defn-] in the program's own file is the program's
|
|
and is callable from the rest of it. *)
|
|
let tp, _ = Session.create ~file:"programs/pkg-private.flan" () in
|
|
(match Session.eval ~origin:"programs/pkgs/secret/secret.flan" tp
|
|
"(defn- mix [a i32 b i32] i32 (+ (* a 100) b))" with
|
|
| c ->
|
|
if not (has c.Session.ir "mul i32") then
|
|
fail "a defn- redefined in its package's file installed no new body"
|
|
| exception Loc.Error { Loc.dmsg = m; _ } ->
|
|
fail "redefining a defn- in its package's file: %s" m);
|
|
(match Session.eval ~origin:"programs/pkg-private.flan" tp
|
|
"(defn peek [] i32 (secret/mix 1 2))" with
|
|
| _ -> fail "a redefined defn- became callable from outside its package"
|
|
| exception Loc.Error { Loc.dmsg = m; _ } ->
|
|
if not (has m "secret/mix is private to its package") then
|
|
fail "a call to a redefined defn- was refused for another reason: %s" m);
|
|
(match Session.eval ~origin:"programs/pkg-private.flan" tp
|
|
"(defn- helper [] i32 7)\n(defn use-helper [] i32 (helper))" with
|
|
| _ -> ()
|
|
| exception Loc.Error { Loc.dmsg = m; _ } ->
|
|
fail "a defn- in the program's own file: %s" m);
|
|
(* A package function whose signature changes names its callers outside the
|
|
package, at their own file and line — and inside it: [mix] gaining a
|
|
parameter leaves [combine] and [twice] in the package's two files, the
|
|
value [via-value] takes, and the calls the package's macros wrote into
|
|
[main]. Making it private in the same breath does
|
|
not let a stale caller outside the package off: recompiling it is still
|
|
refused by the privacy check. *)
|
|
(let tp, _ = Session.create ~file:"programs/pkg-private.flan" () in
|
|
match
|
|
Session.eval ~origin:"programs/pkgs/secret/secret.flan" tp
|
|
"(defn- combine [a i32 b i32 c i32] i32 (mix a (+ b c)))"
|
|
with
|
|
| exception Loc.Error { Loc.dmsg = m; _ } ->
|
|
fail "a package function's signature change was refused: %s" m
|
|
| c ->
|
|
let where =
|
|
List.map
|
|
(fun (x : Session.stale) ->
|
|
(x.Session.caller, Filename.basename x.Session.at.Loc.file,
|
|
x.Session.at.Loc.line))
|
|
c.Session.stale
|
|
in
|
|
if where <> [ ("main", "pkg-private.flan", 8) ] then
|
|
fail "the package's stale callers were %s"
|
|
(String.concat ", "
|
|
(List.map (fun (n, f, l) -> Printf.sprintf "%s %s:%d" n f l) where));
|
|
(match
|
|
Session.eval ~origin:"programs/pkg-private.flan" tp
|
|
"(defn main [] i32 (print (secret/combine 1 2 3)) 0)"
|
|
with
|
|
| _ -> fail "a stale caller recompiled past a defn- was accepted"
|
|
| exception Loc.Error { Loc.dmsg = m; _ } ->
|
|
if not (has m "secret/combine is private to its package") then
|
|
fail "the recompiled stale caller was refused for another reason: %s" m));
|
|
(let tp, _ = Session.create ~file:"programs/pkg-private.flan" () in
|
|
match
|
|
Session.eval ~origin:"programs/pkgs/secret/secret.flan" tp
|
|
"(defn- mix [a i32 b i32 c i32] i32 (+ (* a 10) (+ b c)))"
|
|
with
|
|
| exception Loc.Error { Loc.dmsg = m; _ } ->
|
|
fail "a private package function's signature change was refused: %s" m
|
|
| c ->
|
|
let where =
|
|
List.sort compare
|
|
(List.map
|
|
(fun (x : Session.stale) ->
|
|
(x.Session.caller, Filename.basename x.Session.at.Loc.file))
|
|
c.Session.stale)
|
|
in
|
|
(* [main] twice: the package's macros write calls to [mix] into it. *)
|
|
if where
|
|
<> [ ("main", "pkg-private.flan"); ("main", "pkg-private.flan");
|
|
("secret/combine", "secret.flan"); ("secret/twice", "more.flan");
|
|
("secret/via-value", "more.flan") ]
|
|
then
|
|
fail "mix's stale callers were %s"
|
|
(String.concat ", " (List.map (fun (n, f) -> n ^ " " ^ f) where)));
|
|
(* And a single-file package: redefined from its own file, it stays private
|
|
to that file, so the file beside it that imports it is still refused. *)
|
|
let tl, _ = Session.create ~file:"programs/loose/use.flan" () in
|
|
(match Session.eval ~origin:"programs/loose/lib.flan" tl
|
|
"(defn- inner [a i32] i32 (* a 4))" with
|
|
| _ -> ()
|
|
| exception Loc.Error { Loc.dmsg = m; _ } ->
|
|
fail "redefining a single-file package's defn-: %s" m);
|
|
(match Session.eval ~origin:"programs/loose/use.flan" tl
|
|
"(defn peek [] i32 (lib/inner 1))" with
|
|
| _ -> fail "a redefined single-file defn- became callable beside its file"
|
|
| exception Loc.Error { Loc.dmsg = m; _ } ->
|
|
if not (has m "lib/inner is private to its package") then
|
|
fail "a call to a single-file defn- was refused for another reason: %s" m);
|
|
|
|
(* ── 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);
|
|
|
|
(* A macro that an expansion defined joins the session too. [(defsq sq6)]
|
|
sends no [defmacro], so reading the forms as sent would miss it and the
|
|
next evaluation would call [sq6] as a function taking a Form. *)
|
|
(match Session.eval ~origin:"programs/pkg-macro.flan" tm
|
|
"(defmacro defsq [name] `(defmacro ~name [x] `(* ~x ~x)))"
|
|
with
|
|
| _ -> ()
|
|
| exception Loc.Error { Loc.dmsg = m; _ } ->
|
|
fail "evaluating a macro-writing defmacro: %s" m);
|
|
(match Session.eval ~origin:"programs/pkg-macro.flan" tm "(defsq sq6)" with
|
|
| _ -> ()
|
|
| exception Loc.Error { Loc.dmsg = m; _ } ->
|
|
fail "evaluating a call to a macro-writing macro: %s" m);
|
|
(match Session.eval_expr ~origin:"programs/pkg-macro.flan" tm "(sq6 6)" with
|
|
| c ->
|
|
if not (has c.Session.ir "6, 6") then
|
|
fail "a macro defined by an expansion did not expand to its body"
|
|
| exception Loc.Error { Loc.dmsg = m; _ } ->
|
|
fail "a macro defined by an expansion, called in the session: %s" m);
|
|
|
|
(* A mistake in a body the macro spliced, reported where it was written.
|
|
Same machinery as a build — [Macro.expand_form] and [Expand.call] — and
|
|
the point of asking it here is that the editor is where it is read: C-c
|
|
C-c on a form four lines long puts the cursor on the line the message
|
|
names, and naming the macro call would put it on the wrong one every
|
|
time. The body is on the third line of what is sent and the call is on
|
|
the first. *)
|
|
(match Session.eval ~origin:"programs/pkg-macro.flan" tm
|
|
"(defmacro splice [& body] `(do ~@body))"
|
|
with
|
|
| _ -> ()
|
|
| exception Loc.Error { Loc.dmsg = m; _ } ->
|
|
fail "evaluating a splicing defmacro: %s" m);
|
|
(match
|
|
Session.eval ~origin:"programs/pkg-macro.flan" tm
|
|
"(defn spliced [] i32\n\
|
|
\ (splice\n\
|
|
\ (+ nowhere 1))\n\
|
|
\ 0)"
|
|
with
|
|
| _ -> fail "a mistake in a spliced body was accepted"
|
|
| exception Loc.Error d ->
|
|
if d.Loc.dloc.Loc.line <> 3 then
|
|
fail "a mistake in a spliced body was reported on line %d, not 3: %s"
|
|
d.Loc.dloc.Loc.line d.Loc.dmsg;
|
|
(match d.Loc.expansion with
|
|
| Some ("splice", at) when at.Loc.line = 2 -> ()
|
|
| Some (n, at) ->
|
|
fail "the note on a spliced body says %s at line %d" n at.Loc.line
|
|
| None -> fail "the note on a spliced body names no macro"));
|
|
|
|
(* 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 (length 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 installs, like any other, and the
|
|
callers left behind are the callers of its *copies*: the mangling carries
|
|
only the type variables, so every copy changes signature at once under
|
|
the name it had. Widening the index from i32 to i64 leaves
|
|
[(put-at xs 0 v)] checking, because the literal adapts — the source is
|
|
fine and the compiled call is not, which is the case the signature word
|
|
exists for. *)
|
|
(match
|
|
Session.eval (gen ())
|
|
"(defn put-at [xs [$t] i i64 v $t] () \
|
|
(set (at xs (i32 i)) v))"
|
|
with
|
|
| c ->
|
|
if not (List.exists (fun (x : Session.stale) ->
|
|
String.starts_with ~prefix:"put-at-" x.Session.target
|
|
&& x.Session.compiled <> x.Session.current)
|
|
c.Session.stale)
|
|
then fail "a generic's changed parameter type named no stale caller"
|
|
| exception Loc.Error { Loc.dmsg = m; _ } ->
|
|
fail "a generic's changed parameter type was refused: %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);
|
|
|
|
(* ── The widening thunks, across a reorder ──────────────────────
|
|
A thunk is a function nobody wrote and nothing in the source names, so
|
|
the only way one can change is the program growing or losing a widening
|
|
— and reordering two calls is neither. But [compatible] compares by
|
|
name, so a thunk named for the order it was minted in means one
|
|
signature before the edit and another after, and the session answers a
|
|
body change with "Restart to change it" about a name the programmer
|
|
cannot find. The name spells the signature, so this reload is ordinary.
|
|
|
|
Both directions of the pair are here — the same two calls, swapped —
|
|
because a name that is a counter is wrong for exactly one of them and
|
|
the test has to be the one that is wrong. *)
|
|
(let t, _ = Session.create ~file:"programs/fn-thunk-reload.flan" () in
|
|
match
|
|
Session.eval t
|
|
"(defn both [] i32 (println (use64 b1)) (println (use32 a1)) 0)"
|
|
with
|
|
| c ->
|
|
if not (List.mem "both" c.Session.fns) then
|
|
fail "reordering two widenings installed %s"
|
|
(String.concat " " c.Session.fns)
|
|
| exception Loc.Error { Loc.dmsg = m; _ } ->
|
|
fail "reordering two widenings was refused: %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\\00\"") 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\\00\"") 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);
|
|
(* A compiled caller of the constructor does not stop the edit either: a
|
|
constructor is a function, and a slot added is a parameter added. The
|
|
caller is named, and a call through it would stop on StaleCall rather
|
|
than leave the third slot holding a register. *)
|
|
(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
|
|
| c ->
|
|
if List.map (fun (x : Session.stale) -> (x.Session.caller, x.Session.target))
|
|
c.Session.stale
|
|
<> [ ("origin", "point") ]
|
|
then fail "a class with a compiled caller named the wrong stale callers"
|
|
| exception Loc.Error { Loc.dmsg = m; _ } ->
|
|
fail "a class with a compiled caller was refused: %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);
|
|
(* A method of update-instance-for-redefined-class, from the session. The
|
|
generic is written by [Classes.expand], not by the program, so this is
|
|
the case where the declaration being extended is nowhere in the
|
|
session's own list — and the method still has to install the generic's
|
|
dispatch, and the module has to hand the runtime the body it just
|
|
installed, or migrations go on calling the old one. *)
|
|
(let t, _ = Session.create ~file:"programs/dev-class.flan" () in
|
|
match
|
|
Session.eval t
|
|
"(defmethod update-instance-for-redefined-class point \
|
|
[p added discarded] nil)"
|
|
with
|
|
| c ->
|
|
if not (List.mem Classes.migrate_generic c.Session.fns) then
|
|
fail "a migration method installed %s" (String.concat " " c.Session.fns);
|
|
if not (has c.Session.ir "call void @flan_dyn_class_hook") then
|
|
fail "a migration method did not re-register the hook"
|
|
| exception Loc.Error { Loc.dmsg = m; _ } ->
|
|
fail "a migration method was refused: %s" m);
|
|
(* A slot's type changed and nothing else. Every constructor parameter is
|
|
dyn whatever the slot says, so the signature is the one it was and a
|
|
compiled caller is no reason to refuse — the type is checked where a
|
|
value is stored, at run time. What has to reach the program is the new
|
|
definition, and the registration carries it with the type after the
|
|
name, which is what makes the runtime see a change and migrate. *)
|
|
(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 i64 y])" with
|
|
| c ->
|
|
if not (has c.Session.ir "c\"x i64\\0Ay\\00\"") then
|
|
fail "a slot's new type did not reach the registration"
|
|
| exception Loc.Error { Loc.dmsg = m; _ } ->
|
|
fail "a slot's type changed under a compiled caller was refused: %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 = []; fenv = None; 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"));
|
|
|
|
(* ── A file with no main ───────────────────────────────────────────
|
|
[create_dev] gives it a [main] that returns, so there is a process to
|
|
start, and [has_main] tells that stub from one somebody wrote. *)
|
|
(match Session.create_dev ~file:"programs/dev-nomain.flan" () with
|
|
| t, _, [] ->
|
|
if Session.has_main t then fail "the stub main counted as the file's own";
|
|
if not
|
|
(List.exists (fun (f : Tast.fn) -> f.Tast.name = "main")
|
|
t.Session.host.Tast.fns)
|
|
then fail "a file with no main was given no main to start";
|
|
(* A [main] loaded later is the file's own. *)
|
|
(match Session.eval ~origin:"programs/dev-nomain.flan" t
|
|
"(defn main [] i32 3)" with
|
|
| _ ->
|
|
if not (Session.has_main t) then
|
|
fail "a main loaded into the session did not replace the stub"
|
|
| exception Loc.Error { Loc.dmsg = m; _ } ->
|
|
fail "loading a main into a session started without one: %s" m)
|
|
| _, _, _ :: _ -> fail "dev-nomain.flan had forms that did not compile"
|
|
| exception Loc.Error { Loc.dmsg = m; _ } ->
|
|
fail "a session over a file with no main: %s" m);
|
|
(match Session.create_dev ~file:"programs/dev-parknote.flan" () with
|
|
| t, _, _ ->
|
|
if not (Session.has_main t) then fail "a file's own main was not its own"
|
|
| exception Loc.Error { Loc.dmsg = m; _ } -> fail "dev-parknote.flan: %s" m);
|
|
|
|
(* A file with no main whose forms do not all compile starts without them,
|
|
and names them. [good] goes because it calls [bad]. *)
|
|
(match Session.create_dev ~file:"programs/dev-load-errors.flan" () with
|
|
| t, _, errs ->
|
|
let fns = List.map (fun (f : Tast.fn) -> f.Tast.name) t.Session.host.Tast.fns in
|
|
if not (List.mem "fine" fns) then fail "the form that compiled was left out";
|
|
if List.mem "good" fns || List.mem "bad" fns then
|
|
fail "a form that did not compile is in the host";
|
|
if List.length errs <> 2 then
|
|
fail "a start with two bad forms named %d" (List.length errs)
|
|
| exception Loc.Error { Loc.dmsg = m; _ } ->
|
|
fail "a no-main file with a bad form refused the session: %s" m);
|
|
|
|
(* A file with a main of its own and a form that does not compile starts
|
|
the same way, with its own main. *)
|
|
(match Session.create_dev ~file:"programs/dev-main-broken.flan" () with
|
|
| t, _, errs ->
|
|
if not (Session.has_main t) then fail "the file's own main was left out";
|
|
let fns = List.map (fun (f : Tast.fn) -> f.Tast.name) t.Session.host.Tast.fns in
|
|
if not (List.mem "fine" fns) || List.mem "bad" fns then
|
|
fail "a file with a main started with the wrong forms";
|
|
if List.length errs <> 1 then
|
|
fail "a start with one bad form named %d" (List.length errs)
|
|
| exception Loc.Error { Loc.dmsg = m; _ } ->
|
|
fail "a file with a main and a bad form refused the session: %s" m);
|
|
|
|
(* [pruned] on its own, as the daemon's load-file runs it: each round drops
|
|
the form the error is in, and one it could not blame is raised. *)
|
|
(let t, _ = Session.create ~file:"programs/dev-parknote.flan" () in
|
|
let src =
|
|
In_channel.with_open_bin "programs/dev-load-errors.flan" In_channel.input_all
|
|
in
|
|
let origin = "programs/dev-load-errors.flan" in
|
|
let forms = Reader.read_all ~file:origin src in
|
|
let check forms =
|
|
let h = Session.held t in
|
|
Fun.protect ~finally:(fun () -> Session.restore t h)
|
|
(fun () -> ignore (Session.eval ~origin ~forms t src))
|
|
in
|
|
match Session.pruned check forms with
|
|
| (), kept, errs ->
|
|
if List.length kept <> 1 then fail "load kept %d forms, not 1" (List.length kept);
|
|
(match errs with
|
|
| [ a; b ] ->
|
|
if not (has a.Loc.dmsg "expected i64") then
|
|
fail "the first error a load found was %S" a.Loc.dmsg;
|
|
if not (has b.Loc.dmsg "unknown function bad") then
|
|
fail "the form that used a dropped one went for %S" b.Loc.dmsg
|
|
| _ -> fail "load found %d errors, not 2" (List.length errs))
|
|
| exception Loc.Error { Loc.dmsg = m; _ } -> fail "pruned raised: %s" m);
|
|
|
|
(* ── An expression from a package's file ─────────────────────────────
|
|
CIDER's rule: it resolves as the file would, so the package's own names
|
|
reach it bare, a [defn-] included. From the program's file the same bare
|
|
name is not the package's. *)
|
|
(let tq, _ = Session.create ~file:"programs/pkg-private.flan" () in
|
|
(match
|
|
Session.eval_expr ~origin:"programs/pkgs/secret/secret.flan" tq
|
|
"(+ (combine 1 2) (mix 3 4))"
|
|
with
|
|
| c ->
|
|
if not (has c.Session.ir "secret") then
|
|
fail "an expression from a package's file did not reach the package"
|
|
| exception Loc.Error { Loc.dmsg = m; _ } ->
|
|
fail "an expression from a package's file: %s" m);
|
|
(* The package's own macro, bare, from its file: an expression and a
|
|
declaration both expand it as the file would. *)
|
|
(match
|
|
Session.eval_expr ~origin:"programs/pkgs/secret/secret.flan" tq "(mixed 1 1)"
|
|
with
|
|
| _ -> ()
|
|
| exception Loc.Error { Loc.dmsg = m; _ } ->
|
|
fail "a package's macro, bare, from its file: %s" m);
|
|
(match
|
|
Session.eval ~origin:"programs/pkgs/secret/secret.flan" tq
|
|
"(defn via-mixed [] i32 (mixed 1 2))"
|
|
with
|
|
| _ -> ()
|
|
| exception Loc.Error { Loc.dmsg = m; _ } ->
|
|
fail "a package's macro, bare, in a declaration from its file: %s" m);
|
|
match
|
|
Session.eval_expr ~origin:"programs/pkg-private.flan" tq "(combine 1 2)"
|
|
with
|
|
| _ -> fail "a package's bare name resolved from the program's own file"
|
|
| exception Loc.Error _ -> ());
|
|
|
|
Test_support.report ~label:"session" ()
|