Joseph Ferano
37f8f77380
`(:op "set")` is `inspect`'s addressing with the arrow turned round: same frame, same slot index, same path steps, same fingerprint check, and a list of (path, expression) edits relative to what the buffer is showing. The thunk stores and then renders the same place, so what comes back is what the program holds afterwards rather than an echo of what was asked for. `stopped-only` was not enough for a write. It asks whether the program is stopped, and for a read that is the whole question — the worst a render can do against the wrong stop is print something true of a different frame. A module that *stores* through `flan/dev-slot` reaches its target through whatever snapshot is on top when the store runs, so a resume and a second stop inside the ~300ms build window lands it in the same slot index of a different stack. Not a fault: a plausible shape, in the wrong place, silently. So the agent grew `at-stop N` beside `stopped-only`, the generation `snap_push` already mints for the restart machinery, checked on the game thread at the moment the job is claimed. `stop` answers it, `inspect` carries it out on every reply, and a write that names a stop the program has left is refused before anything is built. Three refusals about where rather than what, and they are in session.ml above both backends because emit and x86 disagree about two of them. A data type's case field has no address that does not also settle the tag. An option's payload has none that does not settle whether there is one. A pointer would be an address this end made up, which is the blessing the registry exists to insist on. `Check.expression` grew a `want` and `Check.expressions` a shared frame: the first is why `3` into an `f32` field is an f32 three rather than "expected f32, found i32", and the second is why two edits in one commit are not two `let`s reading each other's storage.
1736 lines
82 KiB
OCaml
1736 lines
82 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
|
|
(* The flag is named because the backend is no longer something anybody
|
|
asked for: [flan dev] takes it by default, so the person reading this
|
|
chose a program and not a code generator. "unsupported" on its own
|
|
tells them their form is wrong, which it is not — it compiles, on the
|
|
other backend, and the whole of the fix is one flag on the daemon.
|
|
Naming it here rather than in the editor keeps the sentence with the
|
|
refusal it belongs to, and reaches [flan reload] too. *)
|
|
fail loc
|
|
"the x86 dev backend cannot compile this: %s. Restart the daemon with \
|
|
flan dev --llvm, which compiles every form this one refuses" 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)))
|
|
|
|
(* ── Writing one of them back ──────────────────────────────────────── *)
|
|
|
|
(* The inspector's other direction. SLY sets a value from the inspector and
|
|
the reason it is worth having here is the same one the read half has: a
|
|
game keeps its state in a struct somewhere, and the loop between "that
|
|
field is wrong" and "is it this value that fixes it" is the loop the whole
|
|
dev story is about. Changing it in the source and reloading answers a
|
|
different question — it answers what the *next* run does.
|
|
|
|
Everything about the addressing is the read half's, deliberately and not
|
|
for economy: the same root, the same [step_into], the same refusals for a
|
|
field a type does not have. A write that addressed values its own way would
|
|
be free to land somewhere the render above it never showed, which is the
|
|
whole class of bug [render_slot] exists to have closed.
|
|
|
|
What is new is two things. The walk has to end at a *place* and not at a
|
|
value, and the value being stored is an expression somebody typed, so it
|
|
goes through the checker against the type the walk ended at. Both of those
|
|
refuse, and both refuse with a sentence rather than by doing something
|
|
smaller than was asked. *)
|
|
|
|
(* The walk's last expression, as somewhere to store.
|
|
|
|
[step_into] builds exactly four shapes and three of them are places. That
|
|
is not a coincidence to be relied on quietly, so the fourth is named here
|
|
rather than left to fall through to a backend: [emit]'s [place] would
|
|
[failwith] on it and [x86]'s would not, and two backends disagreeing about
|
|
what is writable is worse than either answer.
|
|
|
|
Refused with the reason, not the layout. "A data type has no place form" is
|
|
a fact about this compiler; "the tag is what says which case the bytes are"
|
|
is the fact about the program, and it is the one that says why writing the
|
|
field alone would be wrong even if the offset were right. *)
|
|
let place_of (v : Tast.expr) : (Tast.place, string) result =
|
|
match v.Tast.e with
|
|
| Tast.Deref p -> Ok (Tast.Pderef p)
|
|
| Tast.Prim (Tast.At, target :: idx) when idx <> [] ->
|
|
Ok (Tast.Pindex (target, idx))
|
|
(* [Ssome] builds this too, and it is the one [Field] that is not writable:
|
|
an option is a tag and a payload, and storing the payload on its own
|
|
leaves a [None] holding a value — a value nothing will ever read, because
|
|
every reader asks the tag first. Set the option itself. *)
|
|
| Tast.Field (target, _) when (match target.Tast.ty with
|
|
| Types.Option _ -> true | _ -> false) ->
|
|
Error
|
|
"an option's payload is not a place on its own: the tag is what says \
|
|
whether there is one, and storing past it would leave a None holding a \
|
|
value nothing will ever look at. Set the option itself"
|
|
| Tast.Field (target, i) -> Ok (Tast.Pfield (target, i))
|
|
| Tast.CaseField (_, case, _) ->
|
|
Error
|
|
(Printf.sprintf
|
|
"%s is a field of a data type's case, and which case the bytes are in \
|
|
is what the tag says — so there is no address to store to that does \
|
|
not also have to settle the tag. Set the whole value instead"
|
|
case)
|
|
| _ ->
|
|
Error
|
|
(Printf.sprintf "%s is not somewhere a value can be stored"
|
|
(Types.to_string v.Tast.ty))
|
|
|
|
(* And the types that are places but must not be written through the editor.
|
|
|
|
A [Ptr] is the one that matters. Every other refusal here is about a shape;
|
|
this one is about where the number would come from. A pointer value typed
|
|
into a prompt is an address this end made up, and the registry's whole
|
|
argument is that an address is only worth anything with a blessing beside
|
|
it. Storing one would hand the program a pointer nothing ever blessed, to
|
|
be dereferenced at a moment nobody chose. The read half refuses to *follow*
|
|
a pointer for the same reason it is refused here. *)
|
|
let writable_type (ty : Types.t) : (unit, string) result =
|
|
match ty with
|
|
| Types.Ptr _ ->
|
|
Error
|
|
(Printf.sprintf
|
|
"%s is a pointer, and an address typed in here is one this end made \
|
|
up: nothing blessed it, and the program would dereference it at a \
|
|
moment nobody chose. The inspector does not follow pointers either"
|
|
(Types.to_string ty))
|
|
| _ -> Ok ()
|
|
|
|
(* Stores into slot [slot] of frame [frame], one store per [edits] entry,
|
|
after walking [path].
|
|
|
|
A list and not one store, because the buffer this exists for hands back a
|
|
whole value with several fields changed in it. N modules would be N builds
|
|
of a third of a second each and N trips past the agent's gate — so a
|
|
five-field edit would feel broken, and, worse, would be five separate
|
|
moments for a resume to land between. One module is one job: either every
|
|
store in it happened at this stop or none of them did.
|
|
|
|
Each edit's steps are relative to [path], which is what the buffer is
|
|
showing. A single field set from a line of the inspector is one edit with
|
|
one step; a whole value committed is one edit per changed leaf, with the
|
|
steps that reach it.
|
|
|
|
The thunk stores and then *renders*, between the same [dev-begin] and
|
|
[dev-end] the read half uses, and what comes back is therefore not the
|
|
editor's idea of what it asked for: it is what is actually there
|
|
afterwards, read out of the program's own storage by the printer that drew
|
|
the buffer in the first place.
|
|
|
|
[retains] is left at its default on purpose. A module that stores a string
|
|
literal leaves the program pointing into that module's image, and the
|
|
default is what keeps the mapping alive for it; claiming otherwise here to
|
|
save a page would be [(set msg "tuned")] left pointing at unmapped memory,
|
|
which [emit.ml] spells out where it writes [flan_reload_transient].
|
|
|
|
The caller has established the frame, as it has for [render_slot]. *)
|
|
let write_slot ?(origin = "<set>") t ~frame ~(fn : Tast.fn) ~slot ~path
|
|
~(edits : (step list * string) list)
|
|
: (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 if edits = [] then
|
|
(* Not a no-op quietly performed. A commit that found nothing to write is
|
|
a fact worth saying, and a module built to store nothing would cost a
|
|
third of a second to say it. *)
|
|
Error "there is nothing to store: nothing in this was changed"
|
|
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 where = name ^ path_text path 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 (where ^ ": " ^ why)
|
|
| Ok shown ->
|
|
(* Two passes over the edits, and the split is the point. This one
|
|
settles every *place* and refuses the whole commit if any of them
|
|
is not one, before a single expression has been read — so a buffer
|
|
with one impossible field in it stores nothing rather than storing
|
|
the fields that happened to sort first. The module's
|
|
all-or-nothing property would be an empty promise if this end had
|
|
already half-decided. *)
|
|
let rec places acc = function
|
|
| [] -> Ok (List.rev acc)
|
|
| (steps, code) :: rest ->
|
|
let at = where ^ path_text steps in
|
|
(match walk shown steps with
|
|
| Error why -> Error (at ^ ": " ^ why)
|
|
| Ok target ->
|
|
(match writable_type target.Tast.ty with
|
|
| Error why -> Error (at ^ ": " ^ why)
|
|
| Ok () ->
|
|
(match place_of target with
|
|
| Error why -> Error (at ^ ": " ^ why)
|
|
| Ok dest ->
|
|
places ((at, dest, target.Tast.ty, code) :: acc) rest)))
|
|
in
|
|
(match places [] edits with
|
|
| Error why -> Error why
|
|
| Ok targets ->
|
|
(* And this one reads and checks the values. Every expression is
|
|
checked against one [ctx] — [Check.expressions], not one
|
|
[Check.expression] each — because two expressions checked apart
|
|
both number their slots from zero, and splicing them into one
|
|
thunk would have the second one's [let] reading and writing the
|
|
first one's storage. *)
|
|
let mark = Check.instance_mark t.env in
|
|
let wanted =
|
|
List.map
|
|
(fun (at, _, tty, code) ->
|
|
let form =
|
|
match Reader.read_all ~file:origin code with
|
|
| [ f ] -> f
|
|
| [] -> fail loc "nothing to store into %s" at
|
|
| _ :: f :: _ -> fail f.Form.loc "one value at a time"
|
|
in
|
|
(* Expanded with the session's imported macros in front of
|
|
it, for the reason [eval_expr] gives: the prompt sends
|
|
one expression with no import in sight, and the session
|
|
is the only thing holding what the imports brought in. *)
|
|
(Some tty, Parse.with_imported t.macros (fun () -> Parse.expr form)))
|
|
targets
|
|
in
|
|
(* Checked *against the place's type*, which is the whole reason
|
|
[Check.expression] grew a [want]. Without it, [7] into an [f32]
|
|
field arrives as an [i32] and is refused for a mismatch the
|
|
reader never wrote; with it, it arrives as an [f32], and what
|
|
stays refused is what really does not fit — in the checker's
|
|
own words, which is the only place that sentence should ever be
|
|
written down. *)
|
|
let values, base, bnames = Check.expressions t.env wanted in
|
|
let fresh = Check.instances_since t.env mark in
|
|
let stores =
|
|
List.map2
|
|
(fun (_, dest, _, _) value ->
|
|
{ Tast.e = Tast.Set (dest, value); ty = Types.Unit; loc })
|
|
targets values
|
|
in
|
|
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
|
|
(match Render.render c 0 shown with
|
|
| exception Loc.Error { Loc.dmsg = why; _ } ->
|
|
Error (where ^ ": " ^ why)
|
|
| parts ->
|
|
let nullary n =
|
|
{ Tast.e = Tast.Call (n, []); ty = Types.Unit; loc }
|
|
in
|
|
t.thunks <- t.thunks + 1;
|
|
let tname = Printf.sprintf "set/%d" t.thunks in
|
|
let thunk : Tast.fn =
|
|
{ Tast.name = tname; params = []; ret = Types.Unit;
|
|
body =
|
|
stores
|
|
@ (nullary "flan/dev-begin" :: parts)
|
|
@ [ nullary "flan/dev-end" ];
|
|
fdefers = []; fparent = None; floc = loc;
|
|
slots = Array.append base (Array.of_list (List.rev !extra));
|
|
(* The stored expressions' 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
|
|
let program =
|
|
{ t.program with
|
|
Tast.fns = t.program.Tast.fns @ fresh @ [ thunk ];
|
|
externs = t.program.Tast.externs @ externs }
|
|
in
|
|
let ir =
|
|
redefinition t ~call:tname program
|
|
~fns:
|
|
(List.map (fun (f : Tast.fn) -> f.Tast.name) fresh
|
|
@ [ tname ])
|
|
in
|
|
(* The instances the values forced stay, the thunk does not —
|
|
[eval_expr] says why, and the caller takes the same [held]
|
|
around this that it takes around one. *)
|
|
t.program <-
|
|
{ t.program with Tast.fns = t.program.Tast.fns @ fresh };
|
|
Ok
|
|
({ ir; x86 = t.x86; names = []; fns = []; installs = true },
|
|
where, Types.to_string shown.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 }
|