(** 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 [print-line] 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 *) } 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 ~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 }, l) (* Which package a file being edited belongs to, if any. A form typed into sand-sim/sim.flan declares [settle], but the running program only ever knew it as [sim/settle]: 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 dir = try Filename.dirname (Unix.realpath origin) with Unix.Unix_error _ -> Filename.dirname origin in let same p = let d = try Unix.realpath p.Load.dir with Unix.Unix_error _ -> p.Load.dir in 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 = "") 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 ~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 } ] (* Two separate limits, easily conflated. [depth] and [span] bound the *walk*, so a big fixed array or a self-containing struct cannot turn one expression into a module with ten thousand render sites in it. How much text actually comes out is bounded in the runtime instead, once, for every renderer. *) let max_depth = 4 let max_span = 8 type ctx = { structs : Tast.structure list; enums : (string * (string * int64) list) list; (* Slots a rendered loop needs. The thunk's frame grows as the walk finds slices in it. *) mutable slots : Types.t list; (* reversed *) mutable nslots : int; } let slot c ty = let i = c.nslots in c.nslots <- i + 1; c.slots <- ty :: c.slots; i let rec render c depth (e : Tast.expr) : Tast.expr list = let loc = e.Tast.loc in let unit_ e = { Tast.e; ty = Types.Unit; loc } in let call em x = unit_ (Tast.Call (em.ename, [ x ])) in let cast t x = { Tast.e = Tast.Prim (Tast.Cast t, [ x ]); ty = t; loc } in let bytes_of s = { Tast.e = Tast.Prim (Tast.Bytes, [ { Tast.e = Tast.Str s; ty = Types.String; loc } ]); ty = Types.Slice (Types.Int Types.U8); loc } in let lit s = call emit_bytes (bytes_of s) in let int64 n = { Tast.e = Tast.Int (n, Types.I64); ty = Types.Int Types.I64; loc } in let i32 n = { Tast.e = Tast.Int (Int64.of_int n, Types.I32); ty = Types.Int Types.I32; loc } in let do_ xs = unit_ (Tast.Do xs) in if depth > max_depth then [ lit "..." ] else match e.Tast.ty with | Types.Int Types.U64 -> [ call emit_u64 e ] | Types.Int _ -> [ call emit_i64 (cast (Types.Int Types.I64) e) ] | Types.Float _ -> [ call emit_f64 (cast (Types.Float Types.F64) e) ] | Types.Bool -> [ unit_ (Tast.If (e, lit "true", lit "false")) ] (* Evaluated *and then* reported. A Unit expression is almost always a call made for its effect — (print-line "x") is the REPL's most ordinary input — so emitting the literal without running it would make the prompt answer () while nothing happened. *) | Types.Unit -> [ e; lit "()" ] | Types.String -> [ call emit_str { Tast.e = Tast.Prim (Tast.Bytes, [ e ]); ty = Types.Slice (Types.Int Types.U8); loc } ] (* Bytes are almost always text, and escaping makes the case where they are not readable rather than a mess. *) | Types.Slice (Types.Int Types.U8) -> [ call emit_str e ] (* An enum's members are erased to i32 before the backend sees them, so the name has to be recovered here, from the checker's table, as a chain of comparisons. Falling through to the number is not a failure: a value outside the declared members is exactly what you would want to see. *) | Types.Enum n -> let members = try List.assoc n c.enums with Not_found -> [] in let number = call emit_i64 (cast (Types.Int Types.I64) e) in List.fold_left (fun otherwise (name, v) -> let is = { Tast.e = Tast.Prim (Tast.Eq, [ cast (Types.Int Types.I64) e; int64 v ]); ty = Types.Bool; loc } in unit_ (Tast.If (is, lit (":" ^ name), otherwise))) number members |> fun x -> [ x ] (* A pointer is rendered as its shape and never followed: it is the only thing that could make this walk cycle, and dereferencing one a REPL was handed is not a safe thing to do on someone's behalf. *) | Types.Ptr _ -> [ lit "" ] | Types.Option t -> let tag = { Tast.e = Tast.Field (e, 0); ty = Types.Int Types.I8; loc } in let some = { Tast.e = Tast.Field (e, 1); ty = t; loc } in let is_some = { Tast.e = Tast.Prim (Tast.Ne, [ tag; { Tast.e = Tast.Int (0L, Types.I8); ty = Types.Int Types.I8; loc } ]); ty = Types.Bool; loc } in [ unit_ (Tast.If (is_some, do_ ((lit "(some " :: render c (depth + 1) some) @ [ lit ")" ]), lit "none")) ] | Types.Named n -> (match List.find_opt (fun (s : Tast.structure) -> String.equal s.Tast.sname n) c.structs with | None -> [ lit ("<" ^ n ^ ">") ] | Some st -> let fields = st.Tast.fields in let shown = List.filteri (fun i _ -> i < max_span) fields in let parts = List.concat (List.mapi (fun i (f : Tast.field) -> let v = { Tast.e = Tast.Field (e, i); ty = f.Tast.fty; loc } in (if i = 0 then [] else [ lit " " ]) @ [ lit (":" ^ f.Tast.fname ^ " ") ] @ render c (depth + 1) v) shown) in [ do_ ((lit ("(" ^ n ^ " {") :: parts) @ (if List.length fields > max_span then [ lit " ..." ] else []) @ [ lit "})" ]) ]) (* A fixed array's length is in its type, so it unrolls — capped, because sand's grid is [100 [100 u32]] and unrolling that is ten thousand render sites in one module. *) | Types.Array (n, t) -> let shown = min (Int64.to_int n) max_span in let parts = List.concat (List.init shown (fun i -> let v = { Tast.e = Tast.Prim (Tast.At, [ e; i32 i ]); ty = t; loc } in lit " " :: render c (depth + 1) v)) in [ do_ ((lit "[" :: parts) @ (if Int64.to_int n > shown then [ lit " ..." ] else []) @ [ lit "]" ]) ] (* A slice's length is not known until it runs, so this is the one case that needs a loop. The slice goes into a slot first: the expression it came from must not be evaluated once per element. *) | Types.Slice t -> let sv = slot c e.Tast.ty and iv = slot c (Types.Int Types.I32) in let local i ty = { Tast.e = Tast.Local i; ty; loc } in let len = { Tast.e = Tast.Prim (Tast.Len, [ local sv e.Tast.ty ]); ty = Types.Int Types.I32; loc } in let cond = { Tast.e = Tast.Prim (Tast.Lt, [ local iv (Types.Int Types.I32); len ]); ty = Types.Bool; loc } in let elem = { Tast.e = Tast.Prim (Tast.At, [ local sv e.Tast.ty; local iv (Types.Int Types.I32) ]); ty = t; loc } in let step = unit_ (Tast.Set (Tast.Plocal iv, { Tast.e = Tast.Prim (Tast.Add, [ local iv (Types.Int Types.I32); i32 1 ]); ty = Types.Int Types.I32; loc })) in [ unit_ (Tast.Let ([ (sv, e); (iv, i32 0) ], [ lit "["; unit_ (Tast.While (cond, (lit " " :: render c (depth + 1) elem) @ [ step ])); lit "]" ])) ] | t -> fail loc "no printer for %s" (Types.to_string t) let eval_expr ?(origin = "") 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 = Check.expression t.env (Parse.expr form) in let c = { structs = t.program.Tast.structs; enums = Hashtbl.fold (fun k v acc -> (k, v) :: acc) t.env.Check.enums []; slots = []; nslots = Array.length base } 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 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 c.slots)) } 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 = Emit.redefinition ~dev:true ~known:(known t) ~call:name program ~fns:[ name ] in { ir; names = []; fns = []; installs = true }