Joseph Ferano
cf410c5da3
Session.eval committed the checked program the moment a form checked, and the two steps that can still refuse it — the build, and the agent taking the module — come after that, in the daemon. Either one left the editor holding an error and the session holding a declaration the process has no body for. The next module built for that session lists the name in its install prologue, which interns a cell for it and never stores anything into it, and a dev build's call through a cell has no null test in front of it: the game thread jumps to address 0 at the next C-x C-e, locals render or globals refresh. Session.held takes the four fields eval commits as one unit and Session.restore puts them back. Dev.eval and Dev.eval_expr take one before checking and restore it on every arm where nothing was accepted — a failed build, a refused delivery, an unreachable agent. eval_expr needed it for the generic instances it keeps, whose own comment already claimed the invariant: "the session must not come to believe it holds a body that no module was ever written for." A delivered module that then times out is not a refusal and does not roll back: the agent has it and will install it at a frame boundary.
1445 lines
68 KiB
OCaml
1445 lines
68 KiB
OCaml
(** A live program: the declarations a running process was built from, plus
|
|
every change accepted since.
|
|
|
|
This is what makes an editor possible. [Check.program] builds a fresh
|
|
environment from a declaration list on every call, which is exactly the
|
|
property a session needs and the reason there is no scratch-environment
|
|
machinery here: a form that fails to check leaves nothing behind, because
|
|
nothing was mutated. The list is only replaced once the check has
|
|
succeeded. Re-checking the whole program each time costs the whole frontend,
|
|
which is under 10ms — less than the [llc] that follows it.
|
|
|
|
Two things the session knows that no single evaluation could:
|
|
|
|
- **which names the running process was built with.** A name it has is a
|
|
symbol the loaded module binds to; a name it lacks goes through the
|
|
by-name registry in runtime/flan_dev.c. Getting this wrong is silent:
|
|
treating [rand-seed] as new gives it a registry cell nobody publishes,
|
|
and the first call jumps to null. It has to come from the *checked*
|
|
program, because [Check.program] prepends the prelude and no accumulated
|
|
AST contains it.
|
|
- **what the memory of that process looks like.** A cell is a bare pointer
|
|
and carries no signature, so a redefined function whose parameters
|
|
changed is called by every existing call site with the old ones — no link
|
|
error, no trap, a wrong number. Struct fields and global types are the
|
|
same class. Those are refused here, with the reason, rather than loaded.
|
|
|
|
Not here, and deliberately: evaluating an expression. That is a separate
|
|
primitive — synthesize a function around the form, call it, render the
|
|
value — and it is not what redefining a name is. *)
|
|
|
|
type t = {
|
|
file : string; (* resolves an import's relative path *)
|
|
mutable decls : Ast.decl list; (* post-Load: flat, one namespace *)
|
|
mutable program : Tast.program; (* the last thing that checked *)
|
|
mutable env : Check.env; (* the same, as the checker sees it *)
|
|
host : Tast.program; (* what the process was built from *)
|
|
pkgs : Load.pkg list; (* alias, directory, names owned *)
|
|
(* Every [defmacro] this session can expand a call to: the imports', under
|
|
their aliases, and the buffer's own, under the names the buffer writes.
|
|
Held rather than re-derived because an evaluation parses one form with no
|
|
import and no [defmacro] in sight, and a macro that works on the first
|
|
build and not on the reload is worse than one that never existed.
|
|
|
|
It is exactly this record's own rule applied to macros — what the program
|
|
was built from, plus every change accepted since. The file's own set is
|
|
seeded in [create] from the forms [Load] was handed, which is the same
|
|
read that produced [decls]; nothing here ever goes back to disk, so a
|
|
macro cannot arrive from a version of the file the session was never
|
|
told about. *)
|
|
mutable macros : Form.t list;
|
|
mutable thunks : int; (* expression evaluations so far *)
|
|
(* Whether the modules this session emits carry DWARF. It belongs to the
|
|
session rather than to each call because it has to match the process the
|
|
modules are loaded into: a redefinition with debug info, dlopened into a
|
|
host built without it, gives a debugger a second module to resolve names
|
|
against and nothing to line up the host's own frames with. Both ends are
|
|
set from one flag — see [Dev.start]. *)
|
|
debug : bool;
|
|
(* Which backend compiles the modules this session emits, and it belongs to
|
|
the session for exactly the reason [debug] does: it has to match the
|
|
process they are loaded into. The two backends agree on every scalar and
|
|
disagree on every aggregate, so a module from one dlopened into a host
|
|
from the other is correct until the first redefined function takes or
|
|
returns a struct. Both ends are set from one flag -- see [Dev.start] --
|
|
and [flan.abi.x86] is the backstop if they ever come apart. *)
|
|
x86 : bool;
|
|
}
|
|
|
|
let fail = Loc.fail
|
|
|
|
(* Structural, and conservative: anything this does not recognise counts as
|
|
changed. Comparing emitted text instead would be wrong — [Emit.const] on a
|
|
string allocates a name off a per-module counter, so two different strings
|
|
in two throwaway modules both come out as [@".str.0"] and compare equal. *)
|
|
let rec same_const (a : Tast.expr) (b : Tast.expr) =
|
|
match (a.Tast.e, b.Tast.e) with
|
|
| Tast.Int (x, k), Tast.Int (y, l) -> Int64.equal x y && k = l
|
|
| Tast.Float (x, k), Tast.Float (y, l) -> Float.equal x y && k = l
|
|
| Tast.Bool x, Tast.Bool y -> x = y
|
|
| Tast.Str x, Tast.Str y -> String.equal x y
|
|
| Tast.Unit, Tast.Unit -> true
|
|
| Tast.Zero x, Tast.Zero y -> Types.equal x y
|
|
| Tast.Arr xs, Tast.Arr ys ->
|
|
List.length xs = List.length ys && List.for_all2 same_const xs ys
|
|
| Tast.Make (x, xs), Tast.Make (y, ys) ->
|
|
String.equal x y && List.length xs = List.length ys
|
|
&& List.for_all2 same_const xs ys
|
|
| _ -> false
|
|
|
|
(* The [defmacro]s among a set of top-level forms, as [t.macros] has to hold
|
|
them.
|
|
|
|
[Expand.quasiquote] is not decoration. [Parse.parse_forms] desugars every
|
|
form it is handed before the expander sees it, and [Load.qualify_macro]
|
|
desugars a package's macro on its way out for the same reason — but
|
|
[Parse.imported_macros] is read by [Macro.program] directly, past that map.
|
|
An undesugared body still has its quasiquote in it, which makes a
|
|
quasiquoted call look like a real one: the false ring docs/BUILT.md records the
|
|
first cycle test walking into.
|
|
|
|
Unqualified, and that is the point: a buffer writes its own macro's bare
|
|
name, so that is the name the session has to answer to. A file inside a
|
|
package that the program also imports has both — the bare one from here and
|
|
[alias/name] from [Load] — which is what the two call sites each need. *)
|
|
let own_macros (forms : Form.t list) : Form.t list =
|
|
List.filter_map
|
|
(fun f ->
|
|
match f.Form.v with
|
|
| Form.List ({ Form.v = Form.Sym "defmacro"; _ } :: _) ->
|
|
Some (Expand.quasiquote f)
|
|
| _ -> None)
|
|
forms
|
|
|
|
let create ?(debug = false) ?(x86 = false) ~file () =
|
|
let forms = Reader.read_file file in
|
|
let l = Load.program ~file forms in
|
|
let p, env = Check.program_with_env l.Load.decls in
|
|
({ file; decls = l.Load.decls; program = p; env; host = p; pkgs = l.Load.pkgs;
|
|
(* The file's own first, so that if the file being edited is itself a
|
|
package the program imports, the bare name wins for a form typed into
|
|
that buffer. [macro_union] keeps the left. *)
|
|
macros = Load.macro_union (own_macros forms) l.Load.macros;
|
|
thunks = 0; debug; x86 }, l)
|
|
|
|
(* Which package a file being edited belongs to, if any.
|
|
|
|
A form typed into vendor/agent/agent.flan declares [poll], but the running
|
|
program only ever knew it as [agent/poll]: the alias is chosen by whatever
|
|
imported the directory, and is written nowhere in the file itself. Without
|
|
this the form splices as a brand-new unrelated name, the evaluation reports
|
|
success, and nothing changes — the exact failure this whole design is meant
|
|
to make impossible.
|
|
|
|
Derived from the path rather than sent by the editor for that same reason:
|
|
the editor cannot know an alias the file does not mention. *)
|
|
let package_of t origin =
|
|
match origin with
|
|
| "" -> None
|
|
| origin ->
|
|
let here =
|
|
try Unix.realpath origin with Unix.Unix_error _ -> origin
|
|
in
|
|
let dir = Filename.dirname here in
|
|
(* A package is a directory, or a single .flan file named outright — so the
|
|
file being edited belongs to it if the package *is* that file, or if it
|
|
sits in the package's directory. Comparing only the directory would miss
|
|
the file case entirely and answer [None], which is the silent failure
|
|
above rather than a loud one: the form splices unqualified and the
|
|
running program keeps calling the name it already had. *)
|
|
let same p =
|
|
let d =
|
|
try Unix.realpath p.Load.dir with Unix.Unix_error _ -> p.Load.dir
|
|
in
|
|
String.equal d here || String.equal d dir
|
|
in
|
|
(match List.filter same t.pkgs with
|
|
| [] -> None
|
|
| [ p ] -> Some p
|
|
(* One directory under two aliases: both are live in the program and a
|
|
form cannot mean both. Say so rather than picking one. *)
|
|
| ps ->
|
|
Loc.fail Loc.unknown
|
|
"%s is imported under more than one alias (%s); a form here would \
|
|
have to mean all of them"
|
|
dir
|
|
(String.concat ", " (List.map (fun p -> p.Load.alias) ps)))
|
|
|
|
(* A name the running process exports. Everything else is looked up by name at
|
|
install time — see [Emit.redefinition]'s [known]. *)
|
|
let known t n =
|
|
List.exists (fun (f : Tast.fn) -> String.equal f.Tast.name n) t.host.Tast.fns
|
|
|| List.exists
|
|
(fun (g : Tast.global) -> String.equal g.Tast.gname n)
|
|
t.host.Tast.globals
|
|
|
|
(* ── What a running process cannot be told ─────────────────────────── *)
|
|
|
|
(* Everything here is a change that would load cleanly and then be wrong. The
|
|
house rule (NEXT.md, Watch for) says recognise it and refuse with the
|
|
reason, so each one names what it would have broken. *)
|
|
let compatible ?(origin = fun _ -> None) ~loc (old_ : Tast.program)
|
|
(new_ : Tast.program) =
|
|
let find_fn p n =
|
|
List.find_opt (fun (f : Tast.fn) -> String.equal f.Tast.name n) p.Tast.fns
|
|
in
|
|
List.iter
|
|
(fun (f : Tast.fn) ->
|
|
match find_fn old_ f.Tast.name with
|
|
| None -> ()
|
|
| Some g ->
|
|
let same =
|
|
List.length f.Tast.params = List.length g.Tast.params
|
|
&& List.for_all2 Types.equal f.Tast.params g.Tast.params
|
|
&& Types.equal f.Tast.ret g.Tast.ret
|
|
in
|
|
(* A cell holds a bare pointer. Every call site compiled before this
|
|
change still passes the old arguments through it.
|
|
|
|
This refusal is correct for what is built and is *not* the design
|
|
plan.org now describes: a signature change should make a new
|
|
internal function version with its own trampoline, leave existing
|
|
callers and stored [Fn] values safely on the old one, and warn at
|
|
each tracked stale caller site. That needs versions, trampolines
|
|
and caller tracking, none of which exist — so this stays a refusal
|
|
until they do, rather than becoming a silent mismatch. See
|
|
plan.org, Hot reload, and open decision #6. *)
|
|
if not same then
|
|
(* ── When the name is not one the programmer wrote ──────────────
|
|
A generic's instantiations are named [sort!-i32], [sort!-f32]
|
|
and so on, and the mangling carries only the *type variables*
|
|
— so editing the generic's other parameters changes every copy's
|
|
signature at once, under the same names. The refusal then
|
|
arrives about [sort!-i32], which appears nowhere in the file
|
|
being edited, for a reason invisible at the edited line.
|
|
|
|
So the refusal says where the name came from: which generic, at
|
|
which types, and that every copy changed together. The
|
|
programmer's next move is a restart either way — the point is
|
|
that they can tell *why* without going looking for a function
|
|
that does not exist in the source.
|
|
|
|
Note what does *not* come through here: adding or removing a
|
|
[where] clause changes no signature at all. It changes which
|
|
call sites are legal, and those refusals land at the call sites,
|
|
in the checker, before this is ever reached. *)
|
|
let what, note =
|
|
match origin f.Tast.name with
|
|
| None -> f.Tast.name, ""
|
|
| Some (gname, tys) ->
|
|
( Printf.sprintf "%s, the copy of the generic %s at %s"
|
|
f.Tast.name gname
|
|
(String.concat ", " (List.map Types.to_string tys)),
|
|
Printf.sprintf
|
|
" Editing %s changed every copy of it at once, so this \
|
|
refusal is about a function the source does not name."
|
|
gname )
|
|
in
|
|
fail loc
|
|
"%s changes signature, from (Fn [%s] %s) to (Fn [%s] %s); \
|
|
the calls already compiled into the running program pass the old \
|
|
one.%s Restart to change it."
|
|
what
|
|
(String.concat " " (List.map Types.to_string g.Tast.params))
|
|
(Types.to_string g.Tast.ret)
|
|
(String.concat " " (List.map Types.to_string f.Tast.params))
|
|
(Types.to_string f.Tast.ret)
|
|
note)
|
|
new_.Tast.fns;
|
|
List.iter
|
|
(fun (g : Tast.global) ->
|
|
match
|
|
List.find_opt
|
|
(fun (h : Tast.global) -> String.equal h.Tast.gname g.Tast.gname)
|
|
old_.Tast.globals
|
|
with
|
|
(* A [defconst] is folded into its call sites — into an array length, at
|
|
worst, which is decided before any type resolves — so its value is in
|
|
the running program's code and not only in its storage. A [defvar]'s
|
|
initial value is the opposite case and must *not* be refused: the
|
|
storage holds live state the program has long since moved past, which
|
|
is the whole of "edit the code, keep the sand". Same record, opposite
|
|
answers, told apart by [gconst]. *)
|
|
(* Only a constant the *checker* consumed. Its value is in the shape of
|
|
the running program — [(defconst rows (/ h c))] decides the type of
|
|
[grid] before anything else resolves — so no store can reach it. A
|
|
constant that is only ever read at run time is just bytes in memory:
|
|
a dev build emits it as a mutable global and a redefinition stores
|
|
the new value, which is how a colour table is tuned live. *)
|
|
| Some h
|
|
when h.Tast.gconst && g.Tast.gconst && h.Tast.gfolded
|
|
&& Types.equal g.Tast.gty h.Tast.gty
|
|
&& not (same_const g.Tast.ginit h.Tast.ginit) ->
|
|
fail loc
|
|
"%s is used at compile time — an array length or a type — so the \
|
|
running program has its old value in its shape, where a reload \
|
|
cannot reach it. Restart to change it."
|
|
g.Tast.gname
|
|
| Some h when not (Types.equal g.Tast.gty h.Tast.gty) ->
|
|
(* The storage exists and has a shape. Reusing it for another one
|
|
reads fields at the wrong offsets; allocating fresh storage would
|
|
silently discard the state the reload exists to preserve. *)
|
|
fail loc
|
|
"%s changes type, from %s to %s; the running program already laid \
|
|
that storage out. Restart to change it."
|
|
g.Tast.gname (Types.to_string h.Tast.gty) (Types.to_string g.Tast.gty)
|
|
| _ -> ())
|
|
new_.Tast.globals;
|
|
List.iter
|
|
(fun (s : Tast.structure) ->
|
|
match
|
|
List.find_opt
|
|
(fun (r : Tast.structure) -> String.equal r.Tast.sname s.Tast.sname)
|
|
old_.Tast.structs
|
|
with
|
|
| Some r ->
|
|
let fields (x : Tast.structure) =
|
|
List.map (fun (f : Tast.field) -> (f.Tast.fname, f.Tast.fty))
|
|
x.Tast.fields
|
|
in
|
|
let same =
|
|
List.length s.Tast.fields = List.length r.Tast.fields
|
|
&& List.for_all2
|
|
(fun (an, at) (bn, bt) -> String.equal an bn && Types.equal at bt)
|
|
(fields s) (fields r)
|
|
in
|
|
(* Every value of this type in the running program has the old layout,
|
|
including ones held in globals that the reload is preserving. *)
|
|
if not same then
|
|
fail loc
|
|
"%s changes layout; the values the running program is holding have \
|
|
the old one. Restart to change it."
|
|
s.Tast.sname
|
|
| None -> ())
|
|
new_.Tast.structs
|
|
|
|
(* An enum member is erased to an [i32] literal in the caller — [:space] at a
|
|
call site resolves to a number and is folded there — so changing one cannot
|
|
reach code that is already compiled, exactly like a [defconst]. It has to be
|
|
compared over declarations rather than over [Tast.program], which carries no
|
|
enums at all for that same reason. *)
|
|
let compatible_enums ~loc old_ new_ =
|
|
let members (ds : Ast.decl list) =
|
|
List.filter_map
|
|
(fun (d : Ast.decl) ->
|
|
match d.Ast.d with Ast.Defenum (n, ms) -> Some (n, ms) | _ -> None)
|
|
ds
|
|
in
|
|
let before = members old_ in
|
|
List.iter
|
|
(fun (n, ms) ->
|
|
match List.assoc_opt n before with
|
|
| Some old_ms when old_ms <> ms ->
|
|
fail loc
|
|
"%s changes its members; the running program folded the old values \
|
|
into every call site that names one. Restart to change it."
|
|
n
|
|
| _ -> ())
|
|
(members new_)
|
|
|
|
(* ── Accepting a change ────────────────────────────────────────────── *)
|
|
|
|
(* The redefinition unit is a list of top-level forms, so this is one path for
|
|
both editor commands: C-c C-c sends one form, C-c C-k sends a file. *)
|
|
type change = {
|
|
ir : string; (* the module to build and send *)
|
|
(* Which backend wrote [ir], and therefore which builder and which file
|
|
extension it wants: LLVM IR through [Build.shared], or x86-64 assembly
|
|
through [Build.shared_x86]. It rides on the change rather than being
|
|
looked up again at the build, so the text and the choice of builder can
|
|
never come from two different answers to the same question. *)
|
|
x86 : bool;
|
|
names : string list; (* everything the forms declared *)
|
|
fns : string list; (* the subset that has a body to install *)
|
|
(* False when the module would define nothing: no body to publish and no
|
|
storage to allocate. Building and delivering one anyway reports success
|
|
for a change that cannot have had an effect, and costs the program a
|
|
frame's worth of reload it did not need. *)
|
|
installs : bool;
|
|
}
|
|
|
|
(* [pause] is [C-u C-c C-c]: the position, in the source just sent, of the form
|
|
the program should stop at — docs/DISCUSS.md §9. It arrives as a separate field
|
|
rather than spliced into [src], because splicing text would move every
|
|
location after it, and it is applied below to the *declarations*, once
|
|
parsing has attached those locations and [Load] has qualified the names.
|
|
|
|
Nothing here makes it stick and nothing has to: the marked declaration is
|
|
what goes into [t.decls], so it stays marked until an evaluation replaces
|
|
it — which is an ordinary [C-c C-c] over the same form, with no [:pause].
|
|
That is §9's settled behaviour, and it is the same one statement that
|
|
accepts every other change. *)
|
|
(* The one place the backend choice is made, so that the six callers below
|
|
cannot disagree about it and the refusal has one home.
|
|
|
|
There is no fallback and there must not be one. If [X86.redefinition]
|
|
refuses a form, the daemon reports the refusal; quietly building an LLVM
|
|
module instead would hand an [--x86] host a module from the other backend,
|
|
which is the crossed pair [flan.abi.x86] exists to refuse at [dlopen]. A
|
|
refusal a user can read is the right answer; a segfault three frames later
|
|
is not. *)
|
|
let redefinition (t : t) ?retains ?call ?(consts = []) program ~fns =
|
|
if not t.x86 then
|
|
Emit.redefinition ~dev:true ~debug:t.debug ~known:(known t) ?retains
|
|
~consts ?call program ~fns
|
|
else
|
|
match
|
|
X86.redefinition ~checks:true ~dev:true ~known:(known t) ?retains ~consts
|
|
?call program ~fns
|
|
with
|
|
| asm -> asm
|
|
(* The dev backend covers a subset of the IR and refuses the rest by name,
|
|
which is what makes a build that succeeds one it really compiled. A
|
|
refusal has to reach the editor as a diagnostic like every other, so it
|
|
is re-raised at the form it is about -- the first name being redefined,
|
|
which is where a reader would look. Every caller already handles
|
|
[Loc.Error]; none of them handles [X86.Unsupported], and a session that
|
|
died on the first unsupported form would be worse than one that says so
|
|
and stays up. *)
|
|
| exception X86.Unsupported m ->
|
|
let loc =
|
|
match
|
|
List.find_opt
|
|
(fun (f : Tast.fn) -> List.mem f.Tast.name fns)
|
|
program.Tast.fns
|
|
with
|
|
| Some f -> f.Tast.floc
|
|
| None -> Loc.unknown
|
|
in
|
|
fail loc "the x86 dev backend cannot compile this: %s" m
|
|
|
|
(* ── Undoing an acceptance ─────────────────────────────────────────── *)
|
|
|
|
(* Checking is not the last thing that can fail, and until this existed the
|
|
session behaved as though it were. [eval] assigns the four mutable fields
|
|
the moment a form checks; the *build* and the *delivery* happen afterwards,
|
|
in the daemon, and either can refuse — llc can fail, and the agent's reload
|
|
ring can be full, which a parked program guarantees after enough queued
|
|
installs, since nothing drains the ring while the main thread waits. The
|
|
editor saw an error either way, so the evaluation looked refused; the
|
|
session went on holding the declaration anyway.
|
|
|
|
That leftover is not untidiness, it is a segfault. A declaration the session
|
|
holds and the host does not export is a name every later module lists in its
|
|
install prologue, and the prologue interns a cell for it. A cell nothing
|
|
ever stored a body into is NULL, and a dev build's call through a cell is a
|
|
load and an indirect call with no test in front of it — so the next
|
|
[C-x C-e], the next locals render, the next globals refresh jumps the game
|
|
thread to address 0. One failed build, and the next thing anybody types
|
|
kills the program.
|
|
|
|
So the four fields are one unit that can be put back. [held] is what the
|
|
session was before the evaluation and [restore] is the session being that
|
|
again — all four together, because they are four views of one answer: the
|
|
declarations, the checked program, the checker's environment, and the macros
|
|
a later form expands against. Putting back three of them would leave the
|
|
checker willing to accept a call to a name the program does not have, which
|
|
is the same crash by a longer road.
|
|
|
|
What a restored session can claim is the honest sentence rather than the one
|
|
anyone would rather have: it holds no declaration that no module was
|
|
*accepted* for. Accepted is not installed — the agent queues a module and
|
|
the game thread installs it at a frame boundary — but a queued module is one
|
|
the process has and will run, and that is as far as this side can see.
|
|
|
|
A [defmacro] evaluated in the same breath as a [defn] that fails to build
|
|
goes back with it, and that is right: they arrived as one form and were
|
|
accepted as one. A [defmacro] on its own never reaches a restore, because a
|
|
change with no body to install and no storage to allocate is answered before
|
|
anything is built.
|
|
|
|
[thunks] is not in here. It is a counter that keeps two evaluations from
|
|
naming their thunks alike, not something the session believes about the
|
|
program, and the agent refuses a full ring *before* it dlopens — so a
|
|
rolled-back number would be reused for a module nothing ever mapped, and
|
|
reusing it is the one way to make two live modules share a symbol. *)
|
|
type held = {
|
|
hdecls : Ast.decl list;
|
|
hprogram : Tast.program;
|
|
henv : Check.env;
|
|
hmacros : Form.t list;
|
|
}
|
|
|
|
let held t =
|
|
{ hdecls = t.decls; hprogram = t.program; henv = t.env; hmacros = t.macros }
|
|
|
|
let restore t h =
|
|
t.decls <- h.hdecls;
|
|
t.program <- h.hprogram;
|
|
t.env <- h.henv;
|
|
t.macros <- h.hmacros
|
|
|
|
let eval ?(origin = "<eval>") ?pause t src : change =
|
|
let forms = Reader.read_all ~file:origin src in
|
|
Parse.with_imported t.macros @@ fun () ->
|
|
(* Through [Load] like any other source, so an evaluated (import ...) means
|
|
what it means in a file. Its expansion is what gets spliced, which is also
|
|
why the accumulated list is the post-Load one: re-evaluating a file that
|
|
imports something would otherwise append a second copy of the import and
|
|
the duplicate-name pass would reject it. *)
|
|
let macros = ref t.macros in
|
|
let incoming =
|
|
let l = Load.program ~file:t.file forms in
|
|
(* An evaluated import *adds* to the session's set, so a macro brought in
|
|
by C-c C-k is there for the C-c C-c after it. A union and not an
|
|
assignment: [Load.program] answers the macros of the imports it was
|
|
handed, and the one form C-c C-c sends has no import in it, so
|
|
replacing would empty the set on the first re-evaluation of a defn —
|
|
the macro would work on the build and be an unknown name on the
|
|
reload.
|
|
|
|
The incoming set comes first because [macro_union] keeps the left on a
|
|
name collision, and what [Load] just read off disk is newer than what
|
|
the session has been holding: editing a macro in a package and
|
|
reloading the file that imports it has to expand the new body. The
|
|
other order would keep the stale one and say nothing.
|
|
|
|
Held here and committed at the bottom with everything else, rather than
|
|
assigned on the spot: this is above the checker, and the session's rule
|
|
is that a form which does not check leaves it exactly as it was —
|
|
macros included. Nothing between here and there reads [t.macros]:
|
|
[Load.program] puts the imported set in front of the parse it drives
|
|
itself, and the checker below is handed declarations that are already
|
|
parsed.
|
|
|
|
And the forms just sent come in front of both, which is the half that
|
|
makes a [defmacro] typed at the editor mean anything. A [defmacro] is
|
|
an ordinary declaration on this path already — it parses to a [Defn]
|
|
and installs a body like any other — so the only thing missing was the
|
|
session remembering that the name is a macro. It does now, and the
|
|
shape that follows is the one [defn] already has: the declaration
|
|
joins the session, and the *next* evaluation can call it. Not a re-read
|
|
of the file, which would also pick up macros the session was never told
|
|
about and would put unsaved-versus-saved skew into expansion.
|
|
|
|
Left-wins again, and here it is what lets a macro be edited: the
|
|
incoming body replaces the one the session was holding under that
|
|
name. [Macro.program] dedupes the same way on the same rule, because
|
|
while this parse runs the old copy is still ambient. *)
|
|
macros :=
|
|
Load.macro_union (own_macros forms)
|
|
(Load.macro_union l.Load.macros t.macros);
|
|
let ds = l.Load.decls in
|
|
match package_of t origin with
|
|
| None -> ds
|
|
| Some p ->
|
|
(* Qualified exactly as the import qualified them, so a redefined
|
|
[settle] lands on [sim/settle] and its call to [move-grain] lands on
|
|
[sim/move-grain]. A name the package does not own — the prelude's, or
|
|
another package's — is left alone, which is the same rule [Load] uses
|
|
at import time and the reason both go through [qualify_decl]. *)
|
|
let owns =
|
|
p.Load.owns
|
|
@ List.filter_map Ast.declared_name ds
|
|
in
|
|
List.map (Load.qualify_decl owns p.Load.alias) ds
|
|
in
|
|
let loc =
|
|
match incoming with d :: _ -> d.Ast.dloc | [] -> Loc.unknown
|
|
in
|
|
(* After [qualify_decl], so a package that defines a [pause] of its own does
|
|
not capture the call this splices in. Refused when the position matches
|
|
nothing: installing an unmarked body and answering "ok" would report a
|
|
breakpoint that is not there. *)
|
|
let incoming =
|
|
match pause with
|
|
| None -> incoming
|
|
| Some (line, col) ->
|
|
(match Ast.mark_pause ~line ~col incoming with
|
|
| Some ds -> ds
|
|
| None ->
|
|
fail loc "nothing to pause at line %d, column %d of the form sent"
|
|
line col)
|
|
in
|
|
let names = List.filter_map Ast.declared_name incoming in
|
|
let replacement n =
|
|
List.find_opt
|
|
(fun (d : Ast.decl) -> Ast.declared_name d = Some n)
|
|
incoming
|
|
in
|
|
(* Replaced in place and appended only when genuinely new, so declaration
|
|
order — which is emission order for globals — does not shuffle on every
|
|
evaluation. *)
|
|
let replaced = ref [] in
|
|
let kept =
|
|
List.map
|
|
(fun (d : Ast.decl) ->
|
|
match Ast.declared_name d with
|
|
| Some n ->
|
|
(match replacement n with
|
|
| Some nd -> replaced := n :: !replaced; nd
|
|
| None -> d)
|
|
| None -> d)
|
|
t.decls
|
|
in
|
|
let added =
|
|
List.filter
|
|
(fun (d : Ast.decl) ->
|
|
match Ast.declared_name d with
|
|
| Some n -> not (List.exists (String.equal n) !replaced)
|
|
| None -> false)
|
|
incoming
|
|
in
|
|
let decls = kept @ added in
|
|
(* Nothing above this line has changed the session. A [Loc.Error] from here
|
|
leaves it exactly as it was. *)
|
|
let program, env = Check.program_with_env decls in
|
|
compatible ~origin:(Check.instantiation_origin env) ~loc t.program program;
|
|
compatible_enums ~loc t.decls decls;
|
|
(* ── The bodies to install ────────────────────────────────────────────
|
|
The names the form declared that have a body in the checked program —
|
|
and, for a generic, the bodies its *copies* have, because a generic
|
|
[defn] never reaches [Tast.fns] at all. Without the second clause
|
|
[C-c C-c] on a generic reports [installs=false, fns=[]]: it installs
|
|
nothing and says nothing went wrong, which is the feature being unusable
|
|
in the loop the project exists for.
|
|
|
|
Transitivity is free. The check above was a whole-program check, so
|
|
[env.insts] already holds every copy every call site asked for, including
|
|
the ones a redefined generic pulled in by calling another generic at its
|
|
own variable.
|
|
|
|
The third clause is the one that makes a redefinition reach a type the
|
|
process was never built with. Redefining a *caller* so that it uses a
|
|
generic at a new element type generates a brand-new symbol the host has
|
|
never had — it is not [known t] and no name in [names] mentions it — so
|
|
it has to be found by being an instantiation that the running process
|
|
lacks. [Emit.redefinition] then writes it as a new by-name cell, which is
|
|
the same path a [defn] the process was never built with already takes. *)
|
|
let declared_fns =
|
|
List.filter
|
|
(fun n ->
|
|
List.exists
|
|
(fun (f : Tast.fn) -> String.equal f.Tast.name n)
|
|
program.Tast.fns)
|
|
names
|
|
in
|
|
let from_generics =
|
|
List.concat_map
|
|
(fun n ->
|
|
if Check.is_generic env n then Check.instantiations env n else [])
|
|
names
|
|
in
|
|
let new_instances =
|
|
List.filter_map
|
|
(fun (f : Tast.fn) ->
|
|
if known t f.Tast.name then None
|
|
else
|
|
match Check.instantiation_origin env f.Tast.name with
|
|
| Some _ -> Some f.Tast.name
|
|
| None -> None)
|
|
program.Tast.fns
|
|
in
|
|
let fns =
|
|
List.sort_uniq String.compare
|
|
(declared_fns @ from_generics @ new_instances)
|
|
in
|
|
(* A constant that changed and can be published: known to the host, not
|
|
consumed by the checker. The module stores its new value at the frame
|
|
boundary, exactly as it stores a new function body. *)
|
|
let consts =
|
|
List.filter
|
|
(fun n ->
|
|
known t n
|
|
&& List.exists
|
|
(fun (g : Tast.global) ->
|
|
String.equal g.Tast.gname n && g.Tast.gconst
|
|
&& not g.Tast.gfolded)
|
|
program.Tast.globals)
|
|
names
|
|
in
|
|
let ir = redefinition t ~consts program ~fns in
|
|
let allocates =
|
|
List.exists
|
|
(fun (g : Tast.global) -> not (known t g.Tast.gname))
|
|
program.Tast.globals
|
|
in
|
|
(* Every one of these together, and after the last thing *here* that can
|
|
raise: until this line the session is still the one the evaluation started
|
|
against, which is what makes a refusal cost nothing.
|
|
|
|
It is not the last thing that can fail, though, and this line used to be
|
|
written as if it were. The build and the delivery come after it, in the
|
|
daemon, and both can refuse — so the caller takes a [held] first and puts
|
|
it back when they do. See [restore] above for what a session that kept the
|
|
declaration anyway does to the program. *)
|
|
t.macros <- !macros;
|
|
t.decls <- decls;
|
|
t.program <- program;
|
|
t.env <- env;
|
|
{ ir; x86 = t.x86; names; fns; installs = fns <> [] || allocates || consts <> [] }
|
|
|
|
(* ── Evaluating an expression ──────────────────────────────────────── *)
|
|
|
|
(* [C-x C-e] is a different primitive from redefining a name, and this is where
|
|
the difference lives: there is no name to install a body into, so the
|
|
expression is wrapped in a function that has nowhere to be called from, and
|
|
the module says "run this once". The agent does, at a frame boundary.
|
|
|
|
Getting the value back does not marshal anything. A Flan value carries no
|
|
header, so nothing at run time could say what it is; the compiler knows the
|
|
type and renders it *there*, in the thunk. That is the layout decision's
|
|
bill, paid here — and it is why the renderer is a compile-time walk over the
|
|
type rather than a function in the runtime.
|
|
|
|
The rendering goes to [flan_dev_emit], a piece at a time, not to stdout.
|
|
Piecewise because a struct is its fields with punctuation between them and
|
|
concatenating that in generated IR would need an allocator the language does
|
|
not have; not stdout because stdout belongs to the program, is in the hot
|
|
path for anything that prints, and a dev-only feature must not put a branch
|
|
in it. *)
|
|
|
|
type emitter = { ename : string; ety : Types.t }
|
|
|
|
let emit_bytes = { ename = "flan/dev-emit"; ety = Types.Slice (Types.Int Types.U8) }
|
|
let emit_str = { ename = "flan/dev-emit-str"; ety = Types.Slice (Types.Int Types.U8) }
|
|
let emit_i64 = { ename = "flan/dev-emit-i64"; ety = Types.Int Types.I64 }
|
|
let emit_u64 = { ename = "flan/dev-emit-u64"; ety = Types.Int Types.U64 }
|
|
let emit_f64 = { ename = "flan/dev-emit-f64"; ety = Types.Float Types.F64 }
|
|
|
|
let externs : Tast.extern list =
|
|
let one e sym = { Tast.ename = e.ename; esym = sym; eparams = [ e.ety ];
|
|
eret = Types.Unit } in
|
|
[ one emit_bytes "flan_dev_emit";
|
|
one emit_str "flan_dev_emit_str";
|
|
one emit_i64 "flan_dev_emit_i64";
|
|
one emit_u64 "flan_dev_emit_u64";
|
|
one emit_f64 "flan_dev_emit_f64";
|
|
(* The address of a slot in a *stopped* frame, resolved by the agent
|
|
against the snapshot that break took. It is the one piece a locals
|
|
thunk cannot work out for itself: the compiler knows every slot's type
|
|
and name, and nothing but the running program knows where the frame
|
|
is. See [render_locals]. *)
|
|
{ Tast.ename = "flan/dev-slot"; esym = "flan_agent_frame_slot";
|
|
eparams = [ Types.Int Types.I64; Types.Int Types.I64 ];
|
|
eret = Types.Ptr (Types.Int Types.U8) };
|
|
{ Tast.ename = "flan/dev-begin"; esym = "flan_dev_result_begin";
|
|
eparams = []; eret = Types.Unit };
|
|
{ Tast.ename = "flan/dev-end"; esym = "flan_dev_result_end";
|
|
eparams = []; eret = Types.Unit };
|
|
(* The allocation registry's two questions about an address. Both take a
|
|
[(Ptr u8)] and every pointer is cast to it: the registry is asked
|
|
whether a *byte* is inside a block it knows, and the type at the far
|
|
end is the renderer's business and already known there.
|
|
|
|
[reg-live] returns i32 rather than bool because that is what the C
|
|
returns, and a Flan bool is one bit wide; the comparison to zero is
|
|
made below, where the type is spelled once.
|
|
|
|
[reg-emit] writes into the same result buffer every other piece of a
|
|
rendering goes to. It answers whether it wrote anything, which this
|
|
side ignores — the renderer needs the *emission*, and "nothing was
|
|
written" is already the right rendering for an address the registry
|
|
never saw. *)
|
|
{ Tast.ename = "flan/reg-live"; esym = "flan_dev_reg_live";
|
|
eparams = [ Types.Ptr (Types.Int Types.U8) ];
|
|
eret = Types.Int Types.I32 };
|
|
{ Tast.ename = "flan/reg-emit"; esym = "flan_dev_reg_emit";
|
|
eparams = [ Types.Ptr (Types.Int Types.U8) ];
|
|
eret = Types.Int Types.I32 } ]
|
|
|
|
(* The REPL's emitter. Each piece is one extern call: the dev runtime already
|
|
has a renderer per scalar, and [flan_dev_emit_str] already quotes and
|
|
escapes. See render.ml for what the five are and why they are functions. *)
|
|
let dev_emitter : Render.emitter =
|
|
let call em (x : Tast.expr) : Tast.expr =
|
|
{ Tast.e = Tast.Call (em.ename, [ x ]); ty = Types.Unit; loc = x.Tast.loc }
|
|
in
|
|
{ Render.ebytes = call emit_bytes;
|
|
estr = call emit_str;
|
|
ei64 = call emit_i64;
|
|
eu64 = call emit_u64;
|
|
ef64 = call emit_f64 }
|
|
|
|
(* And what the REPL may do with a pointer, which [println] may not. See
|
|
render.ml's [pointers] for why the two sides differ. *)
|
|
let dev_pointers : Render.pointers =
|
|
let i32 = Types.Int Types.I32 in
|
|
let ask name (p : Tast.expr) : Tast.expr =
|
|
let loc = p.Tast.loc in
|
|
let byte =
|
|
{ Tast.e = Tast.Prim (Tast.Cast (Types.Ptr (Types.Int Types.U8)), [ p ]);
|
|
ty = Types.Ptr (Types.Int Types.U8); loc }
|
|
in
|
|
{ Tast.e = Tast.Call (name, [ byte ]); ty = i32; loc }
|
|
in
|
|
{ Render.live =
|
|
(fun p ->
|
|
let loc = p.Tast.loc in
|
|
let zero = { Tast.e = Tast.Int (0L, Types.I32); ty = i32; loc } in
|
|
{ Tast.e = Tast.Prim (Tast.Ne, [ ask "flan/reg-live" p; zero ]);
|
|
ty = Types.Bool; loc });
|
|
(* Called for the emission and not for the answer, so the i32 is discarded
|
|
here rather than in render.ml: a [Do] whose last element is the unit is
|
|
the honest way to say "run this and forget what it said", and it keeps
|
|
the walk's node types true. *)
|
|
epitaph =
|
|
(fun p ->
|
|
let loc = p.Tast.loc in
|
|
{ Tast.e =
|
|
Tast.Do [ ask "flan/reg-emit" p;
|
|
{ Tast.e = Tast.Unit; ty = Types.Unit; loc } ];
|
|
ty = Types.Unit; loc }) }
|
|
|
|
(* ── The locals of a stopped frame ─────────────────────────────────── *)
|
|
|
|
(* The second half of what a break loop can show, and it is the same primitive
|
|
as [C-x C-e] pointed somewhere else.
|
|
|
|
Nothing marshals and nothing is read across the process boundary. A Flan
|
|
value carries no header, so the daemon could not make sense of bytes it
|
|
copied out even if it had them; what it has instead is the *type*, from
|
|
[Tast.fn.slots], and a name for it, from [snames] beside it. So it compiles
|
|
a thunk that renders those types at those addresses, in the program, and
|
|
reads back the text — exactly what an evaluated expression does, except
|
|
that the root is an address rather than an expression. That address is the
|
|
only thing that comes from the running program.
|
|
|
|
[bound] is which slots the program says have been reached. It is not an
|
|
optimisation: an unbound slot's entry is null, and a thunk that rendered
|
|
one would dereference null on the game thread of a program that is already
|
|
stopped. So the refusal happens here, before any code is emitted for it.
|
|
|
|
What comes back is one line per slot — name, type, value, tab separated.
|
|
Tab and newline are safe separators because every string the renderer emits
|
|
goes through [flan_dev_emit_str], which escapes both.
|
|
|
|
Each slot is rendered from its address rather than copied into the thunk
|
|
first. A copy would be one [alloca] the size of the slot — 40KB for sand's
|
|
grid — and the walk only ever shows eight elements of it. The cost is one
|
|
call to [flan/dev-slot] per leaf the walk reaches instead of one per slot,
|
|
which the depth and span caps already bound. *)
|
|
let render_locals ?(origin = "<locals>") t ~frame ~(fn : Tast.fn) ~bound
|
|
: change * (string * string) list =
|
|
let loc = fn.Tast.floc in
|
|
let extra = ref [] and nslots = ref 0 in
|
|
let c =
|
|
{ Render.structs = t.program.Tast.structs;
|
|
datas = t.program.Tast.datas;
|
|
unions = t.program.Tast.unions;
|
|
enums = Hashtbl.fold (fun k v acc -> (k, v) :: acc) t.env.Check.enums [];
|
|
emit = dev_emitter;
|
|
ptrs = Some dev_pointers;
|
|
alloc = (fun ty ->
|
|
let i = !nslots in
|
|
incr nslots;
|
|
extra := ty :: !extra;
|
|
i) }
|
|
in
|
|
let nullary n = { Tast.e = Tast.Call (n, []); ty = Types.Unit; loc } in
|
|
let bytes_of str =
|
|
{ Tast.e =
|
|
Tast.Prim (Tast.Bytes, [ { Tast.e = Tast.Str str; ty = Types.String; loc } ]);
|
|
ty = Types.Slice (Types.Int Types.U8); loc }
|
|
in
|
|
let lit str = c.Render.emit.Render.ebytes (bytes_of str) in
|
|
let refused = ref [] in
|
|
let refuse name why = refused := (name, why) :: !refused in
|
|
let one i ty name =
|
|
let idx n =
|
|
{ Tast.e = Tast.Int (Int64.of_int n, Types.I64); ty = Types.Int Types.I64; loc }
|
|
in
|
|
let address =
|
|
{ Tast.e = Tast.Call ("flan/dev-slot", [ idx frame; idx i ]);
|
|
ty = Types.Ptr (Types.Int Types.U8); loc }
|
|
in
|
|
let typed =
|
|
{ Tast.e = Tast.Prim (Tast.Cast (Types.Ptr ty), [ address ]);
|
|
ty = Types.Ptr ty; loc }
|
|
in
|
|
let v = { Tast.e = Tast.Deref typed; ty; loc } in
|
|
match Render.render c 0 v with
|
|
| parts ->
|
|
(* The slot *index* travels with the line, last, and it is what makes
|
|
[i] in the break buffer able to name this exact slot back to the
|
|
daemon. The name cannot: [check.ml]'s [fresh_slot] only ever
|
|
allocates, so (let [v 22] …) inside (let [v 11] …) is two slots both
|
|
called [v] and both listed here. Nor can the position in the list,
|
|
because a refused slot is not in it. See [render_slot]. *)
|
|
Some
|
|
((lit (name ^ "\t" ^ Types.to_string ty ^ "\t") :: parts)
|
|
@ [ lit ("\t" ^ string_of_int i ^ "\n") ])
|
|
| exception Loc.Error { Loc.dmsg = why; _ } ->
|
|
(* A type the structural printer has no arm for — a map, a function
|
|
value, a type variable. Named, with the reason, rather than left out
|
|
of the list: a local that is missing and a local that could not be
|
|
printed are different facts. *)
|
|
refuse name why;
|
|
None
|
|
in
|
|
let body =
|
|
List.concat
|
|
((List.filter_map
|
|
(fun i ->
|
|
let ty = fn.Tast.slots.(i) in
|
|
let name =
|
|
if i < Array.length fn.Tast.snames then fn.Tast.snames.(i)
|
|
else None
|
|
in
|
|
match name with
|
|
| None ->
|
|
(* A slot the compiler made up: [dotimes]'s hidden bound, the
|
|
temporary a (min) evaluates an operand into. There is no
|
|
name to show and inventing one would put a variable in the
|
|
list that nobody can find in the file. *)
|
|
refuse (Printf.sprintf "s%d" i)
|
|
"a slot the compiler made up; no name was written for it";
|
|
None
|
|
| Some name when not (List.mem i bound) ->
|
|
refuse name
|
|
"not bound yet at the point the program stopped";
|
|
None
|
|
| Some name -> one i ty name)
|
|
(List.init (Array.length fn.Tast.slots) (fun i -> i))))
|
|
in
|
|
t.thunks <- t.thunks + 1;
|
|
let name = Printf.sprintf "locals/%d" t.thunks in
|
|
let thunk : Tast.fn =
|
|
{ Tast.name; params = []; ret = Types.Unit;
|
|
body = (nullary "flan/dev-begin" :: body) @ [ nullary "flan/dev-end" ];
|
|
fdefers = []; fparent = None; floc = loc;
|
|
slots = Array.of_list (List.rev !extra);
|
|
(* Every slot in here is the walk's own scratch: the locals being shown
|
|
are the *other* frame's, and this thunk reaches them by address. *)
|
|
snames = Array.make (List.length !extra) None }
|
|
in
|
|
let program =
|
|
{ t.program with
|
|
Tast.fns = t.program.Tast.fns @ [ thunk ];
|
|
externs = t.program.Tast.externs @ externs }
|
|
in
|
|
let ir =
|
|
redefinition t ~call:name program ~fns:[ name ]
|
|
in
|
|
ignore origin;
|
|
({ ir; x86 = t.x86; names = []; fns = []; installs = true }, List.rev !refused)
|
|
|
|
(* ── One slot of a stopped frame, walked ───────────────────────────── *)
|
|
|
|
(* The inspector's second rooting mode, and the whole of what it needed.
|
|
|
|
The inspector navigates by rewriting *expressions* — `(.pos b)' where the
|
|
last one was `b' — because a Flan value has no header and the thunk that
|
|
rendered it is [dlclose]d as soon as it returns, so nothing can be held on
|
|
this side the way CIDER holds a JVM object. The cost of that is the bug it
|
|
had: a name sent back to be evaluated is evaluated wherever the evaluator
|
|
stands, which on any frame but the innermost may resolve to a global, to a
|
|
different binding, or to nothing, with the listing above it still showing
|
|
the frame's own storage.
|
|
|
|
Rooting at the slot's address alone does not fix it — an address is not an
|
|
expression, so the first step has nothing to build from. What makes this
|
|
work is that the step does not have to be an expression either. A frame's
|
|
address comes from the shadow stack and every slot's type comes from
|
|
[Tast.fn.slots], so a step into a field is an address plus an offset with
|
|
that field's type, which is *exactly* the arithmetic [Render.render] does
|
|
for the locals listing. So this is [render_locals] with a path applied to
|
|
the root before the walk, and not a second walk.
|
|
|
|
What the path cannot do is the honest half. Every step is refused by name
|
|
with its reason rather than guessed at: a field the type does not have, an
|
|
index past the end of a fixed array, an option's payload on something that
|
|
is not an option. A pointer is still never followed — that is the
|
|
renderer's rule and not this mode's. *)
|
|
|
|
(* A step, as the editor sends it. [Sfield] on a data type carries the case as
|
|
well, because a data type's payload is at an offset that depends on which case
|
|
it is, and the renderer is what told the editor which case this value
|
|
currently holds. Guessing the case from a field name that two cases share
|
|
would read one case's layout over another's payload. *)
|
|
type step = Sfield of string | Sindex of int | Ssome
|
|
|
|
let step_text = function
|
|
| Sfield f -> "." ^ f
|
|
| Sindex i -> Printf.sprintf "[%d]" i
|
|
| Ssome -> ".some"
|
|
|
|
let path_text path = String.concat "" (List.map step_text path)
|
|
|
|
let step_into t (v : Tast.expr) (s : step) : (Tast.expr, string) result =
|
|
let loc = v.Tast.loc in
|
|
let ty = v.Tast.ty in
|
|
let no why = Error why in
|
|
match s with
|
|
| Ssome ->
|
|
(match ty with
|
|
| Types.Option pay -> Ok { Tast.e = Tast.Field (v, 1); ty = pay; loc }
|
|
| _ ->
|
|
no
|
|
(Printf.sprintf "%s is not an option, so it has no payload to go into"
|
|
(Types.to_string ty)))
|
|
| Sindex i ->
|
|
(match ty with
|
|
| Types.Array (n, el) ->
|
|
if i < 0 || Int64.compare (Int64.of_int i) n >= 0 then
|
|
no
|
|
(Printf.sprintf "%d is past the end of %s, which has %Ld elements" i
|
|
(Types.to_string ty) n)
|
|
else
|
|
Ok
|
|
{ Tast.e =
|
|
Tast.Prim
|
|
(Tast.At,
|
|
[ v;
|
|
{ Tast.e = Tast.Int (Int64.of_int i, Types.I32);
|
|
ty = Types.Int Types.I32; loc } ]);
|
|
ty = el; loc }
|
|
| Types.Slice el ->
|
|
(* A slice's length is not in its type, so this is the one step whose
|
|
range cannot be settled here. It is checked in the program, like
|
|
every other index in a dev build. *)
|
|
if i < 0 then no (Printf.sprintf "%d is not an index" i)
|
|
else
|
|
Ok
|
|
{ Tast.e =
|
|
Tast.Prim
|
|
(Tast.At,
|
|
[ v;
|
|
{ Tast.e = Tast.Int (Int64.of_int i, Types.I32);
|
|
ty = Types.Int Types.I32; loc } ]);
|
|
ty = el; loc }
|
|
| _ ->
|
|
no
|
|
(Printf.sprintf "%s is not an array or a slice, so it has no element %d"
|
|
(Types.to_string ty) i))
|
|
| Sfield spec ->
|
|
(match ty with
|
|
| Types.Named n
|
|
when List.exists (fun (u : Tast.data) -> String.equal u.Tast.dname n)
|
|
t.program.Tast.datas ->
|
|
let u =
|
|
List.find (fun (u : Tast.data) -> String.equal u.Tast.dname n)
|
|
t.program.Tast.datas
|
|
in
|
|
(* The editor spells this `Type.case.field', which is the head the
|
|
renderer wrote — `(Type.case {.field …})' — with the field appended.
|
|
A bare `case.field' is taken too, since that is the same fact said
|
|
shorter. *)
|
|
(match String.rindex_opt spec '.' with
|
|
| None ->
|
|
no
|
|
(Printf.sprintf
|
|
"%s is a data type: a field of it has to name the case that holds \
|
|
it, because the payload's offset depends on which case the \
|
|
value is in"
|
|
n)
|
|
| Some k ->
|
|
let case = String.sub spec 0 k
|
|
and fname = String.sub spec (k + 1) (String.length spec - k - 1) in
|
|
let case =
|
|
let pre = n ^ "." in
|
|
let lp = String.length pre in
|
|
if String.length case > lp && String.equal (String.sub case 0 lp) pre
|
|
then String.sub case lp (String.length case - lp)
|
|
else case
|
|
in
|
|
(match
|
|
List.find_opt
|
|
(fun (vr : Tast.variant) -> String.equal vr.Tast.vname case)
|
|
u.Tast.cases
|
|
with
|
|
| None ->
|
|
no (Printf.sprintf "%s has no case called %s" n case)
|
|
| Some vr ->
|
|
let rec idx i = function
|
|
| [] -> None
|
|
| (f : Tast.field) :: rest ->
|
|
if String.equal f.Tast.fname fname then Some (i, f.Tast.fty)
|
|
else idx (i + 1) rest
|
|
in
|
|
(match idx 0 vr.Tast.vfields with
|
|
| None ->
|
|
no
|
|
(Printf.sprintf "%s.%s has no field called %s" n case fname)
|
|
| Some (i, fty) ->
|
|
Ok
|
|
{ Tast.e = Tast.CaseField (v, vr.Tast.vname, i); ty = fty; loc })))
|
|
| Types.Named n ->
|
|
(match
|
|
List.find_opt
|
|
(fun (s : Tast.structure) -> String.equal s.Tast.sname n)
|
|
t.program.Tast.structs
|
|
with
|
|
| None ->
|
|
no
|
|
(Printf.sprintf
|
|
"%s is a type this session has no layout for, so there is no \
|
|
field to step to"
|
|
n)
|
|
| Some st ->
|
|
let rec idx i = function
|
|
| [] -> None
|
|
| (f : Tast.field) :: rest ->
|
|
if String.equal f.Tast.fname spec then Some (i, f.Tast.fty)
|
|
else idx (i + 1) rest
|
|
in
|
|
(match idx 0 st.Tast.fields with
|
|
| None ->
|
|
no (Printf.sprintf "%s has no field called %s" n spec)
|
|
| Some (i, fty) -> Ok { Tast.e = Tast.Field (v, i); ty = fty; loc }))
|
|
| _ ->
|
|
no
|
|
(Printf.sprintf "%s has no fields, so there is no .%s in it"
|
|
(Types.to_string ty) spec))
|
|
|
|
(* Renders slot [slot] of frame [frame], after walking [path] into it. The
|
|
thunk is [render_locals]'s, minus the loop over every slot: one root, one
|
|
line, and the reply carries the type the path ended at so the editor can
|
|
say what it is looking at.
|
|
|
|
The caller has already established that the frame is the body this session
|
|
holds — the slot fingerprint — and that the slot is bound. This function
|
|
does not re-derive either; it is handed the [fn] that check passed. *)
|
|
let render_slot ?(origin = "<inspect>") t ~frame ~(fn : Tast.fn) ~slot ~path
|
|
: (change * string * string, string) result =
|
|
let loc = fn.Tast.floc in
|
|
let nslots_of_fn = Array.length fn.Tast.slots in
|
|
if slot < 0 || slot >= nslots_of_fn then
|
|
Error
|
|
(Printf.sprintf "there is no slot %d in %s; it has %d" slot fn.Tast.name
|
|
nslots_of_fn)
|
|
else
|
|
let sname =
|
|
if slot < Array.length fn.Tast.snames then fn.Tast.snames.(slot) else None
|
|
in
|
|
match sname with
|
|
| None ->
|
|
Error
|
|
(Printf.sprintf
|
|
"slot %d of %s is one the compiler made up; no name was written for \
|
|
it, and it is not something the listing offers"
|
|
slot fn.Tast.name)
|
|
| Some name ->
|
|
let extra = ref [] and nslots = ref 0 in
|
|
let c =
|
|
{ Render.structs = t.program.Tast.structs;
|
|
datas = t.program.Tast.datas;
|
|
unions = t.program.Tast.unions;
|
|
enums = Hashtbl.fold (fun k v acc -> (k, v) :: acc) t.env.Check.enums [];
|
|
emit = dev_emitter;
|
|
ptrs = Some dev_pointers;
|
|
alloc = (fun ty ->
|
|
let i = !nslots in
|
|
incr nslots;
|
|
extra := ty :: !extra;
|
|
i) }
|
|
in
|
|
let idx n =
|
|
{ Tast.e = Tast.Int (Int64.of_int n, Types.I64); ty = Types.Int Types.I64;
|
|
loc }
|
|
in
|
|
let ty = fn.Tast.slots.(slot) in
|
|
let address =
|
|
{ Tast.e = Tast.Call ("flan/dev-slot", [ idx frame; idx slot ]);
|
|
ty = Types.Ptr (Types.Int Types.U8); loc }
|
|
in
|
|
let typed =
|
|
{ Tast.e = Tast.Prim (Tast.Cast (Types.Ptr ty), [ address ]);
|
|
ty = Types.Ptr ty; loc }
|
|
in
|
|
let root = { Tast.e = Tast.Deref typed; ty; loc } in
|
|
let rec walk v = function
|
|
| [] -> Ok v
|
|
| s :: rest ->
|
|
(match step_into t v s with
|
|
| Error why -> Error why
|
|
| Ok v' -> walk v' rest)
|
|
in
|
|
(match walk root path with
|
|
| Error why -> Error (name ^ path_text path ^ ": " ^ why)
|
|
| Ok v ->
|
|
(match Render.render c 0 v with
|
|
| exception Loc.Error { Loc.dmsg = why; _ } -> Error (name ^ path_text path ^ ": " ^ why)
|
|
| parts ->
|
|
let nullary n = { Tast.e = Tast.Call (n, []); ty = Types.Unit; loc } in
|
|
t.thunks <- t.thunks + 1;
|
|
let tname = Printf.sprintf "inspect/%d" t.thunks in
|
|
let thunk : Tast.fn =
|
|
{ Tast.name = tname; params = []; ret = Types.Unit;
|
|
body =
|
|
(nullary "flan/dev-begin" :: parts) @ [ nullary "flan/dev-end" ];
|
|
fdefers = []; fparent = None; floc = loc;
|
|
slots = Array.of_list (List.rev !extra);
|
|
snames = Array.make (List.length !extra) None }
|
|
in
|
|
let program =
|
|
{ t.program with
|
|
Tast.fns = t.program.Tast.fns @ [ thunk ];
|
|
externs = t.program.Tast.externs @ externs }
|
|
in
|
|
let ir =
|
|
redefinition t
|
|
~call:tname program ~fns:[ tname ]
|
|
in
|
|
ignore origin;
|
|
Ok
|
|
({ ir; x86 = t.x86; names = []; fns = []; installs = true },
|
|
name ^ path_text path,
|
|
Types.to_string v.Tast.ty)))
|
|
|
|
(* ── The globals a stopped stack reaches ───────────────────────────── *)
|
|
|
|
(* The other half of what a break loop can show, and in this language arguably
|
|
the more useful one: a game keeps most of its state in top-level [defvar]s,
|
|
and sand.flan holds its entire grid that way.
|
|
|
|
Almost the same thunk as [render_locals] with a different root, and the
|
|
difference is the whole reason this is a second function rather than a
|
|
parameter. A local is reached by *address* — [flan/dev-slot] hands back
|
|
where the frame is, and only the stopped program knows that. A global is
|
|
reached by *name*: [Emit.redefinition] writes a global the host already has
|
|
as [external], so the loaded module binds to the program's own storage and
|
|
the dynamic linker does the work. Nothing has to be asked of the stopped
|
|
thread at all, which is also why there is no [bound] list here — a global's
|
|
storage exists from the moment the process started, so there is no
|
|
not-yet-bound case to refuse.
|
|
|
|
[globals] is chosen by the caller and not here, because the choice is about
|
|
the *stack* and this function is about rendering. See [Dev.globals_op].
|
|
|
|
One line per global — name, type, value, tab separated — the same framing
|
|
[render_locals] uses, and safe for the same reason: every string the
|
|
renderer emits goes through [flan_dev_emit_str], which escapes both. *)
|
|
let render_globals ?(origin = "<globals>") t ~(globals : Tast.global list)
|
|
: change * (string * string) list =
|
|
let loc = Loc.unknown in
|
|
let extra = ref [] and nslots = ref 0 in
|
|
let c =
|
|
{ Render.structs = t.program.Tast.structs;
|
|
datas = t.program.Tast.datas;
|
|
unions = t.program.Tast.unions;
|
|
enums = Hashtbl.fold (fun k v acc -> (k, v) :: acc) t.env.Check.enums [];
|
|
emit = dev_emitter;
|
|
ptrs = Some dev_pointers;
|
|
alloc = (fun ty ->
|
|
let i = !nslots in
|
|
incr nslots;
|
|
extra := ty :: !extra;
|
|
i) }
|
|
in
|
|
let bytes_of str =
|
|
{ Tast.e =
|
|
Tast.Prim (Tast.Bytes, [ { Tast.e = Tast.Str str; ty = Types.String; loc } ]);
|
|
ty = Types.Slice (Types.Int Types.U8); loc }
|
|
in
|
|
let lit str = c.Render.emit.Render.ebytes (bytes_of str) in
|
|
let nullary n = { Tast.e = Tast.Call (n, []); ty = Types.Unit; loc } in
|
|
let refused = ref [] in
|
|
let one (g : Tast.global) =
|
|
let v = { Tast.e = Tast.Global g.Tast.gname; ty = g.Tast.gty; loc } in
|
|
match Render.render c 0 v with
|
|
| parts ->
|
|
Some
|
|
((lit (g.Tast.gname ^ "\t" ^ Types.to_string g.Tast.gty ^ "\t") :: parts)
|
|
@ [ lit "\n" ])
|
|
| exception Loc.Error { Loc.dmsg = why; _ } ->
|
|
(* A type the structural printer has no arm for. Named with its reason
|
|
rather than left out, for [render_locals]'s reason: a global that is
|
|
missing and a global that could not be printed are different facts,
|
|
and a list that showed neither would be the same lie twice. *)
|
|
refused := (g.Tast.gname, why) :: !refused;
|
|
None
|
|
in
|
|
let body = List.concat (List.filter_map one globals) in
|
|
t.thunks <- t.thunks + 1;
|
|
let name = Printf.sprintf "globals/%d" t.thunks in
|
|
let thunk : Tast.fn =
|
|
{ Tast.name; params = []; ret = Types.Unit;
|
|
body = (nullary "flan/dev-begin" :: body) @ [ nullary "flan/dev-end" ];
|
|
fdefers = []; fparent = None; floc = loc;
|
|
slots = Array.of_list (List.rev !extra);
|
|
(* Every slot in here is the walk's own scratch: what is being shown is
|
|
the program's storage, which this thunk reaches by name. *)
|
|
snames = Array.make (List.length !extra) None }
|
|
in
|
|
let program =
|
|
{ t.program with
|
|
Tast.fns = t.program.Tast.fns @ [ thunk ];
|
|
externs = t.program.Tast.externs @ externs }
|
|
in
|
|
let ir =
|
|
redefinition t ~call:name program ~fns:[ name ]
|
|
in
|
|
ignore origin;
|
|
({ ir; x86 = t.x86; names = []; fns = []; installs = true }, List.rev !refused)
|
|
|
|
(* [pause] is [C-u C-x C-e] — §9's "last expression" target. It is a flag and
|
|
not a position, because there is only one form here and it is the whole of
|
|
what was sent: the expression *is* the target. It is also why nothing here
|
|
sticks — a thunk is built and thrown away, so the mark lasts exactly one
|
|
evaluation, which is the truthful thing for an expression that has no
|
|
declaration to live in. *)
|
|
let eval_expr ?(origin = "<eval>") ?(pause = false) t src : change =
|
|
let form =
|
|
match Reader.read_all ~file:origin src with
|
|
| [ f ] -> f
|
|
| [] -> fail Loc.unknown "nothing to evaluate"
|
|
| _ :: f :: _ -> fail f.Form.loc "one expression at a time"
|
|
in
|
|
(* [Parse.expr] expands, so the imported set has to be in front of it here
|
|
exactly as [eval] puts it in front of a declaration: C-x C-e sends one
|
|
expression with no import in sight, and the session is the only thing
|
|
holding what the imports brought in. Without this the prelude's macros
|
|
would work and a package's would be an unknown name.
|
|
|
|
Expansion happens here, before the thunk is built and long before the
|
|
agent is asked for anything, so the three-way wait in [Dev.eval_expr] is
|
|
untouched: a cold macro module costs its ~300ms before that clock starts,
|
|
and the non-termination refusals raise [Loc.Error] out of this call, which
|
|
the daemon already answers as an error rather than a silence. *)
|
|
let parsed = Parse.with_imported t.macros (fun () -> Parse.expr form) in
|
|
(* Wrapped before the checker, so the call is checked like any other and a
|
|
prelude that stopped offering [pause] would be an ordinary unknown name
|
|
rather than a thunk that silently did not stop. The [Do] takes the
|
|
expression's own location for the reason [Ast.mark_pause] does: the frame
|
|
the break loop reports reads it. *)
|
|
let parsed =
|
|
if pause then
|
|
{ Ast.e = Ast.Do [ Ast.pause_call parsed.Ast.loc; parsed ];
|
|
Ast.loc = parsed.Ast.loc }
|
|
else parsed
|
|
in
|
|
(* Checking against the live environment can *generate* code: the first
|
|
[C-x C-e] of a call to a generic at a type nothing has used yet
|
|
instantiates it here, and the copy lands in [t.env] and in no program
|
|
anywhere. Marked before and collected after, and spliced into the module
|
|
below — without this the thunk calls a symbol the module never defines
|
|
and the host has no cell for. *)
|
|
let mark = Check.instance_mark t.env in
|
|
let checked, base, bnames = Check.expression t.env parsed in
|
|
let fresh = Check.instances_since t.env mark in
|
|
(* The thunk's frame starts at whatever [Check.expression] needed and grows
|
|
as the walk finds slices in it, so the slots the renderer asks for are
|
|
appended past [base] and collected here to size the frame below. *)
|
|
let extra = ref [] and nslots = ref (Array.length base) in
|
|
let c =
|
|
{ Render.structs = t.program.Tast.structs;
|
|
datas = t.program.Tast.datas;
|
|
unions = t.program.Tast.unions;
|
|
enums = Hashtbl.fold (fun k v acc -> (k, v) :: acc) t.env.Check.enums [];
|
|
emit = dev_emitter;
|
|
ptrs = Some dev_pointers;
|
|
alloc = (fun ty ->
|
|
let i = !nslots in
|
|
incr nslots;
|
|
extra := ty :: !extra;
|
|
i) }
|
|
in
|
|
let loc = checked.Tast.loc in
|
|
let nullary n = { Tast.e = Tast.Call (n, []); ty = Types.Unit; loc } in
|
|
let body =
|
|
(nullary "flan/dev-begin" :: Render.render c 0 checked)
|
|
@ [ nullary "flan/dev-end" ]
|
|
in
|
|
t.thunks <- t.thunks + 1;
|
|
let name = Printf.sprintf "eval/%d" t.thunks in
|
|
let thunk : Tast.fn =
|
|
{ Tast.name; params = []; ret = Types.Unit; body; fdefers = []; fparent = None; floc = loc;
|
|
slots = Array.append base (Array.of_list (List.rev !extra));
|
|
(* The expression's own [let]s keep their names; the slots [render] added
|
|
behind them are the walk's own scratch and have none to keep. *)
|
|
snames = Array.append bnames (Array.make (List.length !extra) None) }
|
|
in
|
|
(* Built against the program but never spliced into it: an evaluation is not
|
|
a declaration, and adding one would leave the session carrying an eval/N
|
|
for every expression ever typed. *)
|
|
let program =
|
|
{ t.program with
|
|
Tast.fns = t.program.Tast.fns @ fresh @ [ thunk ];
|
|
externs = t.program.Tast.externs @ externs }
|
|
in
|
|
let ir =
|
|
(* The thunk gets debug info on the same flag as everything else. It is a
|
|
function nobody sets a breakpoint on by name, but it is a frame on the
|
|
stack when the expression signals, and a frame the debugger cannot name
|
|
is the thing the conditions buffer is trying to stop showing. *)
|
|
redefinition t ~call:name program
|
|
~fns:(List.map (fun (f : Tast.fn) -> f.Tast.name) fresh @ [ name ])
|
|
in
|
|
(* The copies stay in the session's program, unlike the thunk: the thunk is
|
|
not a declaration and there is nothing to keep, but a copy that has been
|
|
built and loaded *is* part of the running process from here on, and
|
|
forgetting it would generate a second one under the same name at the next
|
|
evaluation.
|
|
|
|
After [Emit], not before it: the session must not come to believe it holds
|
|
a body that no module was ever written for. A daemon that answers and has
|
|
lost track of what the program contains is worse than one that died.
|
|
|
|
Written for is as far as this line can get, and it is not far enough on
|
|
its own: the module still has to build and still has to be taken. The
|
|
caller closes that half by taking a [held] before this and restoring it
|
|
when either fails — a copy the session holds and no module defines is a
|
|
null cell exactly as a stranded declaration is. *)
|
|
t.program <- { t.program with Tast.fns = t.program.Tast.fns @ fresh };
|
|
{ ir; x86 = t.x86; names = []; fns = []; installs = true }
|
|
|
|
(* ── What a macro call expands to ──────────────────────────────────── *)
|
|
|
|
(* [C-c C-m]. The one thing the editor can ask that compiles nothing, sends
|
|
nothing to the program, and leaves the session exactly as it found it.
|
|
|
|
It is a session operation rather than a [Reader] plus a [Macro] call for the
|
|
reason the whole of this file exists: what a call expands to is decided by
|
|
*which macros this session holds* — the prelude's, the ones its imports
|
|
brought in, and the [defmacro]s the buffer has evaluated since it started —
|
|
and that set lives in [t.macros] and nowhere else. Expanding against a fresh
|
|
read of the file would answer with macros the session was never told about
|
|
and with a version of the ones it was told about that is whatever happens to
|
|
be *saved*. An expansion that disagreed with what an evaluation does would
|
|
be worse than no expansion at all: a macro decides what the code is.
|
|
|
|
Nothing here is assigned. [eval] commits [t.macros] and [eval_expr] bumps
|
|
[t.thunks] and [t.program]; this reads and writes nothing, so a form that
|
|
only *looks* like a declaration — a [defmacro] handed to [C-c C-m] — does
|
|
not join the session by having been looked at. [test_session] pins that. *)
|
|
|
|
type expansion = {
|
|
xbefore : Form.t; (* what was sent, quasiquote already desugared *)
|
|
xafter : Form.t; (* what it expands to *)
|
|
xmacro : string option; (* the macro at the head, when the head is one *)
|
|
(* False when the expansion is the form itself. Reported rather than left for
|
|
the editor to diff, because the two ways of being unchanged are different
|
|
facts: a head that names no macro, and a macro whose answer is its own
|
|
call. Only [xmacro] tells them apart. *)
|
|
xchanged : bool;
|
|
}
|
|
|
|
(* [all] is the difference between CIDER's two commands, and it is real here
|
|
rather than inherited: a macro may quasiquote a call to another macro, so
|
|
[(mac/quad 3)] one-stepped is [(mac/twice (mac/twice 3))] and all the way is
|
|
[(+ (+ 3 3) (+ 3 3))].
|
|
|
|
The refusals both live on the [all] path and both are [Loc.Error], which the
|
|
daemon answers as a reply: a macro that never settles is stopped by
|
|
[Macro.fuel] and named, and a ring of macros was refused while the package
|
|
holding it was parsed, which is before any session over it could exist. One
|
|
step cannot reach either — it makes exactly one call and does not look at
|
|
the answer — so [(s/spin)] one-stepped is a fact about the macro and only
|
|
[C-u] refuses. *)
|
|
let macroexpand ?(origin = "<eval>") ~(all : bool) t (src : string) : expansion =
|
|
let form =
|
|
match Reader.read_all ~file:origin src with
|
|
| [ f ] -> f
|
|
| [] -> fail Loc.unknown "nothing to expand"
|
|
| _ :: f :: _ -> fail f.Form.loc "one form at a time"
|
|
in
|
|
(* Desugared first, exactly as [Parse.parse_forms] does it and for its
|
|
reason: a quasiquote that has not been rewritten still looks like a call
|
|
to something named [quasiquote], and the [Form.Sym] inside it looks like a
|
|
head anything could mistake for one. *)
|
|
let before = Expand.quasiquote form in
|
|
(* And the session's macros in front of it, as [eval] and [eval_expr] both
|
|
put them: [Macro.program] reads [Parse.imported_macros] directly. *)
|
|
Parse.with_imported t.macros @@ fun () ->
|
|
let after, name =
|
|
if all then Macro.expand_all before else Macro.expand_step before
|
|
in
|
|
{ xbefore = before; xafter = after; xmacro = name;
|
|
(* Structural, through the printer both halves are shown with, so "changed"
|
|
means "would print differently" — which is the claim the buffer makes.
|
|
There is no equality on [Form.t] to use instead: it carries a [Loc.t],
|
|
and [Loc.from_macro] stamps a name onto every node a macro answers, so
|
|
even an identity expansion compares unequal. *)
|
|
xchanged = Form.to_source after <> Form.to_source before }
|