Joseph Ferano
96ab4c9cf0
print-str, print-i64, print-f64, print-bytes, print-line and newline leave the prelude. print and println are the whole printing surface now, and print is the better call at every one of the sites that used them: it is the same structural walk without the newline, so the no-newline case the family was kept for is covered, and it takes the value as it is. The old print-i64 forced an explicit (i64 x) at every call site, because this language widens nothing implicitly; that cast is gone from 127 places. Dropping it moves one answer. hash-grid returns u64, and the cast through the signed printer showed sand-headless's hash as -2851001042534928384. print routes a u64 through flan_u64_to_bytes, so it now prints 15595743031174623232 — the same 64 bits, read as the unsigned number they are. The pinned expectation follows the correction. test-flan-dev.el and test_session.ml both reached for print-line as "a name the prelude has"; they reach for rand-seed instead.
478 lines
22 KiB
OCaml
478 lines
22 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 *)
|
|
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;
|
|
}
|
|
|
|
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
|
|
|
|
let create ?(debug = false) ~file () =
|
|
let l = Load.program ~file (Parse.program (Reader.read_file file)) 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;
|
|
thunks = 0; debug }, 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 ~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
|
|
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. Restart to change it."
|
|
f.Tast.name
|
|
(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))
|
|
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 *)
|
|
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;
|
|
}
|
|
|
|
let eval ?(origin = "<eval>") t src : change =
|
|
let forms = Reader.read_all ~file:origin src in
|
|
(* 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 incoming =
|
|
let ds = (Load.program ~file:t.file (Parse.program forms)).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
|
|
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 ~loc t.program program;
|
|
compatible_enums ~loc t.decls decls;
|
|
let fns =
|
|
List.filter
|
|
(fun n ->
|
|
List.exists
|
|
(fun (f : Tast.fn) -> String.equal f.Tast.name n)
|
|
program.Tast.fns)
|
|
names
|
|
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 =
|
|
Emit.redefinition ~dev:true ~debug:t.debug ~known:(known t) ~consts program
|
|
~fns
|
|
in
|
|
let allocates =
|
|
List.exists
|
|
(fun (g : Tast.global) -> not (known t g.Tast.gname))
|
|
program.Tast.globals
|
|
in
|
|
t.decls <- decls;
|
|
t.program <- program;
|
|
t.env <- env;
|
|
{ ir; 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";
|
|
{ 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 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 }
|
|
|
|
let eval_expr ?(origin = "<eval>") 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
|
|
let checked, base, bnames = Check.expression t.env (Parse.expr form) 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;
|
|
enums = Hashtbl.fold (fun k v acc -> (k, v) :: acc) t.env.Check.enums [];
|
|
emit = dev_emitter;
|
|
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 @ [ 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. *)
|
|
Emit.redefinition ~dev:true ~debug:t.debug ~known:(known t) ~call:name
|
|
program ~fns:[ name ]
|
|
in
|
|
{ ir; names = []; fns = []; installs = true }
|