(** 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.** Struct fields and
      global types are storage the process already has in a shape, so a change
      to either is refused here, with the reason, rather than loaded.
    - **what every function in the process was compiled against.** A dev cell
      carries its body's signature word (see [Emit.sig_text]), so a function
      whose parameters or return changed installs anyway and a caller compiled
      before the change stops on [StaleCall] at the call rather than passing
      the old arguments. [built] is how the session names those callers
      before anyone runs them: the call sites of every body the process has,
      each with the signature it was compiled for. See [stale_sites].

    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. *)

(* One call site in a body the process is running: the function it calls,
   the signature that function had when this body was compiled, and where the
   call is written. A function value taken by name is a site too — the dev
   build checks the signature where the address is taken. *)
type site = { callee : string; csig : string; cret : Types.t; sloc : Loc.t }

(* What the session knows about one compiled body: the declaration it belongs
   to — itself, the function a clause was lifted out of, or the generic a copy
   was made from — and its call sites. *)
type built = { owner : string; sites : site list }

module SM = Map.Make (String)

(* A call site compiled against a signature its callee no longer has. *)
type stale = {
  caller   : string;              (* the compiled body the site is in *)
  target   : string;              (* the function it calls *)
  compiled : string;              (* the signature it was compiled for *)
  current  : string;              (* the signature the function has now *)
  at       : Loc.t;
  (* True when the call is in [main] and the program is running: the
     activation it is in is [main]'s loop, which never returns to be called
     again, so compiling [main] again cannot reach it. Changing the callee
     back or re-running the program does. *)
  running  : bool;
  (* When [target]'s return type is read off its body and that is what
     changed: which way, and the line that decided it. *)
  cause    : string option;
}

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 *)
  mutable host    : Tast.program;        (* what the process was built from *)
  pkgs            : Load.pkg list;       (* alias, directory, names owned *)
  (* Every [defmacro] this session can expand a call to: the imports', under
     their aliases, and the buffer's own, under the names the buffer writes.
     Held rather than re-derived because an evaluation parses one form with no
     import and no [defmacro] in sight, and a macro that works on the first
     build and not on the reload is worse than one that never existed.

     It is exactly this record's own rule applied to macros — what the program
     was built from, plus every change accepted since. The file's own set is
     seeded in [create] from the forms [Load] was handed, which is the same
     read that produced [decls]; nothing here ever goes back to disk, so a
     macro cannot arrive from a version of the file the session was never
     told about. *)
  mutable macros  : Form.t list;
  mutable thunks  : int;                 (* expression evaluations so far *)
  (* Whether the modules this session emits carry DWARF. It belongs to the
     session rather than to each call because it has to match the process the
     modules are loaded into: a redefinition with debug info, dlopened into a
     host built without it, gives a debugger a second module to resolve names
     against and nothing to line up the host's own frames with. Both ends are
     set from one flag — see [Dev.start]. *)
  debug           : bool;
  (* Which backend compiles the modules this session emits, and it belongs to
     the session for exactly the reason [debug] does: it has to match the
     process they are loaded into. The two backends agree on every scalar and
     disagree on every aggregate, so a module from one dlopened into a host
     from the other is correct until the first redefined function takes or
     returns a struct. Both ends are set from one flag -- see [Dev.start] --
     and [flan.abi.x86] is the backstop if they ever come apart. *)
  x86             : bool;
  (* Every body the running process has, by symbol, with the call sites it
     was compiled with. Seeded from [host] and replaced, body by body, as
     modules are accepted — so it is what was *compiled*, which after a
     signature change is not what [program] would check to. *)
  mutable built   : built SM.t;
  (* The bodies of [main], and of the clauses lifted out of it, as the
     running activation was compiled — kept when [main] is compiled again
     while the program runs, because the loop the program is in is still the
     old one and nothing re-enters it until a re-run. Emptied by [rerun]. *)
  mutable live    : built SM.t;
}

let fail = Loc.fail

(* ── What each compiled body calls ──────────────────────────────────── *)

(* The call sites of one body, each with the signature its callee has in
   [p] — the program the body is being compiled from, which is the signature
   both backends compare the cell's word against at that site. *)
let sites_of (p : Tast.program) (fn : Tast.fn) =
  let sigs = Hashtbl.create 64 in
  List.iter
    (fun (f : Tast.fn) ->
       Hashtbl.replace sigs f.Tast.name
         (Emit.sig_text f.Tast.params f.Tast.ret, f.Tast.ret))
    p.Tast.fns;
  let found = ref [] in
  let see (e : Tast.expr) =
    let at m =
      match Hashtbl.find_opt sigs m with
      | Some (csig, cret) ->
        found := { callee = m; csig; cret; sloc = e.Tast.loc } :: !found
      | None -> ()
    in
    match e.Tast.e with
    | Tast.Call (m, _) -> at m
    | Tast.FnAddr (Tast.Fnval m) | Tast.Closure (Tast.Fnval m, _) -> at m
    | _ -> ()
  in
  List.iter (Tast.walk see) fn.Tast.body;
  List.iter (Tast.walk see) fn.Tast.fdefers;
  List.rev !found

(* The declaration a compiled body belongs to, which is what the checker
   names when that body's source no longer checks. A widening thunk belongs
   to nobody and is left out: each module carries its own copy, so a name
   says nothing about which copy the process reaches. *)
let owner_of env (fn : Tast.fn) =
  match fn.Tast.fparent with
  | Some "<thick>" -> None
  | Some p -> Some p
  | None ->
    (match Check.instantiation_origin env fn.Tast.name with
     | Some (g, _) -> Some g
     | None -> Some fn.Tast.name)

let record_built env (p : Tast.program) (fns : Tast.fn list) m =
  List.fold_left
    (fun m (fn : Tast.fn) ->
       match owner_of env fn with
       | None -> m
       | Some owner -> SM.add fn.Tast.name { owner; sites = sites_of p fn } m)
    m fns

(* Every compiled call site whose callee's signature in [p] is not the one
   it was compiled for, in source order. A callee [p] does not have is
   skipped rather than reported: nothing could have been installed under it
   since, so the cell still holds what the site was compiled against. *)
let stale_sites ?(live = SM.empty) ?(running = false)
    ?(inferred = fun _ -> None) built (p : Tast.program) : stale list =
  let sigs = Hashtbl.create 64 and rets = Hashtbl.create 64 in
  List.iter
    (fun (f : Tast.fn) ->
       Hashtbl.replace sigs f.Tast.name (Emit.sig_text f.Tast.params f.Tast.ret);
       Hashtbl.replace rets f.Tast.name f.Tast.ret)
    p.Tast.fns;
  (* Nobody wrote an inferred return type, so a change to one is said in
     terms of the line that made it. *)
  let cause (st : site) =
    match inferred st.callee, Hashtbl.find_opt rets st.callee with
    | Some (l : Loc.t), Some now when not (Types.equal now st.cret) ->
      Some
        (Printf.sprintf "%s now returns %s, not %s, because of line %d%s"
           st.callee (Types.to_string now) (Types.to_string st.cret) l.Loc.line
           (if String.equal l.Loc.file st.sloc.Loc.file then ""
            else " of " ^ Filename.basename l.Loc.file))
    | _ -> None
  in
  let arities n =
    List.filter_map
      (fun (f : Tast.fn) ->
         if f.Tast.fparent = None && String.equal (Check.written_name f.Tast.name) n
         then Some (Emit.sig_text f.Tast.params f.Tast.ret)
         else None)
      p.Tast.fns
  in
  (* Named by the declaration a body belongs to: a clause lifted out of
     [step] is [step]'s call, and a generic's copy is the generic's. *)
  let from ~kept m acc =
    SM.fold
      (fun _ b acc ->
         let running = kept || (running && String.equal b.owner "main") in
         List.fold_left
           (fun acc (st : site) ->
              match Hashtbl.find_opt sigs st.callee with
              | Some now when not (String.equal now st.csig) ->
                { caller = b.owner; target = st.callee; compiled = st.csig;
                  current = now; at = st.sloc; running; cause = cause st }
                :: acc
              | Some _ -> acc
              | None ->
                (* The callee's name is still a function, under other arities
                   than the one this site was compiled for: that arity was
                   removed, or the name's arities were renamed around it. A
                   caller that still checked was compiled again, so what is
                   left here is one that no longer can. *)
                (match arities (Check.written_name st.callee) with
                 | [] -> acc
                 | now ->
                   { caller = b.owner; target = st.callee; compiled = st.csig;
                     current = String.concat " or " now; at = st.sloc; running;
                     cause = None }
                   :: acc))
           acc b.sites)
      m acc
  in
  from ~kept:true live (from ~kept:false built [])
  (* A caller or callee the prelude-shadowing rename made is not the
     program's, and there is nothing in the program to recompile for it. *)
  |> List.filter (fun s ->
    not (Check.internal_name s.caller || Check.internal_name s.target))
  |> List.sort (fun a b ->
    match String.compare a.at.Loc.file b.at.Loc.file with
    | 0 -> Loc.before a.at b.at
    | c -> c)

(* Structural, and conservative: anything this does not recognise counts as
   changed. Comparing emitted text instead would be wrong — [Emit.const] on a
   string allocates a name off a per-module counter, so two different strings
   in two throwaway modules both come out as [@".str.0"] and compare equal. *)
let rec same_const (a : Tast.expr) (b : Tast.expr) =
  match (a.Tast.e, b.Tast.e) with
  | Tast.Int (x, k), Tast.Int (y, l) -> Int64.equal x y && k = l
  | Tast.Float (x, k), Tast.Float (y, l) -> Float.equal x y && k = l
  | Tast.Bool x, Tast.Bool y -> x = y
  | Tast.Str x, Tast.Str y -> String.equal x y
  | Tast.Unit, Tast.Unit -> true
  | Tast.Zero x, Tast.Zero y -> Types.equal x y
  | Tast.Arr xs, Tast.Arr ys ->
    List.length xs = List.length ys && List.for_all2 same_const xs ys
  | Tast.Make (x, xs), Tast.Make (y, ys) ->
    String.equal x y && List.length xs = List.length ys
    && List.for_all2 same_const xs ys
  | _ -> false

(* The [defmacro]s among a set of top-level forms, as [t.macros] has to hold
   them.

   [Expand.quasiquote] is not decoration. [Parse.parse_forms] desugars every
   form it is handed before the expander sees it, and [Load.qualify_macro]
   desugars a package's macro on its way out for the same reason — but
   [Parse.imported_macros] is read by [Macro.program] directly, past that map.
   An undesugared body still has its quasiquote in it, which makes a
   quasiquoted call look like a real one: the false ring docs/BUILT.md records the
   first cycle test walking into.

   Unqualified, and that is the point: a buffer writes its own macro's bare
   name, so that is the name the session has to answer to. A file inside a
   package that the program also imports has both — the bare one from here and
   [alias/name] from [Load] — which is what the two call sites each need. *)
let own_macros (forms : Form.t list) : Form.t list =
  List.filter_map
    (fun f ->
       match f.Form.v with
       | Form.List ({ Form.v = Form.Sym "defmacro"; _ } :: _) ->
         Some (Expand.quasiquote f)
       | _ -> None)
    forms

(* The macros [load] defined by expanding [forms], beside the ones written in
   them: [(defsq sq)] defines [sq] without a [defmacro] in sight, and the next
   evaluation has to be able to call it. Only those expanded from these forms'
   own file — [Load.program] also parses the packages they import, and a macro
   a package's expansion defined belongs to the package. Written first, so an
   expansion's newer body wins as a [defmacro]'s does. *)
let with_expansion_macros (forms : Form.t list) (load : unit -> 'a) : 'a * Form.t list =
  Parse.expansion_macros := [];
  let r = load () in
  let files = List.map (fun (f : Form.t) -> f.Form.loc.Loc.file) forms in
  let defined =
    List.filter
      (fun (f : Form.t) -> List.mem (Loc.call_site f.Form.loc).Loc.file files)
      !Parse.expansion_macros
  in
  Parse.expansion_macros := [];
  (r, Load.macro_union (own_macros forms) defined)

let of_forms ~debug ~x86 ~file forms =
  let l, mine = with_expansion_macros forms (fun () -> Load.program ~file forms) in
  let p, env = Check.program_with_env l.Load.decls in
  ({ file; decls = l.Load.decls; program = p; env; host = p; pkgs = l.Load.pkgs;
     (* The file's own first, so that if the file being edited is itself a
        package the program imports, the bare name wins for a form typed into
        that buffer. [macro_union] keeps the left. *)
     macros = Load.macro_union mine l.Load.macros;
     thunks = 0; debug; x86;
     built = record_built env p p.Tast.fns SM.empty; live = SM.empty }, l)

let create ?(debug = false) ?(x86 = false) ~file () =
  of_forms ~debug ~x86 ~file (Source.read_file file)

(* ── A file loaded a form at a time, keeping what compiles ─────────── *)

(* The form a diagnostic is about: the last one in [forms] that starts at or
   before the position it was reported at — the call, for an error inside a
   macro's expansion. [None] when the position is in no file these forms came
   from, which is an error nothing here can drop a form to avoid. *)
let blame (forms : Form.t list) (d : Loc.diag) : Form.t option =
  let at = Loc.call_site d.Loc.dloc in
  List.fold_left
    (fun acc (f : Form.t) ->
       if String.equal f.Form.loc.Loc.file at.Loc.file
       && Loc.before f.Form.loc at <= 0
       then Some f
       else acc)
    None forms

(* SBCL's [load] and CIDER's load-file: a file whose third form does not
   compile still defines the other two. [attempt] is run over [forms]; each
   refusal drops the form it is about and runs it again over the rest, so a
   form that only failed because it called one that was dropped is dropped
   with its own error on the next round. Each round drops at least one form,
   so this ends. Answers what [attempt] returned, the forms it was given, and
   every error in the order found. An error no form can be blamed for is
   raised as it came. *)
let pruned (attempt : Form.t list -> 'a) (forms : Form.t list) :
    'a * Form.t list * Loc.diag list =
  let rec go forms errs =
    let drop ds e =
      let bad = List.map (blame forms) ds in
      if List.exists Option.is_none bad then raise e
      else
        let bad = List.filter_map Fun.id bad in
        go (List.filter (fun f -> not (List.memq f bad)) forms)
          (List.rev_append ds errs)
    in
    match attempt forms with
    | r -> (r, forms, List.rev errs)
    | exception (Loc.Error d as e) -> drop [ d ] e
    | exception (Loc.Errors ds as e) -> drop ds e
  in
  go forms []

(* Where [flan dev] writes the [main] a file without one is given. Not a path:
   nothing reads it back, and a location here is how the session tells that
   [main] apart from one somebody wrote. *)
let stub_file = "<flan dev>"

let stub_main () = Reader.read_all ~file:stub_file "(defn main [] i32 0)"

let declares_main (forms : Form.t list) =
  List.exists
    (fun (f : Form.t) ->
       match f.Form.v with
       | Form.List
           ({ Form.v = Form.Sym "defn"; _ } :: { Form.v = Form.Sym "main"; _ } :: _)
         -> true
       | _ -> false)
    forms

(* Whether the [main] this session would run is one somebody wrote. *)
let has_main t =
  List.exists
    (fun (d : Ast.decl) ->
       Ast.declared_name d = Some "main"
       && not (String.equal d.Ast.dloc.Loc.file stub_file))
    t.decls

(* The session [flan dev] starts: the file's forms loaded as [pruned] loads
   them, so what compiles is in the host and what does not is answered beside
   the session rather than instead of it. A file with no [main] — or whose
   [main] is one of the forms left out — is the empty image of SBCL's order: a
   [main] that returns at once is added so there is a process to park, and a
   [main] loaded later replaces the stub like any other redefinition. *)
let create_dev ?(debug = false) ?(x86 = false) ~file () =
  let build forms =
    of_forms ~debug ~x86 ~file
      (if declares_main forms then forms else forms @ stub_main ())
  in
  let (t, l), _, errs = pruned build (Source.read_file file) in
  (t, l, errs)

(* What a macro may call, for the same reason [macros] is held: an evaluation
   parses one form with no import in sight, and a package macro whose body
   calls its own package's functions has to find them. [Load.program] hands
   this to [Parse.with_imported] from the import it just read; a session has to
   answer it from what it already holds.

   Filtered out of [decls] by ownership rather than kept as a second list,
   because [decls] is the one thing every redefinition already maintains and a
   parallel copy would be a second thing to remember to update. A package's
   names are qualified in there — that is what "post-Load: flat, one namespace"
   means — so the prefix is the whole test.

   The buffer's own declarations are deliberately not here. A macro module is
   built from the prelude with no part of the file in it (see [Macro.reduce]'s
   header, and the cycle it is about), and a session's [decls] is the file. *)
let package_decls t =
  List.filter
    (fun (d : Ast.decl) ->
       match Ast.declared_name d with
       | Some n ->
         List.exists
           (fun (p : Load.pkg) -> String.starts_with ~prefix:(p.Load.alias ^ "/") n)
           t.pkgs
       | None -> false)
    t.decls

(* Which package a file being edited belongs to, if any.

   A form typed into vendor/agent/agent.fln 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]. *)
(* The macros a form sent from [origin] can call. From a package's file that
   is the package's own under the bare names the file writes, in front of the
   rest: the session holds them qualified, as the importer calls them, and a
   bare call parsed without these is a call to an unknown function that the
   qualification afterwards turns into a call to the macro's own name. *)
let macros_for t origin =
  match package_of t origin with
  | None -> t.macros
  | Some p ->
    let pre = p.Load.alias ^ "/" in
    let bare =
      List.filter_map
        (fun (f : Form.t) ->
           match f.Form.v with
           | Form.List (hd :: ({ Form.v = Form.Sym n; _ } as nf) :: rest)
             when String.starts_with ~prefix:pre n ->
             let b = String.sub n (String.length pre) (String.length n - String.length pre) in
             Some { f with Form.v = Form.List (hd :: { nf with Form.v = Form.Sym b } :: rest) }
           | _ -> None)
        t.macros
    in
    Load.macro_union bare t.macros

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 (docs/BUILT.md, "The session") 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) =
  (* A function's signature is not in this list. A dev cell carries its
     body's signature word, so a function whose parameters or return changed
     installs and every caller compiled before the change stops at the call
     with [StaleCall] — see [Emit.sig_text] and [stale_sites].

     [main] is the one exception, because its caller is not a call site a
     cell can check. The startup code calls it, and that code was compiled
     into the program when it started; a re-run calls it again the same
     way. *)
  let find_fn p n =
    List.find_opt (fun (f : Tast.fn) -> String.equal f.Tast.name n) p.Tast.fns
  in
  (match find_fn old_ "main", find_fn new_ "main" with
   | Some g, Some f
     when not
            (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) ->
     fail loc
       "main changes signature, from %s to %s. The program's startup code \
        calls main, and it was built for the first one. Restart the program \
        to change it."
       (Emit.sig_text g.Tast.params g.Tast.ret)
       (Emit.sig_text f.Tast.params f.Tast.ret)
   | _ -> ());
  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 [defonce]'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, in an array length or a type. \
            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. Restart to change it."
           g.Tast.gname (Types.to_string h.Tast.gty) (Types.to_string g.Tast.gty)
       (* Which form declared a global is not in the storage, it is in the
          code the process was *built* with: [Emit.startup_plan] wrote the
          [.init~once.] guard around a defonce's store, left a def's bare,
          and gave a defconst no store at all, and that startup function was
          compiled into the host when the process started. A redefinition
          republishes the initialiser and cannot republish the thing that
          decides how often — or whether — it is called. So every swap of the
          keyword would load cleanly and then go on doing what the *old*
          keyword said, with nothing anywhere saying so:

          - defonce → def keeps the guard and never re-runs; def → defonce
            keeps re-running.
          - anything → defconst is worse than ineffective. A constant the
            checker did not fold is republished by value, at the frame
            boundary, by the [consts] list below — so the store lands on
            storage holding live state the program has long since moved past,
            which is "edit the code, keep the sand" broken by a keyword.
          - defconst → anything gets no store at all, because the host's
            startup has none to run for a name that was an image when it was
            compiled.

          One refusal over all of it, because it is one fact: the defining
          form is fixed at build time. Told by [gconst] and [grerun]
          together, which is exactly how every other pass tells the three
          apart. The arms above get first say and are the better message
          where they apply — a folded constant whose value changed, and any
          retype — and neither is about the keyword. *)
       | Some h
         when h.Tast.gconst <> g.Tast.gconst
              || h.Tast.grerun <> g.Tast.grerun ->
         let word (x : Tast.global) =
           if x.Tast.gconst then "defconst"
           else if x.Tast.grerun then "def"
           else "defonce"
         in
         fail loc
           "%s changes from %s to %s. The running program was built with the \
            first one — when an initialiser runs, or whether it runs at all, \
            is decided in its startup code, and a reload can replace the \
            initialiser but not that. Restart to change it, or keep %s and \
            edit the value."
           g.Tast.gname (word h) (word g) (word h)
       | _ -> ())
    new_.Tast.globals;
  List.iter
    (fun (s : Tast.structure) ->
       (* An environment the checker synthesised for a capturing fn is not
          subject to this rule, and that is not a loophole. The layout rule is
          about values the running program reads with code newer than the code
          that wrote them. An environment is only ever read by the lifted body
          that was compiled beside the literal that made it: a function value
          carries that body's own symbol, not a cell, and a redefinition module
          carries its own copy of every lifted body it replaces. A value made
          before the reload keeps calling the old body over the old layout —
          and each environment carries the descriptor it was allocated with —
          so editing which locals an fn names is an ordinary body change, and
          demanding a restart for it would take the dev loop away from the
          feature it was built for. *)
       if Check.is_env_struct s.Tast.sname then () else
       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. Restart to change it."
             (Types.to_string (Types.Named 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. Restart to change it."
           n
       | _ -> ())
    (members new_)

(* ── Accepting a change ────────────────────────────────────────────── *)

(* The redefinition unit is a list of top-level forms, so this is one path for
   both editor commands: C-c C-c sends one form, C-c C-k sends a file. *)
type change = {
  ir      : string;             (* the module to build and send *)
  (* Which backend wrote [ir], and therefore which builder and which file
     extension it wants: LLVM IR through [Build.shared], or x86-64 assembly
     through [Build.shared_x86]. It rides on the change rather than being
     looked up again at the build, so the text and the choice of builder can
     never come from two different answers to the same question. *)
  x86     : bool;
  names   : string list;        (* everything the forms declared *)
  fns     : string list;        (* the subset that has a body to install *)
  (* False when the module would define nothing: no body to publish and no
     storage to allocate. Building and delivering one anyway reports success
     for a change that cannot have had an effect, and costs the program a
     frame's worth of reload it did not need. *)
  installs : bool;
  (* Every call site in the running program compiled against a signature its
     callee no longer has, once this change is in: the callers a signature
     change leaves behind, and the ones earlier changes left that this one
     did not recompile. Empty for anything that builds no module. *)
  stale : stale list;
  (* The compiler's warnings about the forms sent, as it printed them. *)
  warnings : Loc.diag list;
}

(* The bodies a change installed, as whoever reads the reply wrote them: a
   fn with several arities is compiled under a name per arity, and is one
   name to the person who sent it. [fns] itself stays by symbol — the
   daemon's module ownership is keyed on it. *)
let shown_fns (c : change) =
  List.fold_left
    (fun acc f ->
       let n = Check.written_name f in
       if List.mem n acc then acc else n :: acc)
    [] c.fns
  |> List.rev

(* [pause] is [C-u C-c C-c]: the position, in the source just sent, of the form
   the program should stop at — TODO.org, "A breakpoint is marked from the
   editor, without editing the buffer". 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 that entry's settled behaviour, and it is the same one statement
   that accepts every other change. *)
(* The one place the backend choice is made, so that the six callers below
   cannot disagree about it and the refusal has one home.

   There is no fallback and there must not be one. If [X86.redefinition]
   refuses a form, the daemon reports the refusal; quietly building an LLVM
   module instead would hand an [--x86] host a module from the other backend,
   which is the crossed pair [flan.abi.x86] exists to refuse at [dlopen]. A
   refusal a user can read is the right answer; a segfault three frames later
   is not. *)
let redefinition (t : t) ?retains ?call ?(consts = []) ?(retire = []) program
    ~fns =
  if not t.x86 then
    Emit.redefinition ~dev:true ~debug:t.debug ~known:(known t) ?retains
      ~consts ~retire ?call ~annotate:true program ~fns
  else
    match
      X86.redefinition ~checks:true ~dev:true ~known:(known t) ?retains ~consts
        ~retire ?call ~annotate:true program ~fns
    with
    | asm -> asm
    (* The dev backend covers a subset of the IR and refuses the rest by name,
       which is what makes a build that succeeds one it really compiled. A
       refusal has to reach the editor as a diagnostic like every other, so it
       is re-raised at the form it is about -- the first name being redefined,
       which is where a reader would look. Every caller already handles
       [Loc.Error]; none of them handles [X86.Unsupported], and a session that
       died on the first unsupported form would be worse than one that says so
       and stays up. *)
    | exception X86.Unsupported m ->
      let loc =
        match
          List.find_opt
            (fun (f : Tast.fn) -> List.mem f.Tast.name fns)
            program.Tast.fns
        with
        | Some f -> f.Tast.floc
        | None -> Loc.unknown
      in
      (* The flag is named because the backend is no longer something anybody
         asked for: [flan dev] takes it by default, so the person reading this
         chose a program and not a code generator. "unsupported" on its own
         tells them their form is wrong, which it is not — it compiles, on the
         other backend, and the whole of the fix is one flag on the daemon.
         Naming it here rather than in the editor keeps the sentence with the
         refusal it belongs to, and reaches [flan reload] too. *)
      fail loc
        "the x86 dev backend cannot compile this: %s. Restart the daemon with \
         flan dev --llvm" m

(* ── Undoing an acceptance ─────────────────────────────────────────── *)

(* Checking is not the last thing that can fail, and until this existed the
   session behaved as though it were. [eval] assigns the four mutable fields
   the moment a form checks; the *build* and the *delivery* happen afterwards,
   in the daemon, and either can refuse — llc can fail, and the agent's reload
   ring can be full, which a parked program guarantees after enough queued
   installs, since nothing drains the ring while the main thread waits. The
   editor saw an error either way, so the evaluation looked refused; the
   session went on holding the declaration anyway.

   That leftover is not untidiness, it is a segfault. A declaration the session
   holds and the host does not export is a name every later module lists in its
   install prologue, and the prologue interns a cell for it. A cell nothing
   ever stored a body into is NULL, and a dev build's call through a cell is a
   load and an indirect call with no test in front of it — so the next
   [C-x C-e], the next locals render, the next globals refresh jumps the game
   thread to address 0. One failed build, and the next thing anybody types
   kills the program.

   So the four fields are one unit that can be put back. [held] is what the
   session was before the evaluation and [restore] is the session being that
   again — all four together, because they are four views of one answer: the
   declarations, the checked program, the checker's environment, and the macros
   a later form expands against. Putting back three of them would leave the
   checker willing to accept a call to a name the program does not have, which
   is the same crash by a longer road.

   What a restored session can claim is the honest sentence rather than the one
   anyone would rather have: it holds no declaration that no module was
   *accepted* for. Accepted is not installed — the agent queues a module and
   the game thread installs it at a frame boundary — but a queued module is one
   the process has and will run, and that is as far as this side can see.

   A [defmacro] evaluated in the same breath as a [defn] that fails to build
   goes back with it, and that is right: they arrived as one form and were
   accepted as one. A [defmacro] on its own never reaches a restore, because a
   change with no body to install and no storage to allocate is answered before
   anything is built.

   [thunks] is not in here. It is a counter that keeps two evaluations from
   naming their thunks alike, not something the session believes about the
   program, and the agent refuses a full ring *before* it dlopens — so a
   rolled-back number would be reused for a module nothing ever mapped, and
   reusing it is the one way to make two live modules share a symbol. *)
type held = {
  hdecls   : Ast.decl list;
  hprogram : Tast.program;
  henv     : Check.env;
  hmacros  : Form.t list;
  (* And what the process was compiled with, which an acceptance moves too:
     a module that never arrived compiled nothing. *)
  hbuilt   : built SM.t;
  hlive    : built SM.t;
}

let held t =
  { hdecls = t.decls; hprogram = t.program; henv = t.env; hmacros = t.macros;
    hbuilt = t.built; hlive = t.live }

let restore t h =
  t.decls <- h.hdecls;
  t.program <- h.hprogram;
  t.env <- h.henv;
  t.macros <- h.hmacros;
  t.built <- h.hbuilt;
  t.live <- h.hlive

(* A re-run calls [main] through its cell, so the body it enters is the
   newest one and no older activation is left running. *)
let rerun t = t.live <- SM.empty

(* The process is about to be built again from what the session holds now
   (a --two-process re-run), so that becomes what it was built from. Checked
   whole rather than taken from [program], which can hold a caller's old body
   beside a callee whose signature changed (see [eval]); a fresh build of that
   pair would be wrong, so it raises the checker's error instead. *)
let rehost t =
  let p, env =
    let was = !Check.print_warnings in
    Check.print_warnings := false;
    Fun.protect ~finally:(fun () -> Check.print_warnings := was)
      (fun () -> Check.program_with_env t.decls)
  in
  t.program <- p;
  t.env <- env;
  t.host <- p;
  t.built <- record_built env p p.Tast.fns SM.empty;
  t.live <- SM.empty

(* The session's own functions whose names a macro also has — see
   [Parse.shadowing_fns]. A [defmacro] is a [defn] once parsed, so the
   session's macros are taken back out. *)
let shadowing_fns t origin =
  let macros = List.filter_map Macro.macro_name (macros_for t origin) in
  List.filter_map
    (fun (d : Ast.decl) ->
       match d.Ast.d with
       | Ast.Defn fn when not (List.mem fn.Ast.name macros) -> Some fn.Ast.name
       | _ -> None)
    t.decls

(* The name a prelude function the session splices a call to — [pause] for a
   mark, [step-point] for the stepper — answers to in [decls]. A program's own
   function or global of that name takes the name over and the prelude's is
   renamed (see [Check.shadow_prelude]), and the spliced call is the
   prelude's, not the program's. *)
let prelude_fn (decls : Ast.decl list) n =
  let takes (d : Ast.decl) =
    match d.Ast.d with
    | Ast.Defn fn | Ast.Declare (fn, _) | Ast.DeclareC (fn, _) ->
      String.equal fn.Ast.name n
    | Ast.Defvar (m, _, _, _) | Ast.Defconst (m, _, _) -> String.equal m n
    | _ -> false
  in
  if List.exists takes decls then Check.prelude_alias ^ "/" ^ n else n

(* [forms], when given, are [src] already read — [pruned] runs this over a
   file a form fewer each round and has no text for the subset. [base] is the
   file an [(import ...)] in them is resolved against, the session's own when
   absent: a file loaded from another directory names its packages from
   there. *)
let eval ?(origin = "<eval>") ?base ?forms ?pause ?(step = false) ?(running = true) t src : change =
  let forms =
    match forms with Some f -> f | None -> Source.read_code ~file:origin src
  in
  (* What an annotated listing quotes for this form is what was sent, not what
     the file on disk said when it was last read. *)
  Loc.remember ~file:origin src;
  Parse.with_imported ~decls:(package_decls t) ~fns:(shadowing_fns t origin) (macros_for t origin) @@ 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, mine =
      with_expansion_macros forms (fun () ->
          Load.program ~file:(Option.value base ~default:t.file) forms)
    in
    (* An evaluated import *adds* to the session's set, so a macro brought in
       by C-c C-k is there for the C-c C-c after it. A union and not an
       assignment: [Load.program] answers the macros of the imports it was
       handed, and the one form C-c C-c sends has no import in it, so
       replacing would empty the set on the first re-evaluation of a defn —
       the macro would work on the build and be an unknown name on the
       reload.

       The incoming set comes first because [macro_union] keeps the left on a
       name collision, and what [Load] just read off disk is newer than what
       the session has been holding: editing a macro in a package and
       reloading the file that imports it has to expand the new body. The
       other order would keep the stale one and say nothing.

       Held here and committed at the bottom with everything else, rather than
       assigned on the spot: this is above the checker, and the session's rule
       is that a form which does not check leaves it exactly as it was —
       macros included. Nothing between here and there reads [t.macros]:
       [Load.program] puts the imported set in front of the parse it drives
       itself, and the checker below is handed declarations that are already
       parsed.

       And the forms just sent come in front of both, which is the half that
       makes a [defmacro] typed at the editor mean anything. A [defmacro] is
       an ordinary declaration on this path already — it parses to a [Defn]
       and installs a body like any other — so the only thing missing was the
       session remembering that the name is a macro. It does now, and the
       shape that follows is the one [defn] already has: the declaration
       joins the session, and the *next* evaluation can call it. Not a re-read
       of the file, which would also pick up macros the session was never told
       about and would put unsaved-versus-saved skew into expansion.

       Left-wins again, and here it is what lets a macro be edited: the
       incoming body replaces the one the session was holding under that
       name. [Macro.program] dedupes the same way on the same rule, because
       while this parse runs the old copy is still ambient. *)
    macros :=
      Load.macro_union mine (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
      let ds = List.map (Load.qualify_decl owns p.Load.alias) ds in
      if Load.is_package_file p.Load.dir then Load.file_scoped ds else 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 ~fn:(prelude_fn (t.decls @ incoming) "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
  (* [step]: every defn sent stops before each form of its body — see
     [Ast.instrument_step]. After [qualify_decl] for the reason [pause] is. *)
  let incoming =
    if not step then incoming
    else
      match
        Ast.instrument_step ~fn:(prelude_fn (t.decls @ incoming) "step-point")
          incoming
      with
      | Some ds -> ds
      | None -> fail loc "there is no defn in the form sent to step through"
  in
  (* A method declares a name of its own — that is what makes evaluating one
     twice a replacement and evaluating a new one an append, through the same
     kept/added logic every other declaration goes through. But no function is
     emitted under that name: a method's body is inlined into its generic's
     dispatch by [Classes.expand], so the body that has to be installed is the
     *generic's*. Naming it here is what makes [C-c C-c] on a defmethod reach
     a call site compiled before the method existed, which is the whole of why
     this feature is usable in the loop the project exists for. *)
  (* A fn form is every arity of its name (decision 139), so it replaces all
     of them: an arity the new form lacks is gone, and its compiled callers
     are stale. The names here are the names written; the bodies of a fn
     with several arities are compiled under names of their own, which only
     the check knows ([arity_syms] below). *)
  let names =
    List.filter_map Ast.declared_name incoming
    @ List.filter_map
        (fun (d : Ast.decl) ->
           match d.Ast.d with Ast.Defmethod m -> Some m.Ast.mgen | _ -> None)
        incoming
    (* Once each: the arities of one fn are one declaration apiece. *)
    |> List.fold_left (fun acc n -> if List.mem n acc then acc else n :: acc) []
    |> List.rev
  in
  let incoming_named n =
    List.filter (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. The first declaration of a name takes everything the form
     declares under it, and any later one of that name goes. *)
  let replaced = ref [] in
  let kept =
    List.concat_map
      (fun (d : Ast.decl) ->
         match Ast.declared_name d with
         | Some n when List.mem n !replaced -> []
         | Some n ->
           (match incoming_named n with
            | [] -> [ d ]
            | nds -> replaced := n :: !replaced; nds)
         | None -> [ d ])
      t.decls
  in
  let added =
    List.filter
      (fun (d : Ast.decl) ->
         match Ast.declared_name d with
         | Some n -> not (List.mem 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. *)
  (* ── Callers compiled against a signature that changed ─────────────
     A redefinition may change a function's parameters or return, and it
     installs: every caller compiled before the change stops at the call on
     [StaleCall] rather than passing the old arguments (see [Emit.sig_text]).
     Those callers are still in [decls], unchanged, and their source may no
     longer check against the new signature — [(helper 1)] after [helper]
     gained a parameter. They are not being recompiled, so that is not a
     reason to refuse the form that changed [helper]; it is the thing the
     reply reports.

     So a body whose check fails is tolerated exactly when it is a stale
     caller: not in this form, and compiled with a call site whose callee's
     signature, as the new check collected it, is not the one it was compiled
     for. A failure at the line of such a site is tolerated too, which is
     what lets a generic's copy through — the error then lands in whichever
     function asked for the copy, and the stale site is in the generic's
     body. Anything else fails as it always did, and a body that still
     checks is simply checked; either way it is not recompiled, and the
     report below names it.

     What stands in for a tolerated body is the checked body the session
     already had, which is the body the process is running. *)
  let stale_owner (env : Check.env) name (d : Loc.diag) =
    let now callee =
      match Hashtbl.find_opt env.Check.fns callee with
      | Some (ps, r) -> Some (Emit.sig_text ps r)
      | None -> None
    in
    let stale_site (st : site) =
      match now st.callee with
      | Some n -> not (String.equal n st.csig)
      (* An arity the name's new fn form lacks: the name is still there. *)
      | None ->
        let w = Check.written_name st.callee in
        Hashtbl.mem env.Check.versions w || Hashtbl.mem env.Check.fns w
    in
    (not (List.mem (Check.written_name name) names))
    && SM.exists
         (fun fname b ->
            (String.equal b.owner name || String.equal fname name
             || List.exists
                  (fun (st : site) ->
                     String.equal st.sloc.Loc.file d.Loc.dloc.Loc.file
                     && st.sloc.Loc.line = d.Loc.dloc.Loc.line)
                  b.sites)
            && List.exists stale_site b.sites)
         t.built
  in
  (* Every error in the form sent, not the first: [keep_going] checks past a
     refused subexpression (see [Check.check]). One error is still raised as
     [Loc.Error], which is what every caller of one form expects. *)
  let said = ref [] in
  let program, env, tolerated =
    (* A tolerated body whose return type is read off it keeps the
       signature the process has for it. *)
    let previous n =
      List.find_map
        (fun (f : Tast.fn) ->
           if String.equal f.Tast.name n then Some (f.Tast.params, f.Tast.ret)
           else None)
        t.program.Tast.fns
    in
    (* The whole session is checked again, and only the forms sent are warned
       about: a warning said at the eval that wrote it is not said again at
       every eval after. *)
    let was = !Check.warn_within in
    Check.warn_within := Some (List.map (fun (f : Form.t) -> f.Form.loc) forms);
    match
      Fun.protect ~finally:(fun () -> Check.warn_within := was) (fun () ->
        Check.program_tolerant ~keep_going:true ~tolerate:stale_owner ~previous
          decls)
    with
    | r -> said := !Check.said_warnings; r
    | exception Loc.Errors [ d ] -> raise (Loc.Error d)
  in
  let program =
    if tolerated = [] then program
    else
      let kept_fns =
        List.filter
          (fun (f : Tast.fn) ->
             List.mem f.Tast.name tolerated
             || (match f.Tast.fparent with
                 | Some p -> List.mem p tolerated
                 | None -> false))
          t.program.Tast.fns
      and kept_globals =
        List.filter
          (fun (g : Tast.global) -> List.mem g.Tast.gname tolerated)
          t.program.Tast.globals
      in
      { program with
        Tast.fns = program.Tast.fns @ kept_fns;
        globals = program.Tast.globals @ kept_globals }
  in
  (* A (defclass ...) whose slot list changed is a constructor whose
     signature changed, and it takes the same road: it installs, and a
     compiled caller of the old constructor is a stale caller like any
     other. *)
  let incoming_classes =
    List.filter_map
      (fun (d : Ast.decl) ->
         match d.Ast.d with
         | Ast.Defclass (n, _) ->
           Some (n, Option.value ~default:[] (Check.class_slots env n))
         | _ -> None)
      incoming
  in
  compatible ~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. *)
  (* Every function the program has, by name, for the lookups below: a
     session's program can hold thousands. *)
  let in_program = Hashtbl.create 256 in
  List.iter
    (fun (f : Tast.fn) -> Hashtbl.replace in_program f.Tast.name f)
    program.Tast.fns;
  (* A name the form declared with several arities is compiled under one name
     per arity. *)
  let arity_syms =
    List.concat_map
      (fun n ->
         match Hashtbl.find_opt env.Check.versions n with
         | Some vs -> List.map snd vs
         | None -> [])
      names
  in
  let declared_fns =
    List.filter (Hashtbl.mem in_program) (names @ arity_syms)
  in
  (* ── What evaluating a [def] does to the value ────────────────────────
     [def] is Common Lisp's [defparameter], and evaluating a defparameter
     assigns. That is the whole difference from [defvar] — [defonce] here —
     which leaves an existing binding alone. So a [def] sent from the editor
     has two effects and needs both:

     - the storage takes the new value *now*, so code already compiled against
       the global reads it at the next frame; and
     - the initialiser is the one that runs at the next re-run, and at every
       one after it.

     The second is the lifted [global/<n>] — [Check.check_global] lifts every
     [def] initialiser, constants included, for exactly this — published
     through its cell, which the host's startup function calls. Republishing
     it is the whole of the re-run half.

     The first is the store below: the same [Set] the startup function makes,
     run once, at a frame boundary, by the thunk this module carries. It is
     not a second delivery path — it is the one [C-x C-e] already uses, which
     is what makes "at a frame boundary, on the game thread" true of it.

     A [def] the process has never seen is in here too. Its storage comes
     from [flan_dev_global] like any new global's and no startup call names
     it, so without the store a brand-new [(def n i64 (count-them))] would
     come up as calloc's zeroes and stay there for the life of the process.
     [Emit.initial_image] answers that for a constant initialiser and cannot
     for a computed one; the store answers both.

     [defonce] is not in here, and that is its contract: a value the program
     already holds is not touched. A [defconst] is not either — a constant
     the checker never consumed is republished by value, in [consts] below,
     which is the same frame-boundary store by a shorter road.

     The filter is the lifted function's existence rather than the shape of
     the initialiser: [uninit] is the one [def] with nothing to run, and it
     is the one with nothing lifted. *)
  let def_globals =
    List.filter_map
      (fun (d : Ast.decl) ->
         match d.Ast.d with
         | Ast.Defvar (n, _, _, Ast.Every)
           when List.exists
                  (fun (f : Tast.fn) ->
                     String.equal f.Tast.name ("global/" ^ n))
                  program.Tast.fns ->
           List.find_opt
             (fun (g : Tast.global) -> String.equal g.Tast.gname n)
             program.Tast.globals
         | _ -> None)
      incoming
  in
  let def_inits =
    List.map (fun (g : Tast.global) -> "global/" ^ g.Tast.gname) def_globals
  in
  (* Filtered by what the program holds: a copy a tolerated caller asked for
     on its way to failing is in the tables and not in the program, and there
     is nothing of it to install. *)
  let from_generics =
    List.concat_map
      (fun n ->
         if Check.is_generic env n then
           List.filter
             (fun c ->
                List.exists
                  (fun (f : Tast.fn) -> String.equal f.Tast.name c)
                  program.Tast.fns)
             (Check.instantiations env n)
         else [])
      (names @ arity_syms)
  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
  (* A name that takes over a prelude function's moves the prelude's body to
     [Check.prelude_alias] and the prelude's own calls with it (see
     [Check.shadow_prelude]). The process was built with those calls going
     through the name's cell, which the new body is about to be installed
     into, so the prelude's body is installed under its new name and every
     body whose calls moved is compiled again: the prelude keeps its own
     function, as a rebuild would give it. *)
  let prelude_moved =
    if not (List.exists (fun (f : Tast.fn) -> Check.internal_name f.Tast.name)
              program.Tast.fns)
    then []
    else
      let calls_moved (f : Tast.fn) (b : built) =
        let hit = ref false in
        let see (e : Tast.expr) =
          match e.Tast.e with
          | Tast.Call (m, _)
          | Tast.FnAddr (Tast.Fnval m) | Tast.Closure (Tast.Fnval m, _)
            when Check.internal_name m
                 && not (List.exists
                           (fun (s : site) -> String.equal s.callee m) b.sites) ->
            hit := true
          | _ -> ()
        in
        List.iter (Tast.walk see) f.Tast.body;
        List.iter (Tast.walk see) f.Tast.fdefers;
        !hit
      in
      List.filter_map
        (fun (f : Tast.fn) ->
           (* A moved body not yet in the process is installed; one that is
              — moved by an earlier shadowing — is compiled again like any
              other when a later shadowing moves a call inside it. *)
           if Check.internal_name f.Tast.name
              && not (known t f.Tast.name || SM.mem f.Tast.name t.built)
           then Some f.Tast.name
           else
             match SM.find_opt f.Tast.name t.built with
             | Some b when calls_moved f b ->
               (* A lifted clause is compiled with the body it came from. *)
               (match f.Tast.fparent with
                | Some p when p <> "<thick>" -> Some p
                | _ -> Some f.Tast.name)
             | _ -> None)
        program.Tast.fns
  in
  (* A fn form that changes how many arities its name has renames them
     ([Check.split_versions]: [f] alone, [f~1] and [f~2] beside each other), so
     a compiled call can name a body the program no longer has under that
     name. The caller is compiled again when its source still checks — it
     then calls whichever arity its arguments pick — and is a stale caller,
     tolerated above and listed by [stale_sites], when it does not. *)
  (* Asked of every compiled body and not only of the names this form
     touched: a caller left stale when an arity went away is still compiled
     against it forms later, when the name has a body its call checks against
     again — and it is then that it has to be compiled again. Hash lookups,
     because a session's program can hold thousands of bodies. *)
  let written = Hashtbl.create 256 in
  List.iter
    (fun (f : Tast.fn) ->
       Hashtbl.replace written (Check.written_name f.Tast.name) ())
    program.Tast.fns;
  let still_named n =
    (not (Check.internal_name n)) && Hashtbl.mem written (Check.written_name n)
  in
  let versions_moved =
      let has n = Hashtbl.mem in_program n in
      SM.fold
        (fun fname (b : built) acc ->
           if has fname
              && not (List.mem b.owner tolerated)
              && List.exists
                   (fun (st : site) -> not (has st.callee) && still_named st.callee)
                   b.sites
           then
             (* A lifted body is compiled with the function it came from; a
                global's initialiser has no such function, and is itself. *)
             match Hashtbl.find_opt in_program fname with
             | Some { Tast.fparent = Some p; _ } when p <> "<thick>" && has p ->
               p :: acc
             | _ -> fname :: acc
           else acc)
        t.built []
  in
  let fns =
    List.sort_uniq String.compare
      (declared_fns @ def_inits @ from_generics @ new_instances @ prelude_moved
       @ versions_moved)
  in
  (* The bodies an arity was compiled under that the program no longer has —
     the arity was removed, or the name's arities were renamed around it. A
     caller compiled against one and not compiled again (its source no longer
     checks) must stop at the call rather than run the old body, so its cell
     is given a signature word no body has, and the text of what the name is
     now, which the StaleCall reads out. *)
  let retire =
    List.filter_map
      (fun (f : Tast.fn) ->
         let n = f.Tast.name in
         if f.Tast.fparent = None && not (Hashtbl.mem in_program n)
            && still_named n
         then
           let w = Check.written_name n in
           let now =
             List.filter_map
               (fun (g : Tast.fn) ->
                  if g.Tast.fparent = None
                     && String.equal (Check.written_name g.Tast.name) w
                  then Some (Emit.sig_text g.Tast.params g.Tast.ret)
                  else None)
               program.Tast.fns
           in
           Some (n, String.concat " or " now)
         else None)
      t.program.Tast.fns
  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
  (* ── What the program has to run, and not merely load ─────────────────
     Two things now, and one thunk for both, because a module carries one
     [flan_reload_call] and the agent runs it once — after the bodies are
     published, at a frame boundary, on the game thread.

     The first is the class registrations.

     A (defclass ...) is compile-time sugar for a constructor [defn], so
     nothing about it reaches the running process except a function body —
     which is why redefining one used to be silent, and why the instances
     already in the program kept their old slots for ever.

     What closes that is one call per class into
     [runtime/flan_dyn.c]'s registry, carried by a thunk the agent runs after
     the module's bodies are published and on the game thread, which is the
     mechanism [C-x C-e] already uses. It has to be a thunk and not something
     in the constructor: the case this exists for is a class redefined and
     *not* constructed — old instances touched after the edit — and a
     registration that only ran at construction would never fire.

     Every class in the form, not only the ones whose slots changed. The
     registry ignores a re-registration of the same list, so a C-c C-k costs
     a comparison per class and migrates nothing; and a class whose
     definition the registry has never seen has to arrive somehow. *)
  let class_body =
    let str s : Tast.expr = { Tast.e = Tast.Str s; ty = Types.String; loc } in
    (* And the hook a migration calls, re-registered by every module that
       could have changed what it should be: one carrying a class, since
       that is what makes migrations happen, and one carrying a method of
       the generic, since that is what changes the body. The address is the
       cell's contents at the time the thunk runs — after this module's
       bodies are published — so it is the body just installed. *)
    let hook =
      let n = Classes.migrate_generic in
      if incoming_classes <> [] || List.mem n names then
        let ty =
          Types.CFn ([ Types.Dyn; Types.Dyn; Types.Dyn ], Types.Dyn)
        in
        [ { Tast.e =
              Tast.Prim (Tast.Rt "flan_dyn_class_hook",
                         [ { Tast.e = Tast.FnAddr (Tast.Fnval n); ty; loc } ]);
            ty = Types.Unit; loc } ]
      else []
    in
    hook @ List.map
      (fun (n, slots) : Tast.expr ->
         let kw : Tast.expr =
           { Tast.e = Tast.Prim (Tast.Rt "flan_dyn_kw", [ str n ]);
             ty = Types.Dyn; loc }
         in
         (* The slots in one string, a line each with the slot's type
            after its name: the runtime splits them. A dyn vector would
            have been the obvious shape and is the wrong one — it is a
            collector object, so the registry would hold something the
            marker has to reach, where a packed string reaches interned
            keywords that are immortal already. The constructor carries
            the same string, from the same function. *)
         { Tast.e =
             Tast.Prim (Tast.Rt "flan_dyn_class_def",
                        [ kw; str (Check.class_spec_of slots) ]);
           ty = Types.Unit; loc })
      incoming_classes
  in
  (* And the second: the [def] stores. One [Set] per re-evaluated [def], the
     same one [Emit.startup_plan] writes for the same global and without the
     guard flag a [defonce]'s carries. See the note at [def_globals] for why
     this happens at all.

     What an initialiser that transfers out leaves behind is the backend's
     answer and not this line's, and the two do not agree: a scalar comes
     back in a register and is stored after the transfer guard on both, and
     an aggregate is a temporary and one store on LLVM but is written into
     the global in place on x86, which has no [Set] arm of its own. So an
     x86 aggregate initialiser that signals half-way is a global half
     written — the same thing [(set g (wreck))] has always done there, and
     recorded in TODO.org, "A global initialiser still builds an aggregate
     straight into its destination on x86", rather than promised away here.

     After the registrations, not before: a [def] whose initialiser
     constructs an instance of a class the same form redefined has to see the
     slot list the registry now holds. *)
  let store_body =
    List.map
      (fun (g : Tast.global) : Tast.expr ->
         { Tast.e = Tast.Set (Tast.Pglobal g.Tast.gname, g.Tast.ginit);
           ty = Types.Unit; loc = g.Tast.ginit.Tast.loc })
      def_globals
  in
  let run_thunk =
    match class_body @ store_body with
    | [] -> None
    | body ->
      t.thunks <- t.thunks + 1;
      Some
        { Tast.name = Printf.sprintf "install/%d" t.thunks;
          params = []; ret = Types.Unit; body;
          fdefers = []; fenv = None; fparent = None; floc = loc;
          slots = [||]; snames = [||]; as_slots = [] }
  in
  let ir =
    match run_thunk with
    | None -> redefinition t ~consts ~retire program ~fns
    | Some th ->
      redefinition t ~consts ~retire ~call:th.Tast.name
        { program with Tast.fns = program.Tast.fns @ [ th ] }
        ~fns:(fns @ [ th.Tast.name ])
  in
  let allocates =
    List.exists
      (fun (g : Tast.global) -> not (known t g.Tast.gname))
      program.Tast.globals
  in
  (* Every one of these together, and after the last thing *here* that can
     raise: until this line the session is still the one the evaluation started
     against, which is what makes a refusal cost nothing.

     It is not the last thing that can fail, though, and this line used to be
     written as if it were. The build and the delivery come after it, in the
     daemon, and both can refuse — so the caller takes a [held] first and puts
     it back when they do. See [restore] above for what a session that kept the
     declaration anyway does to the program. *)
  (* The bodies this module compiles, and what each of them now calls: the
     ones it installs by name and the clauses lifted out of them, which is
     [Emit.redefinition]'s own list. Every stale caller the report names
     afterwards is one this left alone. *)
  let rebuilt =
    List.filter
      (fun (f : Tast.fn) ->
         List.mem f.Tast.name fns
         || (match f.Tast.fparent with
             | Some "<thick>" -> false
             | Some p -> List.mem p fns
             | None -> false))
      program.Tast.fns
  in
  let built = record_built env program rebuilt t.built in
  (* [main]'s running activation is the body the program started with, and
     compiling [main] again does not reach it: the loop it is in never
     returns to be called again. So while the program runs, the body it was
     started with is kept, and its stale sites stay on the list. *)
  let live =
    if not running then t.live
    else
      List.fold_left
        (fun live (f : Tast.fn) ->
           match SM.find_opt f.Tast.name t.built with
           | Some b when String.equal b.owner "main"
                         && not (SM.mem f.Tast.name live) ->
             SM.add f.Tast.name b live
           | _ -> live)
        t.live rebuilt
  in
  t.macros <- !macros;
  t.decls <- decls;
  t.program <- program;
  t.env <- env;
  t.built <- built;
  t.live <- live;
  (* [run_thunk] counts: a form that is only a (defclass ...) already
     installs its constructor, but a module carrying nothing but the
     registration still has something for the program to run. *)
  { ir; x86 = t.x86; names; fns;
    installs =
      fns <> [] || allocates || consts <> [] || run_thunk <> None;
    stale =
      stale_sites ~live ~running ~inferred:(Check.inferred_cause env) built
        program;
    warnings = !said }

(* ── 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. *)

(* The functions checking an expression lifted out of it — a handler clause,
   a condition's printer — which the checker hangs on a function it calls
   [<none>], since an expression has no enclosing one. They belong to the
   thunk the expression becomes, and a redefinition module brings a lifted
   function along only with its parent, so each is handed to [thunk]. *)
let lifted_mark t = Check.lifted_mark t.env

let claim_lifted t mark thunk =
  List.filter_map
    (fun (f : Tast.fn) ->
       if f.Tast.fparent = Some "<none>" then
         Some { f with Tast.fparent = Some thunk }
       else None)
    (Check.lifted_since t.env mark)

type emitter = { ename : string; ety : Types.t }

let emit_bytes  = { ename = "flan/dev-emit";     ety = Types.Slice (Types.Mut, (Types.Int Types.U8)) }
let emit_str    = { ename = "flan/dev-emit-str"; ety = Types.Slice (Types.Mut, (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 =
  (* [Loc.unknown]: these are the session's own, built here and never written
     in a source file, so there is no [declare] for a refusal to point at. *)
  let one e sym = { Tast.ename = e.ename; esym = sym; eparams = [ e.ety ];
                    eret = Types.Unit; eloc = Loc.unknown } 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 write
       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 [write_slot]. *)
    { Tast.ename = "flan/dev-slot"; esym = "flan_agent_frame_slot";
      eparams = [ Types.Int Types.I64; Types.Int Types.I64 ];
      eret = Types.Ptr (Types.Mut, (Types.Int Types.U8)); eloc = Loc.unknown };
    (* A typed restart's parameter, by the restart's index in the snapshot on
       top and a byte offset into its buffer, and the flag that says the
       buffer was written. See [arm_restart]. *)
    { Tast.ename = "flan/dev-restart-arg"; esym = "flan_agent_restart_arg";
      eparams = [ Types.Int Types.I64; Types.Int Types.I64 ];
      eret = Types.Ptr (Types.Mut, Types.Int Types.U8); eloc = Loc.unknown };
    { Tast.ename = "flan/dev-restart-arm"; esym = "flan_agent_restart_arm";
      eparams = [ Types.Int Types.I64 ]; eret = Types.Unit;
      eloc = Loc.unknown };
    (* The character beside a rendered byte. See [Render.pointers]. *)
    { Tast.ename = "flan/dev-emit-u8-char"; esym = "flan_dev_emit_u8_char";
      eparams = [ Types.Int Types.I64 ]; eret = Types.Unit;
      eloc = Loc.unknown };
    { Tast.ename = "flan/dev-begin"; esym = "flan_dev_result_begin";
      eparams = []; eret = Types.Unit; eloc = Loc.unknown };
    { Tast.ename = "flan/dev-end"; esym = "flan_dev_result_end";
      eparams = []; eret = Types.Unit; eloc = Loc.unknown };
    (* 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.Mut, (Types.Int Types.U8)) ];
      eret = Types.Int Types.I32; eloc = Loc.unknown };
    { Tast.ename = "flan/reg-emit"; esym = "flan_dev_reg_emit";
      eparams = [ Types.Ptr (Types.Mut, (Types.Int Types.U8)) ];
      eret = Types.Int Types.I32; eloc = Loc.unknown } ]

(* 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;
    (* Into the value buffer, not stdout: a dyn expression's value belongs in
       the reply's value like any other. *)
    edyn =
      (fun x ->
         { Tast.e = Tast.Prim (Tast.Rt "flan_dyn_emit_dev", [ x ]);
           ty = Types.Unit; loc = x.Tast.loc });
    enested =
      (fun x ->
         { Tast.e = Tast.Prim (Tast.Rt "flan_dyn_emit_dev", [ x ]);
           ty = Types.Unit; loc = x.Tast.loc }) }

(* 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.Mut, (Types.Int Types.U8))), [ p ]);
        ty = Types.Ptr (Types.Mut, (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 });
    (* Widened to i64 at the call, because every extern this file declares
       that takes a number takes one, and the C reads the byte back out of
       it. The spelling table is in flan_dev.c and answers to
       lib/reader.ml's [read_byte]. *)
    bytechar =
      (fun b ->
         let loc = b.Tast.loc in
         let wide =
           { Tast.e = Tast.Prim (Tast.Cast (Types.Int Types.I64), [ b ]);
             ty = Types.Int Types.I64; loc }
         in
         { Tast.e = Tast.Call ("flan/dev-emit-u8-char", [ wide ]);
           ty = Types.Unit; loc }) }

(* ── The locals of a stopped frame ─────────────────────────────────── *)

(* What a slot is *shown as*. Two departures from the raw [snames] entry,
   both about keeping the listing in the words the person wrote.

   A compiler temp — [dotimes]'s hidden bound, the slot a (min) evaluates an
   operand into — has no name at all, and it is hidden rather than refused:
   [s4] is not a variable anyone can find in the file, and a row explaining
   its absence was noise on every frame that had one. [None] here means
   "not shown".

   A shadowing rebind — [check.ml]'s [bind] suffixes the repeat as [v~2] so
   the debug info never claims one binding is the other — is shown under the
   written name, because the depth is the compiler's bookkeeping. Only a
   trailing [~N] is stripped: [~] is the reader's delimiter and a synthesized
   name like [destructure~nth] carries it for a different reason. And when
   stripping would put one name on two slots of this frame, both keep their
   raw spelling — two rows called [v] with nothing to tell them apart is the
   lie the suffix existed to prevent. *)
let strip_rebind name =
  match String.rindex_opt name '~' with
  | Some k when k > 0 && k < String.length name - 1 ->
    let suffix = String.sub name (k + 1) (String.length name - k - 1) in
    if String.for_all (fun c -> c >= '0' && c <= '9') suffix
    then String.sub name 0 k
    else name
  | _ -> name

let shown_names (fn : Tast.fn) : string option array =
  let n = Array.length fn.Tast.slots in
  let raw =
    Array.init n (fun i ->
      if i < Array.length fn.Tast.snames then fn.Tast.snames.(i) else None)
  in
  (* A name the compiler gave a local of its own, such as the stepper's
     [flan~step], is hidden like an unnamed slot: [~] cannot be typed. *)
  let raw =
    Array.map
      (function
        | Some n when String.starts_with ~prefix:"flan~" n -> None
        | x -> x)
      raw
  in
  let stripped = Array.map (Option.map strip_rebind) raw in
  let count name =
    Array.fold_left
      (fun acc s -> if s = Some name then acc + 1 else acc)
      0 stripped
  in
  Array.mapi
    (fun i s ->
       match s with
       | None -> None
       | Some d -> if count d > 1 then raw.(i) else Some d)
    stripped

(* ── One slot of a stopped frame, walked ───────────────────────────── *)

(* The inspector's second rooting mode, and the whole of what it needed.

   The inspector used to navigate by rewriting *expressions* — `(.pos b)'
   where the last one was `b' — and 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. [slot_path] builds that as an expression over the
   slot's value and [Inspect.place] works out where it lives, so the steps
   and their refusals are stated once, here.

   What the path cannot do is the honest half. Every step is refused by name
   with its reason rather than guessed at: a field the type does not have, an
   index past the end of a fixed array, an option's payload on something that
   is not an option. A pointer is still never followed — that is the
   renderer's rule and not this mode's. *)

(* A step, as the editor sends it. [Sfield] on a data type carries the case as
   well, because a data type's payload is at an offset that depends on which case
   it is, and the renderer is what told the editor which case this value
   currently holds. Guessing the case from a field name that two cases share
   would read one case's layout over another's payload. *)
type step = Sfield of string | Sindex of int | Ssome

let step_text = function
  | Sfield f -> "." ^ f
  | Sindex i -> Printf.sprintf "[%d]" i
  | Ssome -> ".some"

let path_text path = String.concat "" (List.map step_text path)

let step_into t (v : Tast.expr) (s : step) : (Tast.expr, string) result =
  let loc = v.Tast.loc in
  let ty = v.Tast.ty in
  let no why = Error why in
  match s with
  | Ssome ->
    (match ty with
     | Types.Option pay -> Ok { Tast.e = Tast.Field (v, 1); ty = pay; loc }
     | _ ->
       no
         (Printf.sprintf "%s is not an option, so it has no payload to go into"
            (Types.to_string ty)))
  | Sindex i ->
    (match ty with
     | Types.Array (n, el) ->
       if i < 0 || Int64.compare (Int64.of_int i) n >= 0 then
         no
           (Printf.sprintf "%d is past the end of %s, which has %Ld elements" i
              (Types.to_string ty) n)
       else
         Ok
           { Tast.e =
               Tast.Prim
                 (Tast.At,
                  [ v;
                    { Tast.e = Tast.Int (Int64.of_int i, Types.I32);
                      ty = Types.Int Types.I32; loc } ]);
             ty = el; loc }
     | Types.Slice (_, el) ->
       (* A slice's length is not in its type, so this is the one step whose
          range cannot be settled here. It is checked in the program, like
          every other index in a dev build. *)
       if i < 0 then no (Printf.sprintf "%d is not an index" i)
       else
         Ok
           { Tast.e =
               Tast.Prim
                 (Tast.At,
                  [ v;
                    { Tast.e = Tast.Int (Int64.of_int i, Types.I32);
                      ty = Types.Int Types.I32; loc } ]);
             ty = el; loc }
     | _ ->
       no
         (Printf.sprintf "%s is not an array or a slice, so it has no element %d"
            (Types.to_string ty) i))
  | Sfield spec ->
    (match ty with
     | Types.Named n
       when List.exists (fun (u : Tast.data) -> String.equal u.Tast.dname n)
              t.program.Tast.datas ->
       let u =
         List.find (fun (u : Tast.data) -> String.equal u.Tast.dname n)
           t.program.Tast.datas
       in
       (* The editor spells this `Type.case.field', which is the head the
          renderer wrote — `(Type.case {.field …})' — with the field appended.
          A bare `case.field' is taken too, since that is the same fact said
          shorter. *)
       (match String.rindex_opt spec '.' with
        | None ->
          no
            (Printf.sprintf
               "%s is a data type: a field of it has to name the case that holds \
                it, because the payload's offset depends on which case the \
                value is in"
               n)
        | Some k ->
          let case = String.sub spec 0 k
          and fname = String.sub spec (k + 1) (String.length spec - k - 1) in
          let case =
            let pre = n ^ "." in
            let lp = String.length pre in
            if String.length case > lp && String.equal (String.sub case 0 lp) pre
            then String.sub case lp (String.length case - lp)
            else case
          in
          (match
             List.find_opt
               (fun (vr : Tast.variant) -> String.equal vr.Tast.vname case)
               u.Tast.cases
           with
           | None ->
             no (Printf.sprintf "%s has no case called %s" n case)
           | Some vr ->
             let rec idx i = function
               | [] -> None
               | (f : Tast.field) :: rest ->
                 if String.equal f.Tast.fname fname then Some (i, f.Tast.fty)
                 else idx (i + 1) rest
             in
             (match idx 0 vr.Tast.vfields with
              | None ->
                no
                  (Printf.sprintf "%s.%s has no field called %s" n case fname)
              | Some (i, fty) ->
                Ok
                  { Tast.e = Tast.CaseField (v, vr.Tast.vname, i); ty = fty; loc })))
     | Types.Named n ->
       (match
          List.find_opt
            (fun (s : Tast.structure) -> String.equal s.Tast.sname n)
            t.program.Tast.structs
        with
        | None ->
          no
            (Printf.sprintf
               "%s is a type this session has no layout for, so there is no \
                field to step to"
               n)
        | Some st ->
          let rec idx i = function
            | [] -> None
            | (f : Tast.field) :: rest ->
              if String.equal f.Tast.fname spec then Some (i, f.Tast.fty)
              else idx (i + 1) rest
          in
          (match idx 0 st.Tast.fields with
           | None ->
             no (Printf.sprintf "%s has no field called %s" n spec)
           | Some (i, fty) -> Ok { Tast.e = Tast.Field (v, i); ty = fty; loc }))
     | _ ->
       no
         (Printf.sprintf "%s has no fields, so there is no .%s in it"
            (Types.to_string ty) spec))

(* Where slot [slot] of [fn] ends up after walking [path] into it, as an
   expression over [root] — the value at the slot's address — together with
   the label the reply names it by. [Dev.inspect] reads the value there
   through [Inspect]; nothing is compiled.

   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 slot_path t ~(fn : Tast.fn) ~slot ~path ~(root : Types.t -> Tast.expr)
  : (Tast.expr * string, string) result =
  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
    match (shown_names fn).(slot) with
    | None ->
      Error
        (Printf.sprintf
           "slot %d of %s has no name in the source; the listing does not \
            show it and there is nothing here to inspect"
           slot fn.Tast.name)
    | Some name ->
      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 fn.Tast.slots.(slot)) path with
       | Error why -> Error (name ^ path_text path ^ ": " ^ why)
       | Ok v -> Ok (v, name ^ path_text path))

(* ── Writing one of them back ──────────────────────────────────────── *)

(* The inspector's other direction. SLY sets a value from the inspector and
   the reason it is worth having here is the same one the read half has: a
   game keeps its state in a struct somewhere, and the loop between "that
   field is wrong" and "is it this value that fixes it" is the loop the whole
   dev story is about. Changing it in the source and reloading answers a
   different question — it answers what the *next* run does.

   Everything about the addressing is the read half's, deliberately and not
   for economy: the same root, the same [step_into], the same refusals for a
   field a type does not have. A write that addressed values its own way would
   be free to land somewhere the render above it never showed, which is the
   whole class of bug [slot_path] exists to have closed.

   What is new is two things. The walk has to end at a *place* and not at a
   value, and the value being stored is an expression somebody typed, so it
   goes through the checker against the type the walk ended at. Both of those
   refuse, and both refuse with a sentence rather than by doing something
   smaller than was asked. *)

(* The walk's last expression, as somewhere to store.

   [step_into] builds exactly four shapes and three of them are places. That
   is not a coincidence to be relied on quietly, so the fourth is named here
   rather than left to fall through to a backend: [emit]'s [place] would
   [failwith] on it and [x86]'s would not, and two backends disagreeing about
   what is writable is worse than either answer.

   Refused with the reason, not the layout. "A data type has no place form" is
   a fact about this compiler; "the tag is what says which case the bytes are"
   is the fact about the program, and it is the one that says why writing the
   field alone would be wrong even if the offset were right. *)
let place_of (v : Tast.expr) : (Tast.place, string) result =
  match v.Tast.e with
  | Tast.Deref p -> Ok (Tast.Pderef p)
  | Tast.Prim (Tast.At, target :: idx) when idx <> [] ->
    Ok (Tast.Pindex (target, idx))
  (* [Ssome] builds this too, and it is the one [Field] that is not writable:
     an option is a tag and a payload, and storing the payload on its own
     leaves a [None] holding a value — a value nothing will ever read, because
     every reader asks the tag first. Set the option itself. *)
  | Tast.Field (target, _) when (match target.Tast.ty with
                                 | Types.Option _ -> true | _ -> false) ->
    Error
      "an option's payload is not a place on its own: the tag is what says \
       whether there is one, and storing past it would leave a None holding a \
       value nothing will ever look at. Set the option itself"
  | Tast.Field (target, i) -> Ok (Tast.Pfield (target, i))
  | Tast.CaseField (_, case, _) ->
    Error
      (Printf.sprintf
         "%s is a field of a data type's case, and which case the bytes are in \
          is what the tag says — so there is no address to store to that does \
          not also have to settle the tag. Set the whole value instead"
         case)
  | _ ->
    Error
      (Printf.sprintf "%s is not somewhere a value can be stored"
         (Types.to_string v.Tast.ty))

(* And the types that are places but must not be written through the editor.

   A [Ptr] is the one that matters. Every other refusal here is about a shape;
   this one is about where the number would come from. A pointer value typed
   into a prompt is an address this end made up, and the registry's whole
   argument is that an address is only worth anything with a blessing beside
   it. Storing one would hand the program a pointer nothing ever blessed, to
   be dereferenced at a moment nobody chose. The read half refuses to *follow*
   a pointer for the same reason it is refused here. *)
let writable_type (ty : Types.t) : (unit, string) result =
  match ty with
  | Types.Ptr _ ->
    Error
      (Printf.sprintf
         "%s is a pointer, and an address typed in here is one this end made \
          up: nothing blessed it, and the program would dereference it at a \
          moment nobody chose. The inspector does not follow pointers either"
         (Types.to_string ty))
  | _ -> Ok ()

(* Stores into slot [slot] of frame [frame], one store per [edits] entry,
   after walking [path].

   A list and not one store, because the buffer this exists for hands back a
   whole value with several fields changed in it. N modules would be N builds
   of a third of a second each and N trips past the agent's gate — so a
   five-field edit would feel broken, and, worse, would be five separate
   moments for a resume to land between. One module is one job: either every
   store in it happened at this stop or none of them did.

   Each edit's steps are relative to [path], which is what the buffer is
   showing. A single field set from a line of the inspector is one edit with
   one step; a whole value committed is one edit per changed leaf, with the
   steps that reach it.

   The thunk stores and then *renders*, between the same [dev-begin] and
   [dev-end] the read half uses, and what comes back is therefore not the
   editor's idea of what it asked for: it is what is actually there
   afterwards, read out of the program's own storage by the printer that drew
   the buffer in the first place.

   [retains] is left at its default on purpose. A module that stores a string
   literal leaves the program pointing into that module's image, and the
   default is what keeps the mapping alive for it; claiming otherwise here to
   save a page would be [(set msg "tuned")] left pointing at unmapped memory,
   which [emit.ml] spells out where it writes [flan_reload_transient].

   The caller has established the frame, as it has for [slot_path]. *)
let write_slot ?(origin = "<set>") t ~frame ~(fn : Tast.fn) ~slot ~path
  ~(edits : (step list * string) list)
  : (change * string * string, string) result =
  let loc = fn.Tast.floc in
  let nslots_of_fn = Array.length fn.Tast.slots in
  if slot < 0 || slot >= nslots_of_fn then
    Error
      (Printf.sprintf "there is no slot %d in %s; it has %d" slot fn.Tast.name
         nslots_of_fn)
  else if edits = [] then
    (* Not a no-op quietly performed. A commit that found nothing to write is
       a fact worth saying, and a module built to store nothing would cost a
       third of a second to say it. *)
    Error "there is nothing to store: nothing in this was changed"
  else
    let sname = (shown_names fn).(slot) in
    match sname with
    | None ->
      Error
        (Printf.sprintf
           "slot %d of %s has no name in the source; the listing does not \
            show it and there is nothing here to inspect"
           slot fn.Tast.name)
    | Some name ->
      let where = name ^ path_text path in
      let idx n =
        { Tast.e = Tast.Int (Int64.of_int n, Types.I64); ty = Types.Int Types.I64;
          loc }
      in
      let ty = fn.Tast.slots.(slot) in
      let address =
        { Tast.e = Tast.Call ("flan/dev-slot", [ idx frame; idx slot ]);
          ty = Types.Ptr (Types.Mut, (Types.Int Types.U8)); loc }
      in
      let typed =
        { Tast.e = Tast.Prim (Tast.Cast (Types.Ptr (Types.Mut, ty)), [ address ]);
          ty = Types.Ptr (Types.Mut, ty); loc }
      in
      let root = { Tast.e = Tast.Deref typed; ty; loc } in
      let rec walk v = function
        | [] -> Ok v
        | s :: rest ->
          (match step_into t v s with
           | Error why -> Error why
           | Ok v' -> walk v' rest)
      in
      (match walk root path with
       | Error why -> Error (where ^ ": " ^ why)
       | Ok shown ->
         (* Two passes over the edits, and the split is the point. This one
            settles every *place* and refuses the whole commit if any of them
            is not one, before a single expression has been read — so a buffer
            with one impossible field in it stores nothing rather than storing
            the fields that happened to sort first. The module's
            all-or-nothing property would be an empty promise if this end had
            already half-decided. *)
         let rec places acc = function
           | [] -> Ok (List.rev acc)
           | (steps, code) :: rest ->
             let at = where ^ path_text steps in
             (match walk shown steps with
              | Error why -> Error (at ^ ": " ^ why)
              | Ok target ->
                (match writable_type target.Tast.ty with
                 | Error why -> Error (at ^ ": " ^ why)
                 | Ok () ->
                   (match place_of target with
                    | Error why -> Error (at ^ ": " ^ why)
                    | Ok dest ->
                      places ((at, dest, target.Tast.ty, code) :: acc) rest)))
         in
         (match places [] edits with
          | Error why -> Error why
          | Ok targets ->
            (* And this one reads and checks the values. Every expression is
               checked against one [ctx] — [Check.expressions], not one
               [Check.expression] each — because two expressions checked apart
               both number their slots from zero, and splicing them into one
               thunk would have the second one's [let] reading and writing the
               first one's storage. *)
            let mark = Check.instance_mark t.env in
            let lmark = lifted_mark t in
            let wanted =
              List.map
                (fun (at, _, tty, code) ->
                   let form =
                     match Source.read_code ~expr:true ~file:origin code with
                     | [ f ] -> f
                     | [] -> fail loc "nothing to store into %s" at
                     | _ :: f :: _ -> fail f.Form.loc "one value at a time"
                   in
                   (* Expanded with the session's imported macros in front of
                      it, for the reason [eval_expr] gives: the prompt sends
                      one expression with no import in sight, and the session
                      is the only thing holding what the imports brought in. *)
                   (Some tty, Parse.with_imported t.macros (fun () -> Parse.expr form)))
                targets
            in
            (* Checked *against the place's type*, which is the whole reason
               [Check.expression] grew a [want]. Without it, [7] into an [f32]
               field arrives as an [i32] and is refused for a mismatch the
               reader never wrote; with it, it arrives as an [f32], and what
               stays refused is what really does not fit — in the checker's
               own words, which is the only place that sentence should ever be
               written down. *)
            let values, base, bnames = Check.expressions t.env wanted in
            let fresh = Check.instances_since t.env mark in
            let stores =
              List.map2
                (fun (_, dest, _, _) value ->
                   { Tast.e = Tast.Set (dest, value); ty = Types.Unit; loc })
                targets values
            in
            let extra = ref [] and nslots = ref (Array.length base) in
            let c =
              { Render.structs = t.program.Tast.structs @ Check.fresh_copies t.env t.program.Tast.structs;
                datas = t.program.Tast.datas;
                unions = t.program.Tast.unions;
                enums =
                  Hashtbl.fold (fun k v acc -> (k, v) :: acc) t.env.Check.enums [];
                emit = dev_emitter;
                ptrs = Some dev_pointers;
                alloc = (fun ty ->
                  let i = !nslots in
                  incr nslots;
                  extra := ty :: !extra;
                  i) }
            in
            (match Render.render c 0 shown with
             | exception Loc.Error { Loc.dmsg = why; _ } ->
               Error (where ^ ": " ^ why)
             | parts ->
               let nullary n =
                 { Tast.e = Tast.Call (n, []); ty = Types.Unit; loc }
               in
               t.thunks <- t.thunks + 1;
               let tname = Printf.sprintf "set/%d" t.thunks in
               let thunk : Tast.fn =
                 { Tast.name = tname; params = []; ret = Types.Unit;
                   body =
                     stores
                     @ (nullary "flan/dev-begin" :: parts)
                     @ [ nullary "flan/dev-end" ];
                   fdefers = []; fenv = None; fparent = None; floc = loc;
                   slots = Array.append base (Array.of_list (List.rev !extra));
                   (* The stored expressions' own [let]s keep their names; the
                      slots [render] added behind them are the walk's own
                      scratch and have none to keep. *)
                   snames =
                     Array.append bnames
                       (Array.make (List.length !extra) None);
                   as_slots = [] }
               in
               (* A struct copy the values named first, laid out in this
                  module and kept, as [eval_expr] keeps one. *)
               let copies = Check.fresh_copies t.env t.program.Tast.structs in
               let program =
                 { t.program with
                   Tast.fns =
                     t.program.Tast.fns @ fresh @ claim_lifted t lmark tname
                     @ [ thunk ];
                   structs = t.program.Tast.structs @ copies;
                   externs = t.program.Tast.externs @ externs }
               in
               let ir =
                 redefinition t ~call:tname program
                   ~fns:
                     (List.map (fun (f : Tast.fn) -> f.Tast.name) fresh
                      @ [ tname ])
               in
               (* The instances the values forced stay, the thunk does not —
                  [eval_expr] says why, and the caller takes the same [held]
                  around this that it takes around one. *)
               t.program <-
                 { t.program with
                   Tast.fns = t.program.Tast.fns @ fresh;
                   structs = t.program.Tast.structs @ copies };
               Ok
                 ({ ir; x86 = t.x86; names = []; fns = []; installs = true; stale = []; warnings = [] },
                  where, Types.to_string shown.Tast.ty))))

(* ── A typed restart, taken from the break loop ──────────────────────── *)

(* The types a restart takes, read back from how its frame spells them —
   [Check.restart_sig], a parenthesised list of [Types.to_string]s, which the
   reader reads as one list of type forms. *)
let restart_params t sg =
  match Reader.read_all ~file:"<restart>" sg with
  | [ { Form.v = Form.List forms; _ } ] ->
    (match List.map (fun f -> Check.resolve t.env (Parse.texpr f)) forms with
     | tys -> Ok tys
     | exception Loc.Error { Loc.dmsg = why; _ } ->
       Error ("the restart takes " ^ sg ^ ", and " ^ why))
  | _ -> Error ("the restart's parameters are spelled " ^ sg ^ ", which is not a list of types")

(* What [invoke-restart] does to a frame before it aims the channel, done by a
   thunk instead: each value, checked against the parameter's own type, stored
   at its offset in the buffer the frame owns, and the flag set that says the
   buffer was written. The offsets are [Emit.lay_fields] over the parameter
   types, which is how both backends lay out that buffer and how the invoker
   and the clause agree on it.

   The values are expressions, checked in the session like any evaluated one,
   so the refusal for a value that does not fit is the checker's own sentence.
   The thunk renders the stored values back, which is what the program holds
   now rather than what was asked for. *)
let arm_restart ?(origin = "<restart>") t ~index ~(params : Types.t list)
    ~(codes : string list) : (change * string list, string) result =
  let loc = Loc.unknown in
  let md = X86.layout_ctx ~checks:false ~dev:true t.program in
  let _, _, offs = Emit.lay_fields md params in
  let mark = Check.instance_mark t.env in
  let lmark = lifted_mark t in
  let wanted =
    List.map2
      (fun ty code ->
         let form =
           match Source.read_code ~expr:true ~file:origin code with
           | [ f ] -> f
           | [] -> fail loc "a value for a %s is empty" (Types.to_string ty)
           | _ :: f :: _ -> fail f.Form.loc "one value for each parameter"
         in
         (Some ty, Parse.with_imported t.macros (fun () -> Parse.expr form)))
      params codes
  in
  let values, base, bnames = Check.expressions t.env wanted in
  let fresh = Check.instances_since t.env mark in
  let i64 n =
    { Tast.e = Tast.Int (Int64.of_int n, Types.I64); ty = Types.Int Types.I64; loc }
  in
  let at ty off =
    let raw =
      { Tast.e = Tast.Call ("flan/dev-restart-arg", [ i64 index; i64 off ]);
        ty = Types.Ptr (Types.Mut, Types.Int Types.U8); loc }
    in
    { Tast.e = Tast.Prim (Tast.Cast (Types.Ptr (Types.Mut, ty)), [ raw ]); ty = Types.Ptr (Types.Mut, ty); loc }
  in
  let stores =
    List.map2
      (fun (ty, off) (v : Tast.expr) ->
         { Tast.e = Tast.Set (Tast.Pderef (at ty off), v); ty = Types.Unit; loc })
      (List.combine params offs) values
  in
  let arm =
    { Tast.e = Tast.Call ("flan/dev-restart-arm", [ i64 index ]); ty = Types.Unit; loc }
  in
  let extra = ref [] and nslots = ref (Array.length base) in
  let c =
    { Render.structs = t.program.Tast.structs @ Check.fresh_copies t.env t.program.Tast.structs;
      datas = t.program.Tast.datas;
      unions = t.program.Tast.unions;
      enums = Hashtbl.fold (fun k v acc -> (k, v) :: acc) t.env.Check.enums [];
      emit = dev_emitter;
      ptrs = Some dev_pointers;
      alloc = (fun ty ->
        let i = !nslots in
        incr nslots;
        extra := ty :: !extra;
        i) }
  in
  let bytes_of str =
    { Tast.e =
        Tast.Prim (Tast.Bytes, [ { Tast.e = Tast.Str str; ty = Types.String; loc } ]);
      ty = Types.Slice (Types.Mut, Types.Int Types.U8); loc }
  in
  let lit str = c.Render.emit.Render.ebytes (bytes_of str) in
  match
    List.concat
      (List.map2
         (fun (ty, off) k ->
            (if k > 0 then [ lit "\n" ] else [])
            @ Render.render c 0 { Tast.e = Tast.Deref (at ty off); ty; loc })
         (List.combine params offs)
         (List.init (List.length params) Fun.id))
  with
  | exception Loc.Error { Loc.dmsg = why; _ } -> Error why
  | shown ->
    let nullary n = { Tast.e = Tast.Call (n, []); ty = Types.Unit; loc } in
    t.thunks <- t.thunks + 1;
    let tname = Printf.sprintf "restart/%d" t.thunks in
    let thunk : Tast.fn =
      { Tast.name = tname; params = []; ret = Types.Unit;
        body =
          stores @ [ arm ] @ (nullary "flan/dev-begin" :: shown)
          @ [ nullary "flan/dev-end" ];
        fdefers = []; fenv = None; fparent = None; floc = loc;
        slots = Array.append base (Array.of_list (List.rev !extra));
        snames = Array.append bnames (Array.make (List.length !extra) None);
      as_slots = [] }
    in
    let copies = Check.fresh_copies t.env t.program.Tast.structs in
    let program =
      { t.program with
        Tast.fns =
          t.program.Tast.fns @ fresh @ claim_lifted t lmark tname @ [ thunk ];
        structs = t.program.Tast.structs @ copies;
        externs = t.program.Tast.externs @ externs }
    in
    let ir =
      redefinition t ~call:tname program
        ~fns:(List.map (fun (f : Tast.fn) -> f.Tast.name) fresh @ [ tname ])
    in
    t.program <-
      { t.program with
        Tast.fns = t.program.Tast.fns @ fresh;
        structs = t.program.Tast.structs @ copies };
    Ok
      ({ ir; x86 = t.x86; names = []; fns = []; installs = true; stale = []; warnings = [] },
       List.map Types.to_string params)

(* [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. *)
(* [frame] is SLIME's eval-in-frame: a stopped frame's index, the function it
   is running and which of its slots were bound when it stopped. The
   expression is then checked with that frame's named locals in scope — the
   innermost of two of one name winning, as it does in the source — and every
   use of one reads or writes the frame's own storage through [flan/dev-slot],
   so a [set] changes the frame and a vec is not copied. A local not bound
   yet is refused where it is named: its address is null. *)
let in_frame t ~frame:(index, (fn : Tast.fn), bound) (parsed : Ast.expr) =
  let n = Array.length fn.Tast.slots in
  let nparams = List.length fn.Tast.params in
  let named =
    List.filter_map
      (fun i ->
         match if i < Array.length fn.Tast.snames then fn.Tast.snames.(i) else None with
         | Some raw -> Some (i, strip_rebind raw)
         | None -> None)
      (List.init n Fun.id)
  in
  (* Unbound first, so that of two slots one name the bound one shadows. *)
  let order =
    List.filter (fun (i, _) -> not (List.mem i bound)) named
    @ List.filter (fun (i, _) -> List.mem i bound) named
  in
  let scope =
    List.map
      (fun (i, name) ->
         (name, fn.Tast.slots.(i), i >= nparams, List.mem i fn.Tast.as_slots))
      order
  in
  let checked, base, bnames, syn = Check.expression_in_scope t.env ~scope parsed in
  let table = List.map2 (fun (i, name) (_, j) -> (j, (i, name))) order syn in
  let idx loc k =
    { Tast.e = Tast.Int (Int64.of_int k, Types.I64); ty = Types.Int Types.I64; loc }
  in
  let pointer i loc =
    let ty = fn.Tast.slots.(i) in
    { Tast.e =
        Tast.Prim
          (Tast.Cast (Types.Ptr (Types.Mut, ty)),
           [ { Tast.e = Tast.Call ("flan/dev-slot", [ idx loc index; idx loc i ]);
               ty = Types.Ptr (Types.Mut, Types.Int Types.U8); loc } ]);
      ty = Types.Ptr (Types.Mut, ty); loc }
  in
  let checked =
    Tast.rewrite_locals
      (fun j loc ->
         match List.assoc_opt j table with
         | None -> None
         | Some (i, name) when not (List.mem i bound) ->
           fail loc
             "%s is not bound yet where the program stopped, so there is no \
              value to read" name
         | Some (i, _) -> Some (pointer i loc))
      checked
  in
  (* The slots the frame's names were bound to are read through the pointer
     now, never directly; a byte keeps each from costing its type's size. *)
  let base =
    Array.mapi (fun j ty -> if List.mem_assoc j table then Types.Int Types.U8 else ty) base
  and bnames =
    Array.mapi (fun j nm -> if List.mem_assoc j table then None else nm) bnames
  in
  (checked, base, bnames)

let eval_expr ?(origin = "<eval>") ?(pause = false) ?frame t src : change =
  let form =
    match Source.read_code ~expr:true ~file:origin src with
    | [ f ] -> f
    | [] -> fail Loc.unknown "nothing to evaluate"
    | _ :: f :: _ -> fail f.Form.loc "one expression at a time"
  in
  Loc.remember ~file:origin src;
  (* [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 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 ~decls:(package_decls t) ~fns:(shadowing_fns t origin) (macros_for t origin) (fun () -> Parse.expr form) in
  (* CIDER's rule: an expression sent from a package's file means what it
     would mean written in that file, so [(integrate 1.0)] in physics/step.flan
     reaches [physics/integrate]. The qualification [eval] gives a declaration
     from the same buffer. A [defn-] is reachable too, because the location
     [private_ref] compares is the buffer's own path. *)
  let parsed =
    match package_of t origin with
    | None -> parsed
    | Some p -> Load.rename_expr p.Load.owns p.Load.alias [] parsed
  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 ~fn:(prelude_fn t.decls "pause") 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 lmark = Check.lifted_mark t.env in
  let checked, base, bnames =
    match frame with
    | None -> Check.expression t.env parsed
    | Some frame -> in_frame t ~frame parsed
  in
  let fresh = Check.instances_since t.env mark in
  let lifted = Check.lifted_since t.env lmark 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 @ Check.fresh_copies t.env t.program.Tast.structs;
      datas = t.program.Tast.datas;
      unions = t.program.Tast.unions;
      enums = Hashtbl.fold (fun k v acc -> (k, v) :: acc) t.env.Check.enums [];
      emit = dev_emitter;
      ptrs = Some dev_pointers;
      alloc = (fun ty ->
        let i = !nslots in
        incr nslots;
        extra := ty :: !extra;
        i) }
  in
  let loc = checked.Tast.loc in
  let nullary n = { Tast.e = Tast.Call (n, []); ty = Types.Unit; loc } in
  let body =
    (nullary "flan/dev-begin" :: Render.render c 0 checked)
    @ [ nullary "flan/dev-end" ]
  in
  t.thunks <- t.thunks + 1;
  let name = Printf.sprintf "eval/%d" t.thunks in
  let thunk : Tast.fn =
    { Tast.name; params = []; ret = Types.Unit; body; fdefers = []; fenv = None; 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);
      as_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. *)
  (* A body the expression lifted — an [fn] literal, a handler clause — is
     reached by address from the thunk, so it goes into the module with it:
     parented on the thunk, which is what makes [redefinition] carry it, and
     with the environment struct it captured into, which is what lays it out.
     Placed like any other capturing fn, against the whole program, so a
     closure the expression keeps gets an environment the collector owns. *)
  let lifted =
    List.map (fun (f : Tast.fn) -> { f with Tast.fparent = Some name }) lifted
  in
  let placed =
    Check.place_closures (t.program.Tast.fns @ fresh @ lifted @ [ thunk ])
  in
  let own = List.map (fun (f : Tast.fn) -> f.Tast.name) (lifted @ [ thunk ]) in
  let placed =
    List.filter (fun (f : Tast.fn) -> List.mem f.Tast.name own) placed
  in
  let copies = Check.fresh_copies t.env t.program.Tast.structs in
  let program =
    { t.program with
      Tast.fns = t.program.Tast.fns @ fresh @ placed;
      structs =
        t.program.Tast.structs @ copies @ Check.env_structs t.env lifted;
      externs = t.program.Tast.externs @ externs }
  in
  let ir =
    (* The thunk gets debug info on the same flag as everything else. It is a
       function nobody sets a breakpoint on by name, but it is a frame on the
       stack when the expression signals, and a frame the debugger cannot name
       is the thing the conditions buffer is trying to stop showing. *)
    redefinition t ~call:name program
      ~fns:(List.map (fun (f : Tast.fn) -> f.Tast.name) fresh @ [ name ])
  in
  (* The copies stay in the session's program, unlike the thunk: the thunk is
     not a declaration and there is nothing to keep, but a copy that has been
     built and loaded *is* part of the running process from here on, and
     forgetting it would generate a second one under the same name at the next
     evaluation.

     After [Emit], not before it: the session must not come to believe it holds
     a body that no module was ever written for. A daemon that answers and has
     lost track of what the program contains is worse than one that died.

     Written for is as far as this line can get, and it is not far enough on
     its own: the module still has to build and still has to be taken. The
     caller closes that half by taking a [held] before this and restoring it
     when either fails — a copy the session holds and no module defines is a
     null cell exactly as a stranded declaration is. *)
  t.program <-
    { t.program with
      Tast.fns = t.program.Tast.fns @ fresh;
      structs = t.program.Tast.structs @ copies };
  { ir; x86 = t.x86; names = []; fns = []; installs = true; stale = []; warnings = [] }

(* ── What a macro call expands to ──────────────────────────────────── *)

(* [C-c C-m]. The one thing the editor can ask that compiles nothing, sends
   nothing to the program, and leaves the session exactly as it found it.

   It is a session operation rather than a [Reader] plus a [Macro] call for the
   reason the whole of this file exists: what a call expands to is decided by
   *which macros this session holds* — the prelude's, the ones its imports
   brought in, and the [defmacro]s the buffer has evaluated since it started —
   and that set lives in [t.macros] and nowhere else. Expanding against a fresh
   read of the file would answer with macros the session was never told about
   and with a version of the ones it was told about that is whatever happens to
   be *saved*. An expansion that disagreed with what an evaluation does would
   be worse than no expansion at all: a macro decides what the code is.

   Nothing here is assigned. [eval] commits [t.macros] and [eval_expr] bumps
   [t.thunks] and [t.program]; this reads and writes nothing, so a form that
   only *looks* like a declaration — a [defmacro] handed to [C-c C-m] — does
   not join the session by having been looked at. [test_session] pins that. *)

type expansion = {
  xbefore : Form.t;             (* what was sent, quasiquote already desugared *)
  xafter  : Form.t;             (* what it expands to *)
  xmacro  : string option;      (* the macro at the head, when the head is one *)
  (* False when the expansion is the form itself. Reported rather than left for
     the editor to diff, because the two ways of being unchanged are different
     facts: a head that names no macro, and a macro whose answer is its own
     call. Only [xmacro] tells them apart. *)
  xchanged : bool;
}

(* [all] is the difference between CIDER's two commands, and it is real here
   rather than inherited: a macro may quasiquote a call to another macro, so
   [(mac/quad 3)] one-stepped is [(mac/twice (mac/twice 3))] and all the way is
   [(+ (+ 3 3) (+ 3 3))].

   The refusals both live on the [all] path and both are [Loc.Error], which the
   daemon answers as a reply: a macro that never settles is stopped by
   [Macro.fuel] and named, and a ring of macros was refused while the package
   holding it was parsed, which is before any session over it could exist. One
   step cannot reach either — it makes exactly one call and does not look at
   the answer — so [(s/spin)] one-stepped is a fact about the macro and only
   [C-u] refuses. *)
let macroexpand ?(origin = "<eval>") ~(all : bool) t (src : string) : expansion =
  let form =
    match Source.read_code ~file:origin src with
    | [ f ] -> f
    | [] -> fail Loc.unknown "nothing to expand"
    | _ :: f :: _ -> fail f.Form.loc "one form at a time"
  in
  (* Desugared first, exactly as [Parse.parse_forms] does it and for its
     reason: a quasiquote that has not been rewritten still looks like a call
     to something named [quasiquote], and the [Form.Sym] inside it looks like a
     head anything could mistake for one. *)
  let before = Expand.quasiquote form in
  (* And the session's macros in front of it, as [eval] and [eval_expr] both
     put them: [Macro.program] reads [Parse.imported_macros] directly. *)
  Parse.with_imported ~decls:(package_decls t) ~fns:(shadowing_fns t origin) (macros_for t origin) @@ fun () ->
  let after, name =
    if all then Macro.expand_all before else Macro.expand_step before
  in
  { xbefore = before; xafter = after; xmacro = name;
    (* Structural, through the printer both halves are shown with, so "changed"
       means "would print differently" — which is the claim the buffer makes.
       There is no equality on [Form.t] to use instead: it carries a [Loc.t],
       and [Loc.from_macro] stamps a name onto every node a macro answers, so
       even an identity expansion compares unequal. *)
    xchanged = Form.to_source after <> Form.to_source before }