(** 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 *)
  (* The defmacros the imports brought in, qualified. Held rather than
     re-derived because C-c C-c parses one form with no import in sight, and a
     macro that works on the first build and not on the reload is worse than
     one that never existed. *)
  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;
}

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 (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;
     macros = l.Load.macros; 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 ?(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 *)
  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 — 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. *)
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. *)
    macros := 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 =
    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
  (* Every one of these together, and after the last thing that can raise:
     until this line the session is still the one the evaluation started
     against, which is what makes a refusal cost nothing. *)
  t.macros <- !macros;
  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";
    (* 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;
      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 =
    Emit.redefinition ~dev:true ~debug:t.debug ~known:(known t) ~call:name
      program ~fns:[ name ]
  in
  ignore origin;
  ({ ir; 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 union carries the case as
   well, because a union'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.union) -> String.equal u.Tast.uname n)
              t.program.Tast.unions ->
       let u =
         List.find (fun (u : Tast.union) -> String.equal u.Tast.uname n)
           t.program.Tast.unions
       in
       (* The editor spells this `Union.case.field', which is the head the
          renderer wrote — `(Union.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 union: 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;
          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 =
              Emit.redefinition ~dev:true ~debug:t.debug ~known:(known t)
                ~call:tname program ~fns:[ tname ]
            in
            ignore origin;
            Ok
              ({ ir; names = []; fns = []; installs = true },
               name ^ path_text path,
               Types.to_string v.Tast.ty)))

(* ── The globals a stopped stack reaches ───────────────────────────── *)

(* The other half of what a break loop can show, and in this language arguably
   the more useful one: a game keeps most of its state in top-level [defvar]s,
   and sand.flan holds its entire grid that way.

   Almost the same thunk as [render_locals] with a different root, and the
   difference is the whole reason this is a second function rather than a
   parameter. A local is reached by *address* — [flan/dev-slot] hands back
   where the frame is, and only the stopped program knows that. A global is
   reached by *name*: [Emit.redefinition] writes a global the host already has
   as [external], so the loaded module binds to the program's own storage and
   the dynamic linker does the work. Nothing has to be asked of the stopped
   thread at all, which is also why there is no [bound] list here — a global's
   storage exists from the moment the process started, so there is no
   not-yet-bound case to refuse.

   [globals] is chosen by the caller and not here, because the choice is about
   the *stack* and this function is about rendering. See [Dev.globals_op].

   One line per global — name, type, value, tab separated — the same framing
   [render_locals] uses, and safe for the same reason: every string the
   renderer emits goes through [flan_dev_emit_str], which escapes both. *)
let render_globals ?(origin = "<globals>") t ~(globals : Tast.global list)
  : change * (string * string) list =
  let loc = Loc.unknown in
  let extra = ref [] and nslots = ref 0 in
  let c =
    { Render.structs = t.program.Tast.structs;
      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 =
    Emit.redefinition ~dev:true ~debug:t.debug ~known:(known t) ~call:name
      program ~fns:[ name ]
  in
  ignore origin;
  ({ ir; 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;
      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. *)
    Emit.redefinition ~dev:true ~debug:t.debug ~known:(known 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. *)
  t.program <- { t.program with Tast.fns = t.program.Tast.fns @ fresh };
  { ir; names = []; fns = []; installs = true }