flan/lib/check.ml

(** The checker: AST → typed IR.

    Two passes, because top-level names in a package are order-independent
    (plan.org, Modules): the first collects every type, signature and global,
    the second checks bodies against them. Mutually recursive functions need no
    forward declaration, and a struct may be used above where it is declared.

    Checking is *bidirectional*. An expression is checked against an expected
    type when there is one and inferred when there is not, which is what makes
    [None], a bare [0] and a struct literal work without any inference engine:
    the expected type flows in from the function's return type, the parameter
    it is being passed to, or the field it is being stored in.

    The rule from the two misparse bugs applies here too: *anything not yet
    implemented is rejected by name*, never approximated. Milestone 2 is
    calc-me.flan and nothing more (plan.org, Build sequence), so [Vec], [Map],
    [Result]/[try], user data types, closures, [dotimes], [defer], generics and
    cross-package imports are all errors with a message that says which
    milestone they belong to. *)

let fail = Loc.fail

(* [List.map]'s evaluation order is unspecified, and checking allocates frame
   slots as a side effect. Left-to-right is required, not a preference: a later
   let binding sees an earlier one, and slot numbering must be reproducible. *)
let rec map_lr f = function
  | [] -> []
  | x :: rest -> let y = f x in y :: map_lr f rest

let rec map2_lr f xs ys =
  match xs, ys with
  | [], [] -> []
  | x :: xs, y :: ys -> let z = f x y in z :: map2_lr f xs ys
  | _ -> invalid_arg "map2_lr"

(* ── Environments ──────────────────────────────────────────────────── *)

type binding = {
  slot       : int;
  bty        : Types.t;
  assignable : bool;   (* locals are places; parameters are not — spec-memory *)
}

type env = {
  structs : (string, Tast.structure) Hashtbl.t;
  datas  : (string, Tast.data) Hashtbl.t;
  (* The untagged unions, by name, and they are [Tast.structure] values on
     purpose: a union's members *are* a field list, and every one of them is at
     offset zero. Giving them a record of their own would have meant a second
     shape for [field_index] and for every walk over a member list, to say
     nothing new — which table the name is in is already what says whether the
     offsets are cumulative or all zero, exactly as it is for a data type. *)
  unions  : (string, Tast.structure) Hashtbl.t;
  (* Every data type case, twice over: once under its full spelling ["U.C"], which
     is how a value of it is written, and once under the bare ["C"], which is
     how a [match] arm names it and how a mistake spells a constructor. The
     full spelling is a key rather than something split out of a dotted name at
     the use site, because a data type's own name can contain a slash (an imported
     [rl/U]) and may one day contain a dot; string surgery would own an edge
     this does not have to.

     The bare entry is deliberately last-writer-wins and is *only* used to say
     "C is a case of U, write (U.C ...)". Two data types may share a case name —
     construction is qualified and a pattern resolves against the scrutinee, so
     both are unambiguous — and refusing that would be a restriction with no
     mechanism behind it. *)
  cases   : (string, string * Tast.variant) Hashtbl.t;
  aliases : (string, Ast.texpr) Hashtbl.t;
  consts  : (string, int64) Hashtbl.t;         (* compile-time array lengths *)
  locs    : (string, Loc.t) Hashtbl.t;         (* where each type was declared *)
  (* Enum name -> its members, in declaration order. A keyword at a call site
     resolves against this and nothing else. *)
  enums   : (string, (string * int64) list) Hashtbl.t;
  (* Flan name -> the C symbol it is really called by. A foreign function is an
     ordinary entry in [fns] as well; this only records how to name it. *)
  externs : (string, string) Hashtbl.t;
  fns     : (string, Types.t list * Types.t) Hashtbl.t;
  globals : (string, Types.t * bool) Hashtbl.t;   (* type, is a constant *)
  (* Functions the checker made up: a handler-bind clause is lifted into one,
     because a handler is called from wherever the signal was and cannot be a
     branch in the function that established it. *)
  mutable lifted : Tast.fn list;

  (* ── Generics by monomorphisation (spike, milestone 5) ────────────────
     A generic [defn] is *not* in [fns]: its signature mentions type variables
     and nothing can be called at it. It lives here, as the AST it was written
     as, and every call site turns it into an ordinary function with concrete
     types. Odin's model exactly — [find_or_generate_polymorphic_procedure]
     keeps the source [Entity] and hangs generated ones off it. *)
  generics : (string, Ast.fn) Hashtbl.t;
  (* Its signature as *written*: parameter and return types with [Types.Var]
     in them. This is the pattern a call site matches its argument types
     against to bind the variables. *)
  gsigs   : (string, string list * Types.t list * Types.t) Hashtbl.t;
  (* The instantiation cache. Odin's [gen_procs] list, keyed the way Odin keys
     it: a linear scan comparing whole concrete signatures with
     [are_types_identical] — here [Types.equal] pairwise. Same types twice
     means one copy. *)
  insts   : (string, (Types.t list * Types.t * string) list ref) Hashtbl.t;
  (* The copies themselves, in the order they were generated. They are
     ordinary [Tast.fn]s from here down; nothing in a backend knows they were
     ever generic. *)
  mutable instances : Tast.fn list;
  (* The type variables in scope while a generic signature is being resolved.
     Empty everywhere else, which is what keeps the lowercase rejection at
     [resolve_name] the default. *)
  mutable tyvars : string list;
  (* What each of them is bound to while one instantiation's body is checked.
     [resolve_name] consults it before anything else, so the body resolves
     [t] to [i32] and every node under it is concrete. *)
  mutable subst : (string * Types.t) list;
  (* The [where] predicates in scope: what the abstract pass may assume about
     the variables, and what each instantiation checks its concrete types
     answer yes to. Empty everywhere a generic signature or body is not being
     resolved, which is what keeps every refusal below the default. *)
  mutable tvpreds : Ast.pred list;
  (* The chain of instantiations currently being generated, innermost last:
     the generic's name and the concrete parameter types each copy was asked
     for. It is the refusal for a generic that instantiates itself without
     end — [(defn grow [x $t] () (grow [x x]))] asks for a copy at [[2 t]],
     which asks for one at [[2 [2 t]]], forever — and without it the checker
     does not fail, it *hangs*, which through [Session.eval] is [C-c C-c]
     hanging with the dev daemon wedged behind it.

     The test is structural rather than a depth count. A depth count names a
     number the programmer did not write and cannot act on; this names the
     chain. Odin has no cap of its own to copy, so there was nothing to
     borrow. *)
  mutable chain : (string * Types.t list * Loc.t) list;
}

let new_env () = {
  structs = Hashtbl.create 16;
  datas  = Hashtbl.create 16;
  unions  = Hashtbl.create 16;
  cases   = Hashtbl.create 32;
  aliases = Hashtbl.create 16;
  consts  = Hashtbl.create 16;
  locs    = Hashtbl.create 16;
  enums   = Hashtbl.create 8;
  externs = Hashtbl.create 32;
  fns     = Hashtbl.create 32;
  globals = Hashtbl.create 16;
  lifted = [];
  generics = Hashtbl.create 8;
  gsigs = Hashtbl.create 8;
  insts = Hashtbl.create 8;
  instances = [];
  tyvars = [];
  subst = [];
  tvpreds = [];
  chain = [];
}

(* Where a named type was declared, and what it has, as a note.

   This is the second half of the two-place messages: a refusal that says
   [Cursor has no field pos] is true, and the reader's next move is always to
   go and look at Cursor. Attaching the declaration's location and its actual
   field names means the answer arrives with the question, and [next-error]
   will take you there because a note prints as an entry of its own. Empty when
   the name is not one this environment placed, so it degrades to the message
   alone rather than to a wrong pointer. *)
let declared_note env name =
  match Hashtbl.find_opt env.locs name with
  | None -> []
  | Some at ->
    let names =
      match Hashtbl.find_opt env.structs name with
      | Some s -> List.map (fun (f : Tast.field) -> f.Tast.fname) s.Tast.fields
      | None ->
        (match Hashtbl.find_opt env.datas name with
         | Some u -> List.map (fun (c : Tast.variant) -> c.Tast.vname) u.Tast.cases
         | None ->
           match Hashtbl.find_opt env.unions name with
           | Some u -> List.map (fun (f : Tast.field) -> f.Tast.fname) u.Tast.fields
           | None -> [])
    in
    let what =
      if names = [] then name ^ " is declared here"
      else name ^ " is declared here, with " ^ String.concat ", " names
    in
    [ Loc.note at what ]

(* What a [break] or a [continue] may be talking about, innermost first.

   [Lloop] is a loop it is lexically inside, carrying its label if it was given
   one. [Lbarrier] is something a jump may not cross, named so the refusal can
   say which — and the barriers are the whole of the answer to the question
   [return]'s [in_frames] rule could not answer.

   [return] is refused inside a [handler-bind] or a [restart-case] blanketly,
   because a return *always* crosses the frames established there and leaves
   them on the stack pointing into a frame that has gone. A break crosses only
   sometimes: a loop written wholly inside a [restart-case] body has a
   perfectly good local break, and refusing it would be refusing the common
   case for the uncommon one. So the rule here is relative rather than blanket
   — a jump is refused exactly when a barrier stands between it and the loop it
   names — and the two rules agree on the case they share, because a [return]
   is a jump whose target is always outside every barrier.

   A [defer]'s forms are a barrier for a different reason with the same shape:
   they are copied into the function's exit paths, where the loop they were
   written next to no longer exists. A loop *inside* the defer is fine, which
   is again the relative rule and not a blanket one.

   A handler clause is not on this list at all: it is lifted into a function of
   its own and gets a fresh [ctx], so its loops start empty and nothing inside
   it can name a loop outside it. *)
type lentry =
  | Lloop    of string option
  (* A [(loop ...)], carrying the slot and type of each of its names so that a
     [recur] can rebind them. It is *also* a barrier for [break] and
     [continue]: a loop answers with the value of its body, so a jump that left
     one would have no value to give. A [while] written inside a loop is
     unaffected, which is the relative rule doing its job again. *)
  | Lrecur   of (int * Types.t) list
  | Lbarrier of string

(* Per-function state. Slots are never reused, so [slots] is also the frame
   size — the interpreter allocates one array of this length per call. *)
type ctx = {
  env           : env;
  ret           : Types.t;
  mutable slots : int;
  (* The type of each slot, newest first. A backend needs it to size the
     frame — nothing else records it, since the IR refers to slots by index. *)
  mutable slot_tys : Types.t list;
  (* The source name of each slot, newest first, parallel to [slot_tys].
     [None] for a slot the checker invented -- see [Tast.fn.snames]. Recorded
     here rather than recovered later because this scope list is the only place
     that ever knows it. *)
  mutable slot_names : string option list;
  mutable scope : (string * binding) list;   (* innermost first *)
  (* Deferred forms, most recently registered first — which is also the order
     they run in. [defer] is function-scoped, so this list belongs to the
     function and not to a block — see [defer_ok] for where one may be written
     and [check_fn] for where the list is spliced onto the exit paths. *)
  mutable defers : Tast.expr list;
  (* Where a [defer] may be written, which is exactly: a form whose extent is
     the whole function body. Two things have that extent and only two — a
     top-level form of the body, and a form in the body of a [let] that itself
     has it, to any depth. A [let] always registers and its bindings outlive
     the block textually enclosing them, because a [let] is not a frame here:
     its bindings are function slots like any other, and nothing is released at
     scope exit (spec-memory.md, "When storage is released").

     Everything else is refused, and the two that matter are refused for a
     reason rather than by omission. [defer] is a *compile-time* construct —
     the cleanup is copied into every exit path — so a branch would have to
     express "maybe registered", which it cannot, and a loop body would fire
     once at function exit rather than once per iteration.

     The flag is set immediately before each form that may carry one, never
     once around a body: [check] clears it on entry, so a body whose first form
     set it would otherwise refuse the second. [defer_block] names the
     innermost construct that cleared it, so the refusal says which. *)
  mutable defer_ok : bool;
  mutable defer_block : string;
  (* Only for the two things a handler clause cannot do. [outer] is the
     establishing function's scope, kept so that a reference to one of its
     locals can be refused for the reason it is really refused for rather than
     as an unknown name. *)
  outer : (string * binding) list;
  (* Set on the context of a body the checker lifted into a function of its
     own — a handler clause, or an [fn] literal — and naming which, so the
     refusal below says why the enclosing function's locals are not there. Both
     are the same gap: capture does not exist. *)
  mutable outer_what : string option;
  (* True wherever handler or restart frames established by this function are
     on the stack. A [return] from there would leave them pointing into a frame
     that has gone, so it is refused — the same rule as [defer] inside a
     block. *)
  mutable in_frames : string option;
  (* The loops and the barriers this form is inside, innermost first. See
     [lentry]: it is what [break] and [continue] resolve against, and the whole
     of why they are not a goto — a label that names no loop on this list is
     refused, so control can only leave a loop it is already in. *)
  mutable loops : lentry list;
  (* True where this form's value is the value of the enclosing [loop]'s body,
     which is the only place a [recur] may stand. Read and withdrawn at the top
     of [check] exactly as [defer_ok] is, and granted again by the three forms
     that pass a tail through: the last form of a block, both arms of an [if],
     and a [match] arm. Everything else is therefore non-tail by construction,
     and no walk has to enumerate the cases that are not. *)
  mutable tail : bool;
  (* True inside a [defer]'s forms. A defer is the cleanup a transfer runs on
     its way out (§5), so a transfer *starting* there has no answer: this
     function's defers are already half run and the first transfer's target is
     already in hand. Refused where it is written. *)
  mutable in_defer : bool;
  (* The function being checked, so a clause lifted out of it can be named
     after it. The name has to be stable and has to say whose it is: a
     redefinition module emits the clauses belonging to the bodies it is
     replacing, and nothing else in the program can tell it which those are. *)
  owner : string;
}

(* [?name] is the source name, when there is one. It is optional so that the
   several places that allocate a hidden slot say nothing and get [None] --
   a synthesized slot cannot accidentally acquire a name it was never given. *)
let fresh_slot ?name ctx ty =
  let s = ctx.slots in
  ctx.slots <- s + 1;
  ctx.slot_tys <- ty :: ctx.slot_tys;
  ctx.slot_names <- name :: ctx.slot_names;
  s

(* Shadowing is legal -- [(let [v 11] (let [v 22] ...))] is two slots, both
   named [v] -- and the debug info has nowhere to put the distinction. Every
   [!DILocalVariable] is scoped to the subprogram, because the typed IR has no
   block structure for a [!DILexicalBlock] to be built from, so two variables
   called [v] land in one flat scope and lldb answers [p v] with whichever it
   finds first. Measured, not assumed: it answers with the *outer* one, so it
   prints 11 while the body it is stopped in is computing with 22, and the
   inner binding is not listed at all.

   That is the one outcome worse than printing [s3]: a name the debugger is
   confident about and wrong about. So a repeat of a name already bound in this
   function gets a suffix, and both bindings are then visible and unambiguous.
   [~] is the reader's delimiter and cannot occur in a source symbol (the same
   reason [destructure~nth] is spelled that way), so [v~2] is visibly the
   compiler's doing and can never collide with something the programmer wrote.

   This is a way of not lying, not a way of being right: [v] is still the outer
   binding everywhere, including inside the inner one's extent. Scoping the
   variables properly means emitting a [!DILexicalBlock] per [Let] and moving
   the [llvm.dbg.declare]s out of the entry block to the binding sites, which
   needs block structure this IR does not carry. *)
let bind ctx name bty ~assignable =
  let taken n = List.exists (fun s -> s = Some n) ctx.slot_names in
  let name' =
    if not (taken name) then name
    else
      let rec go k =
        let c = Printf.sprintf "%s~%d" name k in
        if taken c then go (k + 1) else c
      in
      go 2
  in
  let slot = fresh_slot ~name:name' ctx bty in
  (* [ctx.scope] keeps the *source* name: the suffix is a debug-info artifact
     and resolving [v] must still find the innermost binding. *)
  ctx.scope <- (name, { slot; bty; assignable }) :: ctx.scope;
  slot

let lookup ctx name = List.assoc_opt name ctx.scope

(* A handler clause is lifted into a function of its own, so the establishing
   function's locals are simply not there. Capturing them is a closure with an
   explicit environment — spec-memory.md's case 2, a non-escaping [fn] capturing
   by value into a stack environment, since a handler frame does not outlive the
   function that pushed it — and until that exists a reference to one is refused
   for the reason it is really refused for, rather than as a name nobody has
   heard of. *)
let captured ctx loc name =
  match ctx.outer_what with
  | Some what when List.mem_assoc name ctx.outer ->
    let why =
      if String.equal what "a handler" then
        "a handler runs from wherever the signal was. Use a global, or pass \
         it on the condition"
      else
        "an fn is lifted into a function of its own and is handed nothing but \
         its parameters. Pass it in, or use a global"
    in
    Loc.failk "check/capture" loc
      "%s cannot see %s: it is a local of the enclosing function, and %s."
      what name why
  | _ -> ()

let scoped ctx f =
  let saved = ctx.scope in
  let r = f () in
  ctx.scope <- saved;
  r

(* A scope that is also a named blocker for [defer]. An arm of an [if] or a
   [match] runs only sometimes, and "maybe registered" is not something a
   compile-time construct can express — the cleanup is copied into every exit
   path or into none — so the refusal is about the branch and says so.

   Outside the [check] recursion on purpose: inside it the inferred type would
   be monomorphic, and the two callers pass functions returning different
   things. *)
let branch ctx f =
  let blocker = ctx.defer_block in
  ctx.defer_block <- "a branch";
  let r = scoped ctx f in
  ctx.defer_block <- blocker;
  r

(* ── Type resolution ───────────────────────────────────────────────── *)

let unimplemented loc what milestone =
  fail loc "%s is not implemented yet — milestone %d (see plan.org)"
    what milestone

(* ── where predicates ──────────────────────────────────────────────────
   A predicate is a compile-time question about a type, and that is the whole
   of it. It carries no implementation, selects no instance, and is not
   extensible: it gates a builtin the compiler already has. So there are no
   dictionaries, no coherence rules and no run-time cost — and the ceiling is
   that nobody can supply a [<] of their own, which does not bind because
   every operation the prelude and the containers need is a primitive.

   Odin's [where] clause is the same shape ([core/slice/slice.odin:289] is
   [where intrinsics.type_is_ordered(T)]) with forty-one predicates against
   these four. There is no [copyable?] any more and no Odin counterpart
   either: Odin has no move semantics, and since the repeal neither does this
   language, so [$T] never has to answer the question. *)
let predicate_names = [ "ordered?"; "equal?"; "hashable?"; "numeric?" ]

(* ── What a type owns, transitively ────────────────────────────────────
   The one structural ownership question that survived the repeal, because it
   is not about copying at all.

   What it decides, and the only thing it decides, is whether a container of
   this element type has to be built against a region allocator — see
   [region_only] below and [flan_alloc_region_only] in the runtime. That is a
   question about *release*, so it is asked of every arm a release would have
   to reach and would not: a Vec or Map owns a block outright; an Option,
   a fixed array, a struct or a data type's case owns whatever its payload
   does.

   It does not live in [Types] for the reason [Types.keyable] gives: that
   module has no field table. The [seen] list is the cycle guard, and the cycle
   is real — the recursive dynamic value this exists for holds a [(Vec Value)],
   so [Value]'s walk reaches [Value]. Answering [false] for a name already on
   the path is right rather than merely terminating: whatever made the outer
   name own something was found by the arm that got here, and a name cannot
   contain itself by value anyway — [check_finite] refuses that — only through
   a container, which is an arm that answers for itself.

   [env.unions], the untagged ones, are deliberately not consulted: nothing
   anywhere records which member of one is live, so there is no fact this
   walk could read — an untagged union is treated as owning nothing, and what
   its members point at is the program's, through whatever tag it keeps
   beside the union. *)
let owning_fields env n =
  match Hashtbl.find_opt env.structs n with
  | Some s -> [ s.Tast.fields ]
  | None ->
    match Hashtbl.find_opt env.datas n with
    | Some d -> List.map (fun (c : Tast.variant) -> c.Tast.vfields) d.Tast.cases
    | None -> []

let rec owning env ?(seen = []) (t : Types.t) =
  match t with
  | Types.Vec _ | Types.Map _ -> true
  | Types.Option e | Types.Array (_, e) -> owning env ~seen e
  | Types.Named n ->
    not (List.mem n seen)
    && List.exists
         (List.exists
            (fun (f : Tast.field) -> owning env ~seen:(n :: seen) f.Tast.fty))
         (owning_fields env n)
  | _ -> false

(* Does a container of this type have to be built against an allocator that
   cannot free one block? Only the half a release would have to walk is asked:
   a map's key cannot own anything — [map_type] refuses one, because a key that
   owned storage would hash its header rather than what it points at — so the
   value is the whole of the question there. *)
let region_only env (t : Types.t) =
  match t with
  | Types.Vec e -> owning env e
  | Types.Map (_, v) -> owning env v
  | _ -> false

(* Does a concrete type answer yes? Checked at every instantiation, against
   the type the call site asked for. *)
let pred_holds p (t : Types.t) =
  match p with
  | "ordered?"  -> Types.is_comparable t
  | "equal?"    -> Types.is_equatable t
  (* [Types.keyable] says yes to a struct and leaves its fields to [key_pair],
     which walks them at the operation. That split is the existing one and is
     kept: a generic declared [hashable?] and instantiated at a struct whose
     fields are not keyable is refused where every other program is, by
     [key_pair]. *)
  | "hashable?" -> Types.keyable t
  | "numeric?"  -> Types.is_numeric t
  | _           -> false

(* What one declared predicate *also* gives you. These are entailments over
   the type system as it stands, not conveniences: every type [is_comparable]
   admits is a number or an enum, so it is equatable. The table is only sound
   while that is true — an ordered type with no [=] would make it wrong — so
   it lives in one place and says so. The gain is real ergonomics:
   [{:where (ordered? $t)}] is enough for a [sort] that also compares,
   rather than two predicates on one line. *)
let pred_entails ~declared ~wanted =
  String.equal declared wanted
  || match wanted, declared with
     | "ordered?",  "numeric?" -> true
     | "equal?",    ("numeric?" | "ordered?") -> true
     | _ -> false

let declares preds v wanted =
  List.exists
    (fun (p : Ast.pred) ->
       String.equal p.Ast.pvar v && pred_entails ~declared:p.Ast.pname ~wanted)
    preds

(* Which variable, if any, a type bottoms out at. Only a bare variable can
   carry a predicate: [(Vec t)] is a Vec whatever [t] is, and its own
   properties are the Vec's. *)
let tyvar_of (t : Types.t) = match t with Types.Var v -> Some v | _ -> None

(* ── (Map K V), spec-memory.md ──────────────────────────────────────────
   Both halves are checked where the type is written, not where an operation
   is, so that a map nothing ever uses is still refused if it cannot work.
   [Check.key_pair] emits the hash and equality pair later, at the operation,
   and repeats these refusals rather than assuming: the two are reached by
   different paths and a silent disagreement between them would be worse than
   saying the same thing twice. *)
let map_type ?(preds = []) loc (k : Types.t) (v : Types.t) =
  ignore preds;
  (* The value used to be refused here when it owned anything, in the same
     words [(Vec (Vec T))] used, and the refusal is gone for the reason set out
     over [map-new]: it was about *teardown*, and which tier this map will be
     built against is not knowable where its type is written. The question is
     asked at the construction instead, of the allocator, once. *)
  (* () has no bytes, so a slot for one is a slot of nothing: the cell
     geometry divides the cache line by the element size and there is nothing
     to divide by. It is also the natural spelling of a *set*, which is why
     someone will write it, so it is refused by name rather than by a crash. *)
  if Types.equal v Types.Unit then
    fail loc
      "a map value cannot be () — there is nothing to store. A set of keys \
       is not built yet; use (Map %s bool) and ignore the value"
      (Types.to_string k);
  if Types.equal k Types.Unit then
    fail loc "a map key cannot be () — every key would be the same key";
  (* The key, as far as the type alone can say. A struct passes here and is
     decided at the operation, by [key_pair], which walks its fields — the
     struct table is not necessarily complete while a type is being resolved,
     and every map that exists reaches an operation anyway, because a global
     map starts zeroed and a local needs (map-new). *)
  (* A type variable is a map key exactly when the [where] clause says it is
     hashable. Nothing else about it is knowable here, and falling through to
     [Types.keyable] would answer no for a variable that is about to be
     instantiated at [string]. *)
  if not (match k with
          | Types.Var v -> declares preds v "hashable?"
          | k -> Types.keyable k) then
    fail loc
      "%s is not a map key. The first implementation takes integers, enums, \
       bools, strings, fixed arrays of those, and value structs composed of \
       those (spec-memory.md, \"Maps — first implementation\"). A float has \
       no usable equality — NaN is not equal to itself — and a Ptr, a slice, \
       a Vec or a Map would hash an address rather than what it points at"
      (Types.to_string k);
  Types.Map (k, v)

(* The positions a function value may not be written in, and the one reason
   they are all the same position: something zeroes it.

   ZII is the language's rule — an omitted struct field, a fixed array's
   elements, a [defvar] with no initialiser are all all-bytes-zero — and a
   zeroed function value is a null pointer with a signature on it, which is the
   one kind of zero that cannot be used for anything. Every other type's zero
   is a value: 0, false, an empty slice, [None], a data type's first case. So these
   are refused where they are written rather than left to crash at the call.

   A parameter, a return type, a [let] binding and an [(Option (Fn ...))] are
   not on the list: none of them is ever conjured, and an [Option]'s zero is a
   [None] whose tag nobody may look past. *)
let rec no_zeroed_fn loc what (t : Types.t) =
  match t with
  | Types.Fn _ ->
    fail loc
      "%s cannot be %s: it would be zeroed, and a zeroed function value is \
       a null pointer — every other type's zero is a value it can have, and \
       this one is not. Pass it as a parameter, or hold it in a let"
      what (Types.to_string t)
  | Types.Array (_, e) -> no_zeroed_fn loc what e
  | _ -> ()

let rec resolve env ?(seen = []) (t : Ast.texpr) : Types.t =
  let loc = t.Ast.tloc in
  match t.Ast.t with
  | Ast.Tname n -> resolve_name env ~seen loc n
  | Ast.Tslice e -> Types.Slice (resolve env ~seen e)
  | Ast.Tarray (l, e) ->
    let e = resolve env ~seen e in
    no_zeroed_fn loc "a fixed array's element" e;
    Types.Array (array_len env loc l, e)
  (* {K V} is the type spelling. There is no map *literal*: a bare map form in
     expression position is a struct literal's field list, and giving the same
     braces two meanings is what the colon-to-dot change was for. A map is
     built with (map-new) and filled with (put). *)
  | Ast.Tmap (k, v) ->
    map_type ~preds:env.tvpreds loc (resolve env ~seen k)
      (resolve env ~seen v)
  (* (Fn [T ...] R): a function value, which is one code address and no
     environment beside it. There is no capture — [check_fn] refuses a
     reference to an enclosing local by name — so this is a pointer with a
     signature and nothing about it can dangle.

     Where one may be *written* is narrower than where the type resolves, and
     the two rules live apart on purpose: this is what the spelling means, and
     [no_zeroed_fn] is where a position that would zero one is refused. A
     parameter, a return type and a let binding are the positions that work. *)
  | Ast.Tfn (ps, r) ->
    Types.Fn (List.map (resolve env ~seen) ps, resolve env ~seen r)
  | Ast.Tapp (name, args) ->
    (match name, args with
     | "Ptr", [ a ] -> Types.Ptr (resolve env ~seen a)
     | "Option", [ a ] -> Types.Option (resolve env ~seen a)
     | ("Ptr" | "Option"), _ -> fail loc "(%s T) takes exactly one type" name
     | "Vec", [ a ] ->
       let e = resolve env ~seen a in
       (* A Vec of a Vec used to be refused here, and the refusal named two
          different failures under one sentence: that [clone] would duplicate
          inner headers instead of copying, and that [free] would drop their
          buffers on the floor. Only the second one was about *teardown*, and
          only the second one an arena answers — [free-all] takes the region
          and the inner blocks with it, because they came out of the same
          region. So the type is admitted, the tier is checked at the
          construction where the allocator is a value that exists (see
          [vec-new]), and [clone] stays refused at the operation, on its own
          merits, in its own words.

          It cannot be refused *here* because nothing here knows the tier:
          [with-allocator] rebinds a dynamic variable, so which allocator a
          [(vec-new)] meets is not a property of where the type is written. *)
       Types.Vec e
     | "Vec", _ -> fail loc "(Vec T) takes exactly one type"
     | "Map", [ k; v ] ->
       map_type ~preds:env.tvpreds loc (resolve env ~seen k)
         (resolve env ~seen v)
     | "Map", _ -> fail loc "(Map K V) takes exactly two types"
     | "Result", _ -> unimplemented loc "(Result T E)" 6
     | _ ->
       fail loc
         "%s takes no type arguments — generics are milestone 5" name)

(* One edit away from a type that exists — a substitution, an insertion, a
   deletion or a transposition of neighbours. Bounded at one, because two edits
   is no longer a typo, it is a guess. *)
and near_miss env n =
  let one_edit a b =
    let la = String.length a and lb = String.length b in
    if abs (la - lb) > 1 then false
    else begin
      (* Walk both until they diverge, then require the tails to match with the
         single edit applied. *)
      let i = ref 0 in
      while !i < la && !i < lb && a.[!i] = b.[!i] do incr i done;
      let ta s k = String.sub s k (String.length s - k) in
      if la = lb then
        !i < la
        && (ta a (!i + 1) = ta b (!i + 1)
            (* stirng/string: two neighbours swapped. *)
            || (!i + 1 < la && a.[!i] = b.[!i + 1] && a.[!i + 1] = b.[!i]
                && ta a (!i + 2) = ta b (!i + 2)))
      else if la < lb then ta a !i = ta b (!i + 1)
      else ta a (!i + 1) = ta b !i
    end
  in
  let candidates =
    Types.primitive_names
    @ Hashtbl.fold (fun k _ acc -> k :: acc) env.aliases []
    @ Hashtbl.fold (fun k _ acc -> k :: acc) env.structs []
    @ Hashtbl.fold (fun k _ acc -> k :: acc) env.datas []
    @ Hashtbl.fold (fun k _ acc -> k :: acc) env.unions []
    @ Hashtbl.fold (fun k _ acc -> k :: acc) env.enums []
  in
  List.find_opt (fun c -> c <> n && one_edit n c) candidates

and resolve_name env ~seen loc n =
  (* ── Type variables, with a sigil at the binding site ─────────────────
     [$t] *introduces* a variable and bare [t] uses it, which is Odin's
     spelling ([$T] in the signature, [T] in the body). The sigil is read as
     an ordinary symbol character, so the whole decision lives here: nothing
     in the reader, the parser or the AST knows the character means anything.

     Which names are variables is decided before this is ever called —
     [signature_tyvars] scans the signature for the sigil and puts the bare
     names in [env.tyvars] — so an unknown lowercase name is still the
     unknown-type error it always was. That is the point of the sigil: without
     one, a mistyped type name silently became a type parameter and made the
     function more permissive than it was written to be. *)
  let bare = if n <> "" && n.[0] = '$' then String.sub n 1 (String.length n - 1) else n in
  match List.assoc_opt bare env.subst with
  (* Inside an instantiation: the variable is this concrete type, and every
     node checked under it is as concrete as if it had been written out. *)
  | Some t -> t
  | None ->
  if List.mem bare env.tyvars then Types.Var bare
  else if n <> bare then
    (* A sigil somewhere that is not a [defn] signature: a struct field, a
       global, a [let] annotation. There is nowhere for it to bind, so it is
       the error rather than a variable with no scope. *)
    Loc.failk "check/unbound-type-variable" loc
      "%s introduces a type variable, and only a defn signature can — write \
       the concrete type here" n
  else
  match Types.ikind_of_name n with
  | Some k -> Types.Int k
  | None ->
    match Types.fkind_of_name n with
    | Some k -> Types.Float k
    | None ->
      match n with
      | "bool" -> Types.Bool
      | "string" -> Types.String
      (* Lowercase and concrete, which the rule three screens down says is a
         type variable. It is spelled this way because it is a primitive and
         every other primitive is lowercase — [dyn] beside [i64] and [bool]
         reads as one of them, [Dyn] beside [Vec] and [Option] reads as a
         container over something. The type-variable rule is reached by a
         [when] guard below and this arm is before it, so the spelling costs
         nothing but the note. *)
      | "dyn" -> Types.Dyn
      | "Unit" -> Types.Unit
      | "Never" -> Types.Never
      (* A builtin opaque type, the way [string] is a builtin ptr+len. There is
         no user-writable constructor and no way to name its procedure: see
         Types, and NEXT.md's "the escape is real". *)
      | "Allocator" -> Types.Alloc
      | _ when Hashtbl.mem env.aliases n ->
        if List.mem n seen then
          fail loc "the type alias %s is defined in terms of itself" n
        else resolve env ~seen:(n :: seen) (Hashtbl.find env.aliases n)
      | _ when Hashtbl.mem env.structs n -> Types.Named n
      (* A data type is [Named] exactly as a struct is: one case in [Types.t]
         covers both, and which table the name is in is what tells them apart.
         Keeping them one case is what lets a data type be a field, a parameter, a
         return type and a slot without a single one of those paths learning
         that data types exist. *)
      | _ when Hashtbl.mem env.datas n -> Types.Named n
      (* And so is an untagged union, for the same reason: it is a value of a
         size and an alignment, and nothing that carries one has to know it is
         a union rather than a struct. *)
      | _ when Hashtbl.mem env.unions n -> Types.Named n
      | _ when Hashtbl.mem env.enums n -> Types.Enum n
      (* A typo in a primitive is lowercase too, and the type-variable rule
         below would otherwise report [f65] as unimplemented generics and send
         you to plan.org instead of to the character you mistyped. *)
      | _ when near_miss env n <> None ->
        Loc.failk "check/unknown-type" loc "unknown type %s — did you mean %s?" n
          (Option.get (near_miss env n))
      (* Lowercase is a type variable, Capitalized is concrete — no sigil
         (plan.org, Types). A variable parses, but nothing at milestone 2 can
         give a value one, so it is rejected here rather than later. *)
      | _ when n <> "" && n.[0] = Char.lowercase_ascii n.[0] ->
        unimplemented loc
          (Printf.sprintf "generic code over the type variable %s" n) 5
      | _ -> Loc.failk "check/unknown-type" loc "unknown type %s" n

and array_len env loc = function
  | Ast.Lint n -> n
  | Ast.Lname n ->
    (match Hashtbl.find_opt env.consts n with
     | Some v -> v
     | None ->
       fail loc "%s is not a compile-time integer constant, so it cannot be \
                 an array length" n)

(* ── Pairing a defn's parameter vector ──────────────────────────────────

   [(defn f [x y] ...)] is one parameter [x] of type [y] if [y] names a type,
   and two parameters of type [dyn] if it does not. Parse could not tell — the
   long argument is beside its [defn] case — so it handed over the slots
   undecided and this is where they are paired, with every type name in hand:
   every file loaded, every macro expanded, every C header imported.

   The walk is left to right and takes two slots or one. A name followed by
   something that is a type takes two and is annotated; a name followed by
   another name that is not a type, or by nothing, takes one and is [dyn]. That
   is the whole rule, and it reads the way the vector reads.

   A name that *is* a type name is refused rather than paired. [(defn f [i64 x]
   ...)] has no good reading: taken as written it is a parameter called [i64],
   which shadows nothing but confuses everything, and the likelier intent is a
   pair written backwards. Refusing here costs a rename in the one program that
   meant it and closes the one place where this rule could still hand somebody
   a signature they did not write. *)
let is_type_name env n =
  Types.ikind_of_name n <> None
  || Types.fkind_of_name n <> None
  || List.mem n [ "bool"; "string"; "dyn"; "Unit"; "Never"; "Allocator" ]
  || Hashtbl.mem env.aliases n
  || Hashtbl.mem env.structs n
  || Hashtbl.mem env.datas n
  || Hashtbl.mem env.unions n
  || Hashtbl.mem env.enums n
  (* A type variable: [$t] in a signature is generics' binding site, and a
     slot holding one is a type however few of them there are. *)
  || (n <> "" && n.[0] = '$')

(* Before a bare symbol is allowed to become an unannotated parameter, the two
   ways it is more likely to be a type that went wrong.

   This is the cost dynamic-by-default puts on the parameter vector, and it is
   worth naming plainly: a slot with no type used to be a syntax error, and now
   it is a [dyn] parameter. So [(defn f [x f65] ())] — a typo for [f64] — no
   longer reads as a mistyped type. It reads as two parameters, one of them
   called [f65], and the function silently takes an argument nobody meant to
   give it. An arity that changes because of a typo, with no diagnostic, is the
   failure class Parse's [defn] comment calls the worst available, and the
   feature reintroduces it in a new place.

   Two rules take most of it back. A name within one edit of a type's name is
   the typo it looks like, and is refused with the same "did you mean" the
   resolver gives — the near-miss table is already there and is exactly the
   right question. And a capitalised name is a type by the convention the whole
   corpus keeps: not one parameter in the language is capitalised, while [Form],
   [Cursor], [Vector2] and the rest appear in these vectors constantly. So an
   unknown capitalised name is an unknown *type*, reported as one, rather than
   a parameter nobody would have spelled that way.

   What is left uncovered is a lowercase name that resembles no type: [(defn f
   [x widget] ())] is two dyn parameters and there is no evidence in the text
   that it was meant to be one. That case is the feature working as specified,
   and it is the residual the parent owns. *)
let dyn_param_or_typo env n loc =
  match near_miss env n with
  | Some m ->
    Loc.failk "check/unknown-type" loc
      "unknown type %s — did you mean %s? A parameter with no type is dyn, so \
       this would otherwise be read as a second parameter called %s"
      n m n
  | None ->
    if n <> "" && n.[0] = Char.uppercase_ascii n.[0]
       && n.[0] <> Char.lowercase_ascii n.[0]
    then
      Loc.failk "check/unknown-type" loc
        "unknown type %s. A capitalised name in a parameter vector is a type — \
         a parameter with no type is dyn, and parameters are lowercase"
        n

let pair_params env (items : Ast.pitem list) : Ast.field list =
  let dyn loc = { Ast.t = Ast.Tname "dyn"; tloc = loc } in
  let rec go = function
    | [] -> []
    | Ast.Ptype t :: _ ->
      Loc.failk "check/parameter-name-expected" t.Ast.tloc
        "a parameter's name was expected here, and this is a type. \
         Parameters are [name Type ...], and a name with no type is dyn"
    | Ast.Pname (n, loc) :: rest when is_type_name env n ->
      ignore rest;
      Loc.failk "check/parameter-named-type" loc
        "%s names a type, so it cannot also be this parameter's name. If the \
         pair was written backwards it is [name %s]; otherwise rename the \
         parameter" n n
    | Ast.Pname (n, loc) :: Ast.Ptype t :: rest ->
      { Ast.fname = n; fty = t; floc = loc } :: go rest
    | Ast.Pname (n, loc) :: Ast.Pname (t, tloc) :: rest when is_type_name env t ->
      { Ast.fname = n; fty = { Ast.t = Ast.Tname t; tloc }; floc = loc } :: go rest
    (* The slot after this one is not a type, so this one is a parameter with
       no type written — unless the slot after it only *looks* unlike a type
       because it was mistyped, which is what the check is for. The next slot
       is the one interrogated, not this one: this one is a name either way. *)
    | Ast.Pname (n, loc) :: (Ast.Pname (t, tloc) :: _ as rest) ->
      dyn_param_or_typo env t tloc;
      { Ast.fname = n; fty = dyn loc; floc = loc } :: go rest
    | Ast.Pname (n, loc) :: rest ->
      { Ast.fname = n; fty = dyn loc; floc = loc } :: go rest
  in
  go items

(* Every [defn] in the program, with its parameter vector paired. Run as a pass
   of its own, after the type names are registered and before any signature is
   resolved, so that nothing downstream ever sees an unpaired one. *)
let pair_decls env (decls : Ast.decl list) : Ast.decl list =
  let fn (f : Ast.fn) =
    match f.Ast.praw with
    | None -> f
    | Some items -> { f with Ast.params = pair_params env items; praw = None }
  in
  List.map
    (fun (d : Ast.decl) ->
       match d.Ast.d with
       | Ast.Defn f -> { d with Ast.d = Ast.Defn (fn f) }
       | Ast.Declare (f, c) -> { d with Ast.d = Ast.Declare (fn f, c) }
       | Ast.DeclareC (f, c) -> { d with Ast.d = Ast.DeclareC (fn f, c) }
       | _ -> d)
    decls

(* ── Generics: the four operations monomorphisation needs ───────────────
   Naming a variable, binding one from an argument, substituting the binding
   back in, and spelling the result as a symbol. Everything else about the
   feature is where these are called from. *)

(* The variables a signature introduces: every [$t] written in it, in the
   order written, once each. Only a [defn] signature is scanned, which is what
   makes the binding site a *place* and not merely a spelling. *)
let signature_tyvars (fn : Ast.fn) =
  let acc = ref [] in
  let name loc n =
    if n <> "" && n.[0] = '$' then begin
      let bare = String.sub n 1 (String.length n - 1) in
      if bare = "" then fail loc "$ on its own does not name a type variable";
      (* [$i32] would shadow a machine type inside the body and read as one
         everywhere else. There is no reason to want it. *)
      if List.mem bare Types.primitive_names
         || Types.ikind_of_name bare <> None
         || Types.fkind_of_name bare <> None then
        fail loc "%s is a type, so $%s cannot be a type variable" bare bare;
      if not (List.mem bare !acc) then acc := bare :: !acc
    end
  in
  let rec ty (t : Ast.texpr) =
    match t.Ast.t with
    | Ast.Tname n -> name t.Ast.tloc n
    | Ast.Tslice e -> ty e
    | Ast.Tarray (_, e) -> ty e
    | Ast.Tmap (k, v) -> ty k; ty v
    (* The head of an application is a constructor — [Ptr], [Option], [Vec] —
       and a variable cannot stand there: this spike is generic over types,
       not over type constructors. A [$t] inside the arguments is ordinary. *)
    | Ast.Tapp (_, args) -> List.iter ty args
    | Ast.Tfn (ps, r) -> List.iter ty ps; ty r
  in
  List.iter (fun (p : Ast.field) -> ty p.Ast.fty) fn.Ast.params;
  (match fn.Ast.ret with Some r -> ty r | None -> ());
  List.rev !acc

(* Bind the variables in a parameter's written type from the type an argument
   turned out to have. Odin's [is_polymorphic_type_assignable], structurally
   and with the same rule: a variable already bound must match what it is
   bound to, so [(pair 1 2.0)] over [a $t b $t] is a refusal and not a
   second instantiation. *)
let rec bind_ty subst (pat : Types.t) (arg : Types.t) =
  match pat, arg with
  | Types.Var v, a ->
    (match List.assoc_opt v !subst with
     | None -> subst := (v, a) :: !subst; true
     | Some b -> Types.equal a b)
  | Types.Slice p, Types.Slice a
  | Types.Ptr p, Types.Ptr a
  | Types.Vec p, Types.Vec a
  | Types.Option p, Types.Option a -> bind_ty subst p a
  | Types.Array (n, p), Types.Array (m, a) -> Int64.equal n m && bind_ty subst p a
  | Types.Map (k, v), Types.Map (k', v') ->
    bind_ty subst k k' && bind_ty subst v v'
  | Types.Fn (ps, r), Types.Fn (ps', r') ->
    List.length ps = List.length ps'
    && List.for_all2 (bind_ty subst) ps ps' && bind_ty subst r r'
  (* Nothing generic left on the pattern side: this is ordinary type
     equality, and [Never] fits anywhere exactly as it does elsewhere. *)
  | p, a -> Types.fits ~expected:p ~actual:a

let rec subst_ty subst (t : Types.t) =
  match t with
  | Types.Var v -> (match List.assoc_opt v subst with Some c -> c | None -> t)
  | Types.Slice e -> Types.Slice (subst_ty subst e)
  | Types.Array (n, e) -> Types.Array (n, subst_ty subst e)
  | Types.Map (k, v) -> Types.Map (subst_ty subst k, subst_ty subst v)
  | Types.Ptr e -> Types.Ptr (subst_ty subst e)
  | Types.Vec e -> Types.Vec (subst_ty subst e)
  | Types.Option e -> Types.Option (subst_ty subst e)
  | Types.Fn (ps, r) -> Types.Fn (List.map (subst_ty subst) ps, subst_ty subst r)
  | t -> t

(* Does this resolved type still mention a variable? *)
let rec generic_ty (t : Types.t) =
  match t with
  | Types.Var _ -> true
  | Types.Slice e | Types.Array (_, e) | Types.Ptr e | Types.Vec e
  | Types.Option e -> generic_ty e
  | Types.Map (k, v) -> generic_ty k || generic_ty v
  | Types.Fn (ps, r) -> List.exists generic_ty ps || generic_ty r
  | _ -> false

(* The refusal plan.org's Types section asks for, in one place so that every
   operator says the same thing: with no constraints a type variable supports
   only what *every* type supports, so [=], [<], [+] and [hash] over one are
   rejected rather than silently instantiated at whatever type the first call
   site happened to use.

   With [where] there are now two ways out and the message names both: declare
   the predicate, or take the operation as a function value the way
   [sort-by] does. Declaring it is the one that keeps the call site short,
   which is the whole reason predicates exist — under the no-constraint rule
   [(sort xs)] had to become [(sort-by xs (fn [a b] (< a b)))] at every call
   site in the corpus. *)
let unconstrained env loc op ~needs (t : Types.t) =
  if generic_ty t then
    match tyvar_of t with
    | Some v when declares env.tvpreds v needs -> ()
    | _ ->
      Loc.failk "check/unconstrained-type-variable" loc
        "%s over the type variable %s is refused: a type variable supports \
         only what it is declared to support, and nothing here says %s is \
         %s. Write {:where (%s $%s)} at the head of the body, or take the \
         operation as a parameter — a (Fn [%s %s] ...) — and call it here"
        op (Types.to_string t) (Types.to_string t) needs needs
        (Types.to_string t) (Types.to_string t) (Types.to_string t)


(* How a concrete type is spelled inside an instantiation's name. The prelude
   already writes this by hand — [filter-i32], [sum-f32], [append-i64] — so a
   generated name reads like the handwritten one it replaces, which is what a
   backtrace, a [Reach] edge and a dev-build cell all end up showing.
   [Types.to_string] cannot serve: [[i32]] and [(Vec i32)] are not symbols. *)
let rec mangle_ty (t : Types.t) =
  match t with
  | Types.Unit -> "unit"
  | Types.Slice e -> "slice-" ^ mangle_ty e
  | Types.Array (n, e) -> Printf.sprintf "arr%Ld-%s" n (mangle_ty e)
  | Types.Map (k, v) -> Printf.sprintf "map-%s-%s" (mangle_ty k) (mangle_ty v)
  | Types.Ptr e -> "ptr-" ^ mangle_ty e
  | Types.Vec e -> "vec-" ^ mangle_ty e
  | Types.Option e -> "opt-" ^ mangle_ty e
  | Types.Fn (ps, r) ->
    Printf.sprintf "fn-%s-to-%s"
      (String.concat "-" (List.map mangle_ty ps)) (mangle_ty r)
  | t -> Types.to_string t

(* ── The runaway instantiation, refused by name rather than by depth ────
   [(defn grow [x $t] () (grow [x x]))] asks for a copy at [[t]], which asks
   for one at [[[t]]], forever. Before this the checker did not fail, it
   *hung*, and [Session.eval] runs the same code — so what hung was [C-c C-c],
   with the dev daemon wedged behind it and nothing to show the editor. That
   is the project's stated priority stopped by three lines of ordinary-looking
   Flan, which is why this is a refusal and not a cap.

   The spike stopped it with a depth counter refusing past 32. A number is the
   wrong thing to say: 32 is not in the program, the programmer cannot act on
   it, and a legitimate deep instantiation and a runaway one look identical in
   the message. **The structural test is exact.** A generic that is already on
   the chain and is being asked for again at a type that *contains* the type
   it was asked for before is growing, and growing without a smaller case is
   not going to stop. A generic that recurses at the *same* types never
   reaches here — the cache entry goes in before the body is checked — and one
   that recurses at a *smaller* or unrelated type is fine and stays fine.

   The message prints the chain, which is what the programmer can act on: each
   link is a call site and a type, and the place the type started growing is
   visible in the list.

   Odin has no cap of its own to copy, so there was nothing to borrow and this
   is the whole design. The depth backstop below stays as a backstop only: it
   catches a growth this test does not recognise, and it is never the thing
   the message is about. *)
let rec occurs_in ~needle (t : Types.t) =
  Types.equal needle t
  ||
  match t with
  | Types.Slice e | Types.Array (_, e) | Types.Ptr e | Types.Vec e
  | Types.Option e -> occurs_in ~needle e
  | Types.Map (k, v) -> occurs_in ~needle k || occurs_in ~needle v
  | Types.Fn (ps, r) ->
    List.exists (occurs_in ~needle) ps || occurs_in ~needle r
  | _ -> false

(* [b] is [a] with something built around it: same shape, strictly bigger. *)
let grows ~from_:a ~to_:b =
  List.length a = List.length b
  && List.for_all2 (fun x y -> occurs_in ~needle:x y) a b
  && not (List.for_all2 Types.equal a b)

let runaway env loc gname cparams =
  let chain_text () =
    String.concat "\n  "
      (List.map
         (fun (g, ps, l) ->
            Printf.sprintf "%s at (%s), asked for at %s" g
              (String.concat " " (List.map Types.to_string ps))
              (Loc.to_string l))
         (env.chain @ [ (gname, cparams, loc) ]))
  in
  let earlier =
    List.find_opt
      (fun (g, ps, _) -> String.equal g gname && grows ~from_:ps ~to_:cparams)
      env.chain
  in
  (match earlier with
   | Some _ ->
     Loc.failk "check/runaway-instantiation" loc
       "%s instantiates itself without end. Each copy asks for another at a \
        type built around the one before, so there is no last copy to \
        generate:\n  %s\nA generic function may call itself, but not at a \
        type built out of its own type variable — the argument has to get \
        smaller, or stay the same"
       gname (chain_text ())
   | None -> ());
  (* The backstop. Nothing known reaches it; it exists so that a growth the
     test above does not recognise is still a refusal with the chain in it
     rather than a hang. *)
  if List.length env.chain >= 64 then
    Loc.failk "check/runaway-instantiation" loc
      "%s has been instantiated 64 deep and is still going:\n  %s"
      gname (chain_text ())

(* [check_fn] is defined after the expression checker and an instantiation is
   made from inside it, so the knot is tied here and closed at the bottom of
   the file. One forward reference rather than moving a 90-line function. *)
let check_fn_ref : (env -> Ast.fn -> Tast.fn) ref =
  ref (fun _ _ -> assert false)

(* ── Small helpers over the AST ────────────────────────────────────── *)

(* Untyped literals: their machine type comes from context, so when one is an
   operand of a binary operator we look at the *other* operand first. *)
let is_literal (e : Ast.expr) =
  match e.Ast.e with Ast.Int _ | Ast.Float _ | Ast.Byte _ -> true | _ -> false

(* [addr] takes the address of a place, but the parser only builds places for
   [set]. Recover one from the expression it parsed instead. *)
let place_of_expr (e : Ast.expr) : Ast.place option =
  match e.Ast.e with
  | Ast.Var s -> Some (Ast.Pvar s)
  | Ast.Field (t, f) -> Some (Ast.Pfield (t, f))
  | Ast.Call ({ Ast.e = Ast.Var "at"; _ }, t :: idx) when idx <> [] ->
    Some (Ast.Pindex (t, idx))
  | Ast.Call ({ Ast.e = Ast.Var "deref"; _ }, [ p ]) -> Some (Ast.Pderef p)
  | _ -> None

let mk loc ty e : Tast.expr = { Tast.e; ty; loc }

let unit_at loc = mk loc Types.Unit Tast.Unit

(* A source location as a value, for a runtime trap that has to name the site
   rather than the runtime. The bounds and slice traps get theirs from [Emit],
   which renders the [Loc.t] it is already carrying; a trap reached through a
   plain runtime call has no such carrier, so the string is built here and
   crosses as ptr+len like any other. *)
let here loc = mk loc Types.String (Tast.Str (Loc.to_string loc))

(* A runtime call, with the result type spelled at the site. *)
let rt loc ty sym args = mk loc ty (Tast.Prim (Tast.Rt sym, args))

(* ── The allocation registry's note, NEXT.md ───────────────────────────

   One after every operation that may have allocated — which is *here*, and
   nowhere else, because here is the only place the concrete type is known. A
   Flan struct is exactly its C layout with no header and no tag word, so
   nothing at run time can say what is at an address; the allocator's caller
   knew, and this is the caller writing it down.

   The type is spelled with [Types.to_string], the same spelling a slot
   fingerprint and a DWARF node already key on, so a name that appears in a
   registry answer is a name the programmer wrote.

   It is built unconditionally and dropped by the backend in a release build
   (see [Emit]'s [Rt] arm). The checker does not know which kind of build this
   is and must not learn: a note that existed only in a dev build would make
   the two builds different *trees*, and every pass between here and the
   backend would have to agree about which one it was looking at.

   [target] is the container, passed by address like every other container
   operation; the extent comes off its header in the runtime, because the
   header is the only thing that knows where the storage landed. *)
let reg_note loc sym (target : Tast.expr) sizes ty =
  rt loc Types.Unit sym
    ((target :: sizes) @ [ mk loc Types.String (Tast.Str (Types.to_string ty)) ])

(* [(do attempt note)] — the note runs only once the guard's retry loop has
   stopped, so it describes the storage the program ended up with rather than
   one of the attempts that failed. *)
let with_note loc (guarded : Tast.expr) (note : Tast.expr) =
  mk loc Types.Unit (Tast.Do [ guarded; note ])

(* ── Reading a file at compile time, decision 1 ────────────────────────
   The path is a *literal*, because the bytes have to be in hand before any
   value exists — this is Odin's rule too (check_load_directive rejects
   anything that is not Addressing_Constant) and it is what makes the result
   cost nothing at run time.

   It resolves relative to the directory of the file the form is written in,
   which is again Odin's rule (dir_from_path of the call's file). Relative to
   the compiler's working directory would make a package's assets depend on
   where flan was invoked from, which is the thing that cannot be right. An
   absolute path is taken as written. *)
let embed_path loc (p : Ast.expr) =
  match p.Ast.e with
  | Ast.Str "" -> Loc.fail p.Ast.loc "an embedded path cannot be empty"
  | Ast.Str s when Filename.is_relative s ->
    let base = Filename.dirname loc.Loc.file in
    if String.equal base "" then s else Filename.concat base s
  | Ast.Str s -> s
  | _ ->
    Loc.fail p.Ast.loc
      "an embedded path must be a literal string — the bytes are read at \
       compile time, so there is nothing here to compute it from"

(* The whole read is guarded, not only the open. On Linux [open_in_bin] on a
   *directory* succeeds and [in_channel_length] answers a number; the read is
   where EISDIR arrives. Guarding only the open therefore turned (embed "dir")
   — someone who meant embed-dir — into an uncaught OCaml exception out of the
   checker, which is the one way a user can make the compiler crash rather than
   refuse. *)
let read_embed_file path loc =
  match
    let ch = open_in_bin path in
    Fun.protect ~finally:(fun () -> close_in_noerr ch)
      (fun () -> really_input_string ch (in_channel_length ch))
  with
  | s -> s
  | exception Sys_error msg ->
    if Sys.file_exists path && (try Sys.is_directory path with Sys_error _ -> false)
    then
      Loc.fail loc
        "cannot embed %s: it is a directory — (embed-dir \"...\") embeds one \
         of those, as a [n EmbedFile]"
        path
    else Loc.fail loc "cannot embed %s: %s" path msg
  | exception End_of_file ->
    Loc.fail loc "cannot embed %s: it changed size while being read" path

(* Non-recursive, files only, sorted by name — the three things Odin's
   #load_directory settles, and the sort is the one that matters most here:
   readdir order is filesystem-dependent, so an unsorted embed would make the
   emitted .ll differ between two builds of identical sources. *)
let read_embed_dir path loc =
  let names =
    match Sys.readdir path with
    | exception Sys_error msg -> Loc.fail loc "cannot embed %s: %s" path msg
    | a -> Array.to_list a
  in
  (* [Sys.is_directory] *raises* on a path that does not resolve, so the
     existence test has to come first: a dangling symlink in an embedded
     directory would otherwise crash the compiler before it was ever asked
     about. Non-recursive and files only, which is Odin's rule too. *)
  let files =
    List.filter
      (fun n ->
         let full = Filename.concat path n in
         Sys.file_exists full
         && not (try Sys.is_directory full with Sys_error _ -> true))
      names
  in
  List.map
    (fun n -> (n, read_embed_file (Filename.concat path n) loc))
    (List.sort String.compare files)

let i64_at loc n = mk loc (Types.Int Types.I64) (Tast.Int (n, Types.I64))

(* spec-memory.md, "Alignment": the number is produced where the concrete
   element type is known, which without generics is simply the call site. *)
let size_of loc t = mk loc (Types.Int Types.I64) (Tast.Prim (Tast.SizeOf t, []))
let align_of loc t = mk loc (Types.Int Types.I64) (Tast.Prim (Tast.AlignOf t, []))

(* The address of an expression, place or not: the type-erased runtime takes
   the element [push] copies by pointer. *)
let addr_of loc (e : Tast.expr) =
  mk loc (Types.Ptr e.Tast.ty) (Tast.Prim (Tast.AddrOf, [ e ]))

(* ── Where a rendered number's bytes live ──────────────────────────────

   The three number-to-text conversions used to answer a slice into one static
   buffer in the runtime, shared by every call in the process, and nothing
   copied it: (print a) (print b) over two of them printed the second number
   twice. No crash and nothing for a sanitizer to find, because the read was
   inside a buffer that was perfectly alive — the wrong bytes, alive.

   The buffer is now the caller's, one frame slot per call site, and it is
   allocated here rather than in either backend on purpose: a slot is a
   function-lifetime frame location in both of them — an entry-block alloca in
   [Emit], a prologue-allocated offset in [X86] — where a backend temporary in
   [X86] is bump-allocated and reclaimed at the end of the expression that made
   it, which is exactly the lifetime a returned slice must outlive. Doing it
   once here also keeps the two backends symmetric by construction: each gains
   one pointer argument and no lifetime reasoning of its own.

   64 bytes is agreed with flan_rt.c's FLAN_NUM_BYTES, which clamps the length
   it publishes to it. The zeroing the [Let] does is one 64-byte clear beside
   an snprintf. *)
let num_bytes = 64L

let to_bytes ctx loc pr (x : Tast.expr) =
  let bty = Types.Array (num_bytes, Types.Int Types.U8) in
  let bslice = Types.Slice (Types.Int Types.U8) in
  let s = fresh_slot ctx bty in
  mk loc bslice
    (Tast.Let
       ([ (s, mk loc bty (Tast.Zero bty)) ],
        [ mk loc bslice
            (Tast.Prim (pr, [ x; addr_of loc (mk loc bty (Tast.Local s)) ])) ]))

(* ── The region requirement, emitted ───────────────────────────────────
   spec-memory.md's arena rule, and the whole of what replaced the three
   refusals a container of owning elements used to meet at its *type*. The
   question those refusals asked was about teardown: the type-erased runtime
   copies and releases slots bytewise, so a [free] would release the slots and
   leave everything inside them stranded. A region never releases a slot —
   [free-all] takes the whole thing, inner blocks included, because they came
   out of the same region — so the premise does not hold there and the refusal
   was over-broad.

   What could not move with it is *where* the question is asked. [can-free] is
   a capability on an allocator value, read at run time, and [with-allocator]
   rebinds a dynamic variable, so the tier a [(vec-new)] will meet is not a
   property of the place its type is written. The compile-time half is
   therefore only the decision to ask — [region_only], a property of the
   element type and settled here — and the run-time half is the answer.

   One branch per container and never per element, which spec-memory.md fixes
   and which is a performance decision before it is a safety one: the
   alternative is a walk at release, and a walk at release is the registry of
   destructors the frame tier's reset exists to not have.

   Emitted at every site that can *allocate* for such a container, not only at
   its construction, and the extra sites are not belt and braces. ZII means a
   container can exist without ever passing through [vec-new]: a data type
   case's field left out of a literal, a [(defvar xs (Vec Value))] a global
   starts as. Those are zeroed, they have no allocator at all, and the first
   [push] is what adopts the context — so a guard only at the construction
   would have a hole exactly the width of ZII.

   The *container* is what is asked in both places, and at a construction that
   means the guard runs immediately after the init rather than before it. The
   allocator is right there as an argument of the site, but naming it twice in
   the emitted tree is not free: it is an arbitrary expression, and [(vec-new
   Value (arena-new 4096))] would build two arenas and guard the one it threw
   away. The container has recorded it by the time the init returns, so asking
   the container asks that one expression exactly once. It is still the point
   of construction and still before anything is put in; what a trap there costs
   is the empty block just taken, on a process that is about to die.

   At a growth the guard runs first, because there the container already exists
   and the allocation is what has to be stopped. A zeroed one answers from the
   context it is about to adopt, which is not a guess — [flan_vec_adopt] is the
   code that will take it, on this same call. *)
let region_sym (t : Types.t) =
  match t with
  | Types.Vec _ -> "flan_vec_region_only"
  | Types.Map _ -> "flan_map_region_only"
  | _ -> assert false

let region_check env loc (target : Tast.expr) (after : Tast.expr) =
  if not (region_only env target.Tast.ty) then after
  else
    mk loc after.Tast.ty
      (Tast.Do
         [ rt loc Types.Unit (region_sym target.Tast.ty) [ target; here loc ];
           after ])

(* Every integer index into an array or slice is i32 at milestone 2. *)
let index_ty = Types.Int Types.I32

(* A condition's type at run time is a number, and it has to be the *same*
   number in a module compiled later against a program already running. So it
   is a hash of the name and not an index into anything: an index would shift
   the moment a struct were added, and every handler pushed by the old code
   would then match the wrong type. FNV-1a over the name, 32 bits. *)
let type_id name =
  let h = ref 0x811c9dc5 in
  String.iter
    (fun c ->
       h := (!h lxor Char.code c) land 0xffffffff;
       h := (!h * 0x01000193) land 0xffffffff)
    name;
  !h

(* How a restart's parameter list is spelled, and with it what the two ends of
   an [invoke-restart] compare — spec-conditions.md §3's run-time check. A
   restart is found by name on a dynamic stack, so neither end can see the
   other and nothing static can be checked: what is compared at run time is
   this string's hash, alongside the count, and the string itself is carried so
   that a mismatch can say what was wanted and what was given.

   Comparing a 32-bit hash means two different parameter lists could in
   principle collide. The count is checked separately, which rules out every
   practical case (a collision would have to be between two lists of the same
   length), and the types are parenthesised so that [(Option i32)] cannot read
   as two parameters. *)
let restart_sig tys =
  "(" ^ String.concat " " (List.map Types.to_string tys) ^ ")"

let expect loc ~want (got : Tast.expr) =
  match want with
  | None -> got
  | Some w ->
    if Types.fits ~expected:w ~actual:got.Tast.ty then got
    else
      fail loc "expected %s, found %s" (Types.to_string w)
        (Types.to_string got.Tast.ty)

(* Something a [break] may not jump out of, named so the refusal can say which.
   See [lentry]: it is a barrier and not a blanket refusal, so a loop written
   wholly inside one keeps its own perfectly good local break. Outside the
   recursive group below because its callers hand it bodies of two shapes — one
   expression and a list of them — and inside it would be monomorphic. *)
let barrier ctx what f =
  let loops = ctx.loops in
  ctx.loops <- Lbarrier what :: loops;
  let r = f () in
  ctx.loops <- loops;
  r

(* ── Expressions ───────────────────────────────────────────────────── *)

(* ── (Map K V): the key's hash and equality pair ────────────────────────
   spec-memory.md restricts the first implementation to built-in structural
   key types — integers, enums, strings, fixed arrays, and value structs
   composed recursively from those — and makes equality and hashing for them
   compiler-provided structural operations rather than type classes. So there
   is no dispatch to design: every key type resolves, here, to a pair of
   symbols, and the pair is passed to the type-erased runtime the way Odin
   hangs its two contextless procs off a Map_Info.

   Most key types need no emitted function at all. A key whose equality is
   bytewise and whose bytes are all present is served by one runtime pair over
   (pointer, size), which is what [bytewise_key] identifies. Two kinds are not:

   - a [string] is ptr+len and its bytes are elsewhere, so two equal strings at
     different addresses must still hash the same;
   - a struct may have padding, whose bytes are indeterminate, so two structs
     that are equal field by field can differ bytewise — and it may hold a
     string, which brings the first problem inside it.

   A struct therefore gets a pair emitted for it, walking its fields, and that
   is the only case that does. *)

let rec bytewise_key = function
  | Types.Int _ | Types.Enum _ | Types.Bool -> true
  | Types.Array (_, t) -> bytewise_key t
  | _ -> false

let hash_ty = Types.Int Types.U64

(* A context for a function the checker is about to invent. Nothing is
   reachable from it: no outer scope, no defers, and [defer_ok] false, because
   none of these is a body anyone wrote. *)
let invented_ctx env ret =
  { env; ret; slots = 0; slot_tys = []; slot_names = []; scope = [];
    defers = []; outer = []; outer_what = None; in_frames = None; loops = []; tail = false;
    in_defer = false; defer_ok = false; defer_block = "a nested form";
    owner = "<none>" }

(* The address of field [i] of the struct the pointer in slot [p] points at. *)
let field_addr_of loc sty fty p i =
  let target = mk loc sty (Tast.Deref (mk loc (Types.Ptr sty) (Tast.Local p))) in
  mk loc (Types.Ptr fty) (Tast.Addr (Tast.Pfield (target, i)))

(* The pointer form is what a Map_Info holds; the direct form is what an
   emitted hasher calls. See flan_rt.c on why they are two symbols. *)
let direct = function
  | "flan_hash_flat" -> "flan_key_hash_flat"
  | "flan_eq_flat" -> "flan_key_eq_flat"
  | "flan_hash_str" -> "flan_key_hash_str"
  | "flan_eq_str" -> "flan_key_eq_str"
  | s -> s

(* The pair for [k]: (hash, equality), each a symbol to be taken the address
   of. Emits a function for a struct key the first time it sees one, and finds
   it in [env.lifted] every time after — the name is derived from the type, so
   two maps with the same key type share one pair. *)
let rec key_pair env loc (k : Types.t) : Tast.fnref * Tast.fnref =
  match k with
  (* A hash and an equality for a type variable would have to be *chosen*,
     and nothing here can choose: the pair is emitted as concrete symbols and
     the concrete type does not exist until the instantiation. Refused rather
     than assumed — falling through to [bytewise_key] would hash whatever
     bytes the variable turned out to have, which is the wrong answer for a
     [string] and for any struct with padding.

     **This arm is a backstop and nothing normal reaches it.** Two things get
     there first. Inside an instantiation [env.subst] has already made [k]
     concrete, so there is no variable left. Outside one — in the abstract
     pass over a generic body — the map operations are *deferred*
     ([deferred_key] below): a key that is a variable declared [hashable?]
     never asks for a pair here, and a variable that is not declared it never
     gets as far as a [(Map $t V)] to operate on, because [map_type] refuses
     the type where it is written. What is left for this arm is a key that is
     a variable by some route neither of those covers, and the honest answer
     to that is still a refusal rather than a guessed pair. *)
  | Types.Var v ->
    Loc.failk "check/generic-map-key" loc
      "a map keyed by the type variable %s has no hash and no equality here: \
       both are emitted as concrete symbols chosen from the concrete key \
       type, and there is none until this generic is instantiated. The map \
       operations are deferred to the instantiation when {:where (hashable? \
       $%s)} is declared — declare it, or write the operation in a function \
       over the concrete key type and call that" v v
  | Types.String -> Tast.Rtfn "flan_hash_str", Tast.Rtfn "flan_eq_str"
  | t when bytewise_key t ->
    Tast.Rtfn "flan_hash_flat", Tast.Rtfn "flan_eq_flat"
  | Types.Named n when Hashtbl.mem env.structs n -> struct_key_pair env loc n
  (* A data type key would have to hash the tag and then only the bytes the
     case in hand actually uses — the rest of the payload is indeterminate,
     exactly as a struct's padding is, so hashing the blob would make two equal values
     hash differently. That is a per-case walk driven by a switch, which is a
     different shape from the field list [struct_key_pair] emits and which
     nothing has yet wanted. Refused by name rather than written untested. *)
  | Types.Named n when Hashtbl.mem env.datas n ->
    fail loc
      "%s is a data type, and a data type is not a map key: the payload past \
       the case in hand is indeterminate, so hashing the bytes would make two equal \
       values hash differently. Hashing one needs a per-case walk, which is \
       not written — key on the tag, or on a struct holding what you meant" n
  (* And an untagged union is refused for the half of that reason which has
     nothing to do with a tag: a member smaller than the union leaves the rest
     of the storage indeterminate, so two values that agree about every byte
     anybody wrote hash differently. There is no per-member walk to write here
     either — nothing records which member was written, which is the type. *)
  | Types.Named n when Hashtbl.mem env.unions n ->
    fail loc
      "%s is a union, and a union is not a map key: a member narrower than \
       the union leaves the rest of the bytes indeterminate, so two values \
       that agree about everything written would still hash differently. Key \
       on the member you meant" n
  | Types.Array (_, e) ->
    (* A fixed array of a struct or of strings would need the same per-element
       walk a struct key gets, driven by a loop rather than by a field list.
       Nothing has wanted one, so it is refused by name rather than written
       untested — and refused with the shape that does work named beside it. *)
    fail loc
      "a fixed array is a map key only when its elements are compared \
       bytewise, and %s is not — a struct or a string element needs a \
       per-element walk that is not written. A struct key holding the array \
       works, because a struct key is walked field by field"
      (Types.to_string e)
  | Types.Float _ ->
    (* Not a milestone question, which is why it is said separately: NaN is not
       equal to itself, and 0.0 and -0.0 are equal while differing bytewise. A
       float key therefore has no equality for a hash map to use, whatever the
       implementation does. *)
    fail loc
      "a float is not a map key: NaN is not equal to itself, and 0.0 and -0.0 \
       are equal but differ bytewise, so there is no equality here for a map \
       to hash. Key on an integer, or on a quantised integer of your choosing"
  | other ->
    fail loc
      "%s is not a map key. The first implementation takes integers, enums, \
       bools, strings, fixed arrays of those, and value structs composed of \
       those (spec-memory.md, \"Maps — first implementation\"). A Ptr, a \
       slice, a Vec or a Map would hash an address rather than what it points \
       at, which is a different operation"
      (Types.to_string other)

and struct_key_pair env loc n =
  let hname = "map/hash/" ^ n and ename = "map/eq/" ^ n in
  let known name =
    List.exists (fun (f : Tast.fn) -> f.Tast.name = name) env.lifted
  in
  if known hname then Tast.Flanfn hname, Tast.Flanfn ename
  else begin
    let sty = Types.Named n in
    let fields = (Hashtbl.find env.structs n).Tast.fields in
    if fields = [] then
      fail loc
        "%s has no fields, so every value of it is equal to every other — a \
         map keyed on it holds at most one entry, which is not a map" n;
    let hparams = [ Types.Ptr sty; hash_ty; Types.Int Types.I64 ] in
    let eparams = [ Types.Ptr sty; Types.Ptr sty; Types.Int Types.I64 ] in
    (* Registered before the fields are walked, so a struct reached twice
       through two different fields emits one pair and not two. A struct cannot
       contain itself by value, so there is no cycle to break — only sharing.
       The body is filled in below; nothing can call these in between. *)
    let placeholder name ret params =
      { Tast.name; params; slots = Array.of_list params;
        snames = Array.make (List.length params) None;
        ret; body = []; fdefers = []; fparent = None; floc = loc }
    in
    env.lifted <-
      placeholder hname hash_ty hparams
      :: placeholder ename (Types.Int Types.I8) eparams
      :: env.lifted;

    (* The hash: seed, then one combine per field, in declaration order. Each
       field is hashed by its own pair — the same recursion, so a string field
       hashes its bytes and a nested struct hashes field by field. Padding is
       never reached, because nothing here addresses anything but a field. *)
    let hctx = invented_ctx env hash_ty in
    let kp = fresh_slot ~name:"key" hctx (Types.Ptr sty) in
    let seed = fresh_slot ~name:"seed" hctx hash_ty in
    ignore (fresh_slot ~name:"size" hctx (Types.Int Types.I64));
    let acc = fresh_slot ~name:"h" hctx hash_ty in
    let steps =
      List.mapi
        (fun i (fl : Tast.field) ->
           let fty = fl.Tast.fty in
           let h, _ = key_pair env loc fty in
           let args =
             [ field_addr_of loc sty fty kp i;
               mk loc hash_ty (Tast.Local seed); size_of loc fty ]
           in
           let one =
             match h with
             | Tast.Rtfn s -> rt loc hash_ty (direct s) args
             | Tast.Flanfn s | Tast.Fnval s ->
               mk loc hash_ty (Tast.Call (s, args))
           in
           mk loc Types.Unit
             (Tast.Set (Tast.Plocal acc,
                        rt loc hash_ty "flan_hash_combine"
                          [ mk loc hash_ty (Tast.Local acc); one ])))
        fields
    in
    let hbody =
      (mk loc Types.Unit
         (Tast.Set (Tast.Plocal acc, mk loc hash_ty (Tast.Local seed))))
      :: steps
      @ [ mk loc hash_ty (Tast.Local acc) ]
    in

    (* The equality: one early return per field, then true. Written as returns
       rather than as a conjunction so that the comparison stops at the first
       field that differs, which for a struct with a string field is the
       difference between one memcmp and two. *)
    let ectx = invented_ctx env (Types.Int Types.I8) in
    let ap = fresh_slot ~name:"a" ectx (Types.Ptr sty) in
    let bp = fresh_slot ~name:"b" ectx (Types.Ptr sty) in
    ignore (fresh_slot ~name:"size" ectx (Types.Int Types.I64));
    let i8 v = mk loc (Types.Int Types.I8) (Tast.Int (v, Types.I8)) in
    let checks =
      List.mapi
        (fun i (fl : Tast.field) ->
           let fty = fl.Tast.fty in
           let _, eq = key_pair env loc fty in
           let args =
             [ field_addr_of loc sty fty ap i;
               field_addr_of loc sty fty bp i; size_of loc fty ]
           in
           let call =
             match eq with
             | Tast.Rtfn s -> rt loc (Types.Int Types.I8) (direct s) args
             | Tast.Flanfn s | Tast.Fnval s ->
               mk loc (Types.Int Types.I8) (Tast.Call (s, args))
           in
           let differs =
             mk loc Types.Bool (Tast.Prim (Tast.Eq, [ call; i8 0L ]))
           in
           mk loc Types.Unit
             (Tast.If (differs,
                       mk loc Types.Never (Tast.Return (Some (i8 0L))),
                       unit_at loc)))
        fields
    in
    let ebody = checks @ [ i8 1L ] in

    let finish name ret params ctx body =
      { Tast.name; params;
        slots = Array.of_list (List.rev ctx.slot_tys);
        snames = Array.of_list (List.rev ctx.slot_names);
        ret; body; fdefers = []; fparent = None; floc = loc }
    in
    env.lifted <-
      finish hname hash_ty hparams hctx hbody
      :: finish ename (Types.Int Types.I8) eparams ectx ebody
      :: List.filter
           (fun (f : Tast.fn) ->
              f.Tast.name <> hname && f.Tast.name <> ename)
           env.lifted;
    Tast.Flanfn hname, Tast.Flanfn ename
  end

(* The pair as two expressions, ready to be passed. Their Flan type is
   [Alloc]: an opaque pointer-width value with no user-writable constructor,
   which is all the backend needs and all any Flan type ever says about it. *)
let key_fns env loc k =
  let h, e = key_pair env loc k in
  mk loc Types.Alloc (Tast.FnAddr h), mk loc Types.Alloc (Tast.FnAddr e)

(* ── The map operations, deferred to the instantiation ─────────────────
   True when the key is a type variable, which means the operation cannot be
   built here and must be answered by the copy: [key_fns] emits concrete
   symbols and there is no concrete key type yet. The caller checks its
   arguments first and then returns a placeholder of the operation's own type,
   exactly as [print] does — see the allow-list comment at the [print] arm for
   what being on that list costs and why these are on it.

   The predicate is *required* before deferring, and that is the whole safety
   argument: with {:where (hashable? $t)} in the signature, the instantiation
   refuses at the call site against a requirement the author wrote down. A
   variable with no such clause is refused here and now, at the definition,
   which is where the abstract pass wants every refusal that has nothing to
   point at. In practice [map_type] has already refused such a signature where
   the type was written; this repeats it rather than relying on that, the same
   way [key_pair] repeats [map_type]'s key check. *)
let deferred_key env loc what (k : Types.t) =
  match k with
  | Types.Var v ->
    if not (declares env.tvpreds v "hashable?") then
      Loc.failk "check/generic-map-key" loc
        "%s over a map keyed by the type variable %s is refused: the hash and \
         the equality are emitted as concrete symbols chosen from the \
         concrete key type, and nothing here declares %s hashable. Write \
         {:where (hashable? $%s)} at the head of the body — then the \
         operation is deferred to each instantiation, and a call site that \
         asks for a key type that cannot be hashed is refused there, against \
         the clause"
        what (Types.to_string k) (Types.to_string k) v;
    true
  | _ -> false

let rec check ctx ?want (e : Ast.expr) : Tast.expr =
  let loc = e.Ast.loc in
  (* Read the permission this form was given and withdraw it in the same
     breath, so that nothing reached from here inherits it. The two callers
     that may grant it — [check_fn]'s body walk and [check_let]'s, below —
     grant it again before the *next* form rather than once around the body. *)
  let defer_ok = ctx.defer_ok in
  ctx.defer_ok <- false;
  (* The same read-and-withdraw, for the same reason: a [recur] is in tail
     position only if *this* form was, and nothing reached from here inherits
     it unless the arm below hands it on deliberately. *)
  let tail = ctx.tail in
  ctx.tail <- false;
  match e.Ast.e with
  | Ast.Int n -> int_literal loc ~want n
  | Ast.Byte b -> int_literal loc ~want ~default:Types.U8 (Int64.of_int b)
  | Ast.Float x ->
    let k =
      match want with
      | Some (Types.Float k) -> k
      | Some other when other <> Types.Never ->
        fail loc "expected %s, found the float literal %g"
          (Types.to_string other) x
      | _ -> Types.F64
    in
    mk loc (Types.Float k) (Tast.Float (x, k))
  | Ast.Str s -> expect loc ~want (mk loc Types.String (Tast.Str s))
  | Ast.Kw k ->
    (* A keyword resolves at compile time against the enum the site expects,
       and a typo is an error here rather than a wrong number at run time
       (plan.org, settled: keywords at typed call sites). It has no meaning
       without that expectation — there is no keyword type to fall back on. *)
    (match want with
     | Some (Types.Enum name) ->
       let members = Hashtbl.find ctx.env.enums name in
       (match List.assoc_opt k members with
        | Some v -> mk loc (Types.Enum name) (Tast.Int (v, Types.I32))
        | None ->
          fail loc "%s has no member :%s — it has %s" name k
            (String.concat " "
               (List.map (fun (m, _) -> ":" ^ m) members)))
     | Some other ->
       fail loc ":%s is an enum member, but %s is expected here" k
         (Types.to_string other)
     | None ->
       fail loc
         ":%s only means something where an enum type is expected — there is \
          no keyword type" k)
  | Ast.Quote _ ->
    unimplemented loc "a quoted symbol (restart names)" 6
  | Ast.Var name -> var ctx loc ~want name
  | Ast.Do body -> ctx.tail <- tail; block ctx ?want loc body
  (* [defer_ok] rides through: a [let] at the top level of a function body has
     exactly the function's extent, and so does a [let] nested inside one.
     [tail] rides through for the same shape of reason: a [recur] written as
     the last form of a [let] inside a loop body is in the loop's tail. *)
  | Ast.Let (bs, body) -> check_let ctx ~tail ?want ~defer_ok loc bs body
  | Ast.If (c, t, e') -> check_if ctx ~tail ?want loc c t e'
  | Ast.While (label, c, body) ->
    (* The condition is part of the loop even though it is written outside the
       braces — emit puts it in the header block, so it is re-evaluated at the
       top of every trip — but it stays outside [in_loop], because a [break]
       in a condition still means the enclosing loop and a [defer] there is
       still the outer block's. *)
    let c = check ctx ~want:Types.Bool c in
    let body = in_loop ctx ?label (fun () ->
      scoped ctx (fun () -> map_lr (fun b -> check ctx b) body))
    in
    (* No latch: a [while] has nothing to run between the body and the test, so
       a [continue] can branch straight at the condition. *)
    expect loc ~want (mk loc Types.Unit (Tast.While (c, body, [])))
  (* [Never], as [exit] and [return] are: nothing after one of these runs, and
     an [if] arm that ends in a break does not have to agree with the other. *)
  (* (loop [x 0 acc 1] body ...) — a loop that answers with the value of its
     body, and the only place a [recur] may stand. Not an IR node: it is a
     [let] over the names, a [While] whose condition is [true], and a jump.
     See [check_loop]. *)
  | Ast.Loop (bs, body) -> check_loop ctx ?want loc bs body
  | Ast.Recur args -> check_recur ctx ~tail loc args
  | Ast.Break label ->
    mk loc Types.Never (Tast.Break (loop_target ctx loc "break" label))
  | Ast.Continue label ->
    mk loc Types.Never (Tast.Continue (loop_target ctx loc "continue" label))
  | Ast.Return v when ctx.in_frames <> None ->
    ignore v;
    (* The frames are pushed and popped around the body, so an early exit would
       leave them on the handler or restart stack pointing into a frame that
       has gone. Rejected rather than left to corrupt it, the same rule as
       defer inside a block. *)
    fail loc
      "return is not allowed inside %s yet — the frames it established are \
       popped on the way out and an early exit would leave them on the stack"
      (match ctx.in_frames with Some n -> n | None -> assert false)

  | Ast.Return v ->
    let v =
      match v with
      | None ->
        if not (Types.equal ctx.ret Types.Unit) then
          fail loc "this function returns %s, so return needs a value"
            (Types.to_string ctx.ret);
        None
      | Some v -> Some (check ctx ~want:ctx.ret v)
    in
    (* Whatever has been deferred *so far* runs first: a defer written below
       this return has not executed yet and must not fire. *)
    let r = mk loc Types.Never (Tast.Return v) in
    (match ctx.defers with
     | [] -> r
     | ds -> mk loc Types.Never (Tast.Do (ds @ [ r ])))
  | Ast.Set (p, v) ->
    let p, pty = check_place ctx loc p in
    let v = check ctx ~want:pty v in
    expect loc ~want (mk loc Types.Unit (Tast.Set (p, v)))
  | Ast.Field (target, name) ->
    let target, sname = struct_target ctx target in
    let s = Option.get (fields_named ctx.env sname) in
    (match Tast.field_index s name with
     | None ->
       Loc.failk "check/unknown-field" loc ~notes:(declared_note ctx.env sname)
         "%s has no field %s" sname name
     | Some i ->
       let fty = (List.nth s.Tast.fields i).Tast.fty in
       expect loc ~want (mk loc fty (Tast.Field (target, i))))
  | Ast.Struct (name, kvs) -> check_struct ctx ~want loc name kvs
  | Ast.Arr items -> check_arr ctx ~want loc items
  (* (array 4 rl/Vector2). Parse already assembled the whole array type, so
     there is nothing to infer: resolve it and hand back its all-bytes-zero
     value, which is what a declared array with no initialiser gets. *)
  | Ast.ArrayOf t ->
    let ty = resolve ctx.env t in
    expect loc ~want (mk loc ty (Tast.Zero ty))
  | Ast.Match (scrutinee, arms) -> check_match ctx ~tail ?want loc scrutinee arms
  | Ast.Call (head, args) -> check_call ctx ~want loc head args
  | Ast.Unwrap (Ast.Usome, v) ->
    (* Unwrap Some, else early-return None from the enclosing function, so the
       enclosing function must itself return an Option (plan.org). *)
    (match ctx.ret with
     | Types.Option _ ->
       let v = check ctx v in
       (match v.Tast.ty with
        | Types.Option t ->
          expect loc ~want (mk loc t (Tast.UnwrapSome v))
        | other ->
          fail loc "some takes an (Option T), found %s" (Types.to_string other))
     | other ->
       fail loc
         "some early-returns None, so the enclosing function must return an \
          Option; this one returns %s" (Types.to_string other))
  | Ast.Unwrap (Ast.Utry, _) -> unimplemented loc "try (Result)" 6
  | Ast.Fn (params, body) -> check_fn ctx ~want loc params body
  | Ast.Dotimes (label, name, count, body) ->
    check_dotimes ctx ~want loc label name count body
  (* (signal c) : Unit, always — spec-conditions.md §1. A handler that returns
     normally leaves the signalling function to carry on, and with nothing
     matching this is a no-op, so nothing about it alters control flow. That is
     what makes it checkable here rather than needing the transfer machinery
     restart-case will want. *)
  | Ast.Signal (kind, c) ->
    let c = check ctx c in
    let name =
      match c.Tast.ty with
      | Types.Named n -> n
      | t ->
        fail c.Tast.loc
          "a condition is a struct, not %s — matching is by type and there is \
           no condition hierarchy"
          (Types.to_string t)
    in
    (* §1 and §2. [signal] is Unit whatever it finds; [error] is Never,
       because the only way past it is a handler that transfers — one that
       returns normally has not answered it, and the program stops. *)
    let ty, kind =
      match kind with
      | Ast.Ssignal -> (Types.Unit, Tast.Ssignal)
      | Ast.Serror -> (Types.Never, Tast.Serror)
    in
    expect loc ~want (mk loc ty (Tast.Signal (kind, type_id name, c)))

  | Ast.HandlerBind (clauses, body) -> check_handler_bind ctx ?want loc clauses body

  (* spec-conditions.md §3–§6: the transfer. Neither of these is a call — one
     establishes frames around a body, and the other leaves the function it is
     written in — so both are their own nodes all the way down. *)
  | Ast.RestartCase (body, clauses) -> check_restart_case ctx ?want loc body clauses
  | Ast.InvokeRestart (name, args) ->
    (* Never: control resumes at the restart-case, which yields the clause's
       value to *its* continuation, so nothing here has a value and nothing
       after it runs. The lookup is at run time because restarts are
       dynamically scoped and named — §4 — and so, for the same reason, is the
       check that these arguments are the ones the clause takes (§3). *)
    if ctx.in_defer then
      fail loc
        "invoke-restart is not allowed inside a defer — a defer is the cleanup \
         a transfer runs on its way out, so starting one there would leave \
         this function's defers half run with two targets and no way to \
         choose";
    let args = map_lr (fun a -> check ctx a) args in
    List.iter
      (fun (a : Tast.expr) ->
         match a.Tast.ty with
         | Types.Unit | Types.Never ->
           fail a.Tast.loc
             "a restart argument must be a value, and this one is %s"
             (Types.to_string a.Tast.ty)
         | _ -> ())
      args;
    let sg = restart_sig (List.map (fun (a : Tast.expr) -> a.Tast.ty) args) in
    (* Evaluated into slots first, so that an argument which transfers on its
       own is guarded before this form aims the channel, and so that a call
       written in an argument is on the ordinary walk rather than hidden
       inside a node that [Reach] and [Load] treat as a leaf. *)
    let binds =
      List.map (fun (a : Tast.expr) -> (fresh_slot ctx a.Tast.ty, a)) args
    in
    let locals =
      List.map
        (fun (s, (a : Tast.expr)) -> mk a.Tast.loc a.Tast.ty (Tast.Local s))
        binds
    in
    let invoke =
      mk loc Types.Never
        (Tast.InvokeRestart (type_id name, name, locals, sg, type_id sg, loc))
    in
    expect loc ~want
      (if binds = [] then invoke
       else mk loc Types.Never (Tast.Let (binds, [ invoke ])))

  | Ast.Defer forms ->
    (* Registering is the whole of it: the forms are checked here, where they
       can see the scope they are written in, and the node left behind is
       [unit]. [check_fn] splices the registered list onto both exit paths.

       [defer_ok] is true for a top-level form of the body and for a form in a
       [let] whose extent is the body — see the field's comment. Anywhere else
       the cleanup would run at function exit rather than at the exit of the
       construct it was written in, so it is refused, and named. *)
    if not defer_ok then
      fail loc
        "defer is not allowed inside %s — a defer is copied into every exit \
         path of the function, so it always registers and always runs at \
         function exit. Write it at the top level of the function body, or in \
         a let that is (a let has the function's extent, because nothing is \
         released at scope exit)"
        ctx.defer_block;
    register_defer ctx loc forms

and int_literal loc ~want ?(default = Types.I32) n =
  match want with
  | Some (Types.Int k) -> mk loc (Types.Int k) (Tast.Int (in_range loc k n, k))
  (* An untyped integer constant is usable where a float is wanted, as in
     Odin. A float literal is never usable where an integer is wanted. *)
  | Some (Types.Float k) ->
    mk loc (Types.Float k) (Tast.Float (Int64.to_float n, k))
  | Some other when other <> Types.Never ->
    fail loc "expected %s, found the integer literal %Ld"
      (Types.to_string other) n
  | _ -> mk loc (Types.Int default) (Tast.Int (in_range loc default n, default))

(* Arithmetic wraps, but a literal that does not fit its type is a typo, not a
   wrap — 300 is never what someone meant by a u8. *)
and in_range loc k n =
  let bits = Types.bits k in
  let ok =
    if Types.signed k then
      bits = 64
      || (Int64.compare n (Int64.neg (Int64.shift_left 1L (bits - 1))) >= 0
          && Int64.compare n (Int64.shift_left 1L (bits - 1)) < 0)
    else if bits = 64 then
      (* A u64 literal is its 64-bit pattern, so anything at or above 2^63
         arrives here as a negative [int64] and is still in range —
         0xcbf29ce484222325 is a real u64 and not an error. The cost is that a
         negative *decimal* literal is accepted as a u64 too, because the
         reader records only the value and not how it was written. Narrower
         unsigned types keep the strict check, which is where a typo like 300
         for a u8 actually shows up. *)
      true
    else
      Int64.compare n 0L >= 0
      && Int64.compare n (Int64.shift_left 1L bits) < 0
  in
  if ok then n
  else fail loc "%Ld does not fit in %s" n (Types.ikind_name k)

(* The arms that are names rather than calls, and the same rule holds for them:
   each is in [builtins] below, and test_flan reads this match to check it. *)
and var ctx loc ~want name =
  match name with
  | "true" | "false" ->
    expect loc ~want (mk loc Types.Bool (Tast.Bool (name = "true")))
  | "None" ->
    (match want with
     | Some (Types.Option t) -> mk loc (Types.Option t) Tast.None_
     | Some other when other <> Types.Never ->
       fail loc "expected %s, found None" (Types.to_string other)
     | _ ->
       fail loc
         "nothing here says what None is an Option of — annotate the \
          function's return type or the binding")
  (* spec-memory.md puts the allocator in the calling convention as
     [context/allocator] and [context/temp]. They read as names rather than
     calls because that is how the spec writes them, and they are dynamic
     variables at run time rather than extra parameters — see docs/BUILT.md for why
     the literal reading of "calling convention" is deferred. *)
  | "context/allocator" ->
    expect loc ~want
      (mk loc Types.Alloc (Tast.Prim (Tast.Rt "flan_context_allocator", [])))
  | "context/temp" ->
    expect loc ~want
      (mk loc Types.Alloc (Tast.Prim (Tast.Rt "flan_context_temp", [])))
  | _ ->
    match lookup ctx name with
    | Some b ->
      expect loc ~want (mk loc b.bty (Tast.Local b.slot))
    | None ->
      match Hashtbl.find_opt ctx.env.globals name with
      | Some (ty, _) ->
        expect loc ~want (mk loc ty (Tast.Global name))
      | None ->
        match Hashtbl.find_opt ctx.env.cases name with
        (* A case with no fields is a whole value on its own, so it is written
           as a name and not as a call — the same shape [None] has, and for the
           same reason: there is nothing to put in the braces. A case that does
           have fields is refused here rather than silently zeroed, because ZII
           on a constructor would quietly produce a value nobody wrote. *)
        | Some (dname, c) when String.contains name '.' ->
          if c.Tast.vfields <> [] then
            fail loc
              "%s has fields, so it needs them — write (%s {.%s ...})"
              name name
              (List.hd c.Tast.vfields).Tast.fname;
          expect loc ~want
            (mk loc (Types.Named dname)
               (Tast.MakeCase (dname, c.Tast.vname, [])))
        | Some (dname, c) ->
          fail loc
            "%s is a case of the data type %s, and a data type value names both — \
             write %s.%s" name dname dname c.Tast.vname
        | None ->
          (* A bare function name *is* the function. This is a Lisp-1 — one
             top-level namespace, enforced, so a defn and a defvar cannot share
             a name — and that is exactly what makes (map double xs) safe to
             read: there is no second binding of [double] for it to have meant
             instead, so Common Lisp's #'double would be punctuation answering
             a question this language does not ask. *)
          (match Hashtbl.find_opt ctx.env.fns name with
           | Some (params, ret) ->
             (* A foreign function is in [fns] too, and its emitted signature
                is C's: no transfer channel, and an aggregate flattened by the
                shim. Nothing could call the resulting pointer correctly, so it
                is refused for what it is rather than handed out. *)
             if Hashtbl.mem ctx.env.externs name then
               fail loc
                 "%s is a foreign function, and its address is not a Flan \
                  function value: a Flan function's signature ends with the \
                  transfer channel and a C one does not. Wrap it in a defn \
                  and pass that" name;
             expect loc ~want
               (mk loc (Types.Fn (params, ret)) (Tast.FnAddr (Tast.Fnval name)))
           | None -> captured ctx loc name;
         Loc.failk "check/unknown-name" loc "unknown name %s" name)

(* What remains of spec-memory.md's ownership section after the repeals of
   2026-09-18 is the allocator's side alone: the region rule decides where a
   container of owning elements may be built, and the allocator's capability
   decides what a free means at run time. Everything copies — a container as
   its header, the copies aliasing one buffer — and which frees run, and in
   what order, is the program's own business, the same contract Odin ships
   with; the dev build's epoch words are the net under it. The flow analysis
   that used to live here (a per-function dead set, a borrow flag, a
   loop-iteration diff) went in the first repeal; the move-only concept
   itself — copy refusals, [copyable?], the struct/union owning rules — went
   in the second. See spec-memory.md, "The repeal". *)

(* [defer_ok] is granted again before *every* form, not once before the block:
   [check] withdraws it as it starts, so granting it once would let the first
   form carry a defer and refuse the second — and two resources acquired in one
   [let] is the case the relaxation exists for. *)
and block ctx ?want ?(defer_ok = false) loc body =
  match body with
  (* Withdrawn here too. An empty body has no last form to be the tail, so
     leaving the permission set would hand it to whatever is checked next. *)
  | [] -> ctx.tail <- false; expect loc ~want (unit_at loc)
  | _ ->
    (* A block's tail is its last form and nothing else. Callers that must not
       pass one on need do nothing: [check] withdrew it before they were
       reached, so [tail] is already false here for all of them. *)
    let tail = ctx.tail in
    let rec go = function
      | [ last ] ->
        ctx.defer_ok <- defer_ok;
        ctx.tail <- tail;
        let l = check ctx ?want last in [ l ], l.Tast.ty
      | x :: rest ->
        ctx.defer_ok <- defer_ok;
        ctx.tail <- false;
        let x = check ctx x in
        let rest, ty = go rest in x :: rest, ty
      | [] -> assert false
    in
    let body, ty = go body in
    mk loc ty (Tast.Do body)

(* (fn [x y] BODY...) — a function value, lifted into a function of its own.

   The same arrangement a handler clause already uses, and deliberately so:
   this compiler has built and called function values internally since the Map
   landed, and the surface feature is that machinery given a name rather than a
   second one invented beside it.

   **No capture, and that is the scope of this milestone.** The body sees its
   parameters and the program's globals and nothing else; a reference to a
   local of the enclosing function is refused by name (see [captured]) rather
   than resolved to something it did not mean. That is what makes the value a
   bare code address with no environment behind it, which in turn is what makes
   it safe to pass down, return, and store: there is nothing that can outlive
   anything. spec-memory.md's capture cases, and escaping closures with them,
   stay deferred.

   **The parameter types come from the position.** [Ast.Fn] carries names and
   no types — that is the surface syntax, not an omission here — so an fn is
   checkable exactly where something says what is wanted. An argument position
   does, because [named_call] threads the callee's parameter type into each
   argument; a bare [(let [f (fn [x] x)])] does not, and is refused saying so. *)
and check_fn ctx ~want loc (params : string list) body =
  let pts, ret =
    match want with
    | Some (Types.Fn (ps, r)) when List.length ps = List.length params -> ps, r
    | Some (Types.Fn (ps, r)) ->
      fail loc
        "this fn has %d parameter%s and %s was wanted here"
        (List.length params)
        (if List.length params = 1 then "" else "s")
        (Types.to_string (Types.Fn (ps, r)))
    | Some other when other <> Types.Never ->
      fail loc "expected %s, found an fn" (Types.to_string other)
    | _ ->
      fail loc
        "nothing here says what this fn's parameters are — an fn takes its \
         types from the position it is written in, so it goes in an argument \
         whose parameter is a (Fn [T ...] R), and a name already written as a \
         defn goes anywhere"
  in
  (* Its own frame and its own empty scope, with [outer] kept only so that a
     reference to the enclosing function's locals is refused for the reason it
     is really refused for. *)
  let fctx =
    { env = ctx.env; ret; slots = 0; slot_tys = []; slot_names = [];
      scope = []; defers = []; outer = ctx.scope;
      outer_what = Some "an fn"; in_frames = None; loops = []; tail = false;
      in_defer = false; defer_ok = false; defer_block = "a nested form";
      owner = ctx.owner }
  in
  List.iter2
    (fun n t -> ignore (bind fctx n t ~assignable:false)) params pts;
  let fbody = map_lr (fun e -> check fctx e) body in
  (* The same rule an ordinary defn's body follows: the last form is the
     answer, and it has to be the declared return type. *)
  let fbody =
    match List.rev fbody with
    | [] -> fbody
    | last :: rest ->
      List.rev (expect last.Tast.loc ~want:(Some ret) last :: rest)
  in
  (* Named after the function it was written in and numbered within it, which
     is the handler clause's rule and is stable for the same reason: a
     redefinition module emits the lifted functions belonging to the bodies it
     replaces, and an index into the whole program's list could not say which
     those were. *)
  let fname =
    (* Counted per *kind*, not over everything this function has lifted. A
       handler clause and an fn share one list, and a shared counter would
       renumber every fn in a function the moment a handler-bind was added
       above one — a rename for a body that did not change, in the names a
       redefinition module emits. Two counters, two stable sequences. *)
    let mine =
      List.filter
        (fun (l : Tast.fn) ->
           l.Tast.fparent = Some ctx.owner
           && String.length l.Tast.name >= 3
           && String.sub l.Tast.name 0 3 = "fn/")
        ctx.env.lifted
    in
    Printf.sprintf "fn/%s/%d" ctx.owner (List.length mine)
  in
  ctx.env.lifted <-
    { Tast.name = fname; params = pts;
      slots = Array.of_list (List.rev fctx.slot_tys);
      snames = Array.of_list (List.rev fctx.slot_names);
      ret; body = fbody; fdefers = [];
      fparent = Some ctx.owner; floc = loc }
    :: ctx.env.lifted;
  expect loc ~want
    (mk loc (Types.Fn (pts, ret)) (Tast.FnAddr (Tast.Fnval fname)))

(* A handler runs where the *signal* was, not where it was established, so it
   cannot be a branch in the function that wrote it: it is lifted into a
   function of its own and reached through a pointer.

   Which means it cannot see the establishing function's locals. Capturing them
   is a closure with an explicit environment — the non-escaping kind, captured
   by value onto this frame — and until that exists a reference to one is
   rejected by name rather than silently resolving to something else. Globals and the condition itself are
   in scope, which is enough for the accumulation case §1 is about.

   The body may not [return] either. The frames are pushed and popped around
   it, and an early exit would leave them on the stack pointing into a function
   that has gone. *)
and check_handler_bind ctx ?want loc clauses body =
  ignore want;
  let frames =
    List.map
      (fun (c : Ast.hclause) ->
         let ty = resolve ctx.env c.Ast.hty in
         let name =
           match ty with
           | Types.Named n -> n
           | t ->
             fail c.Ast.hloc
               "a handler matches a struct type, not %s" (Types.to_string t)
         in
         (* Its own context: a fresh frame, an empty scope, and no way to reach
            the enclosing one. *)
         let hctx =
           { env = ctx.env; ret = Types.Unit; slots = 0; slot_tys = []; slot_names = [];
             scope = []; defers = []; outer = ctx.scope; outer_what = Some "a handler"; in_frames = None; loops = []; tail = false; in_defer = false; defer_ok = false; defer_block = "a nested form"; owner = "<none>" }
         in
         (* The condition crosses as a pointer, because the handler runs while
            the signalling frame is still alive and there is nothing to copy.
            What the clause binds is the condition itself, though, so the
            pointer is a hidden parameter and the name is a slot loaded from
            it — a handler that passed [c] to something expecting the struct
            would otherwise be handed an address. *)
         let pslot = fresh_slot hctx (Types.Ptr ty) in
         let cslot = bind hctx c.Ast.hname ty ~assignable:false in
         let hbody = map_lr (fun e -> check hctx e) c.Ast.hbody in
         let hbody =
           [ mk c.Ast.hloc Types.Unit
               (Tast.Let
                  ([ (cslot,
                      mk c.Ast.hloc ty
                        (Tast.Deref
                           (mk c.Ast.hloc (Types.Ptr ty) (Tast.Local pslot)))) ],
                   hbody)) ]
         in
         (* Named after the function it came out of, and numbered within it:
            stable against an unrelated handler-bind being added elsewhere,
            which an index into the whole program's lifted list would not be. *)
         let fname =
           (* Per kind, for the reason [check_fn] gives: an fn lifted out of
              the same function must not shift this sequence. *)
           let mine =
             List.filter
               (fun (l : Tast.fn) ->
                  l.Tast.fparent = Some ctx.owner
                  && String.length l.Tast.name >= 8
                  && String.sub l.Tast.name 0 8 = "handler/")
               ctx.env.lifted
           in
           Printf.sprintf "handler/%s/%d/%s" ctx.owner (List.length mine) name
         in
         ctx.env.lifted <-
           { Tast.name = fname; params = [ Types.Ptr ty ];
             slots = Array.of_list (List.rev hctx.slot_tys);
             snames = Array.of_list (List.rev hctx.slot_names);
             ret = Types.Unit; body = hbody; fdefers = [];
             fparent = Some ctx.owner; floc = c.Ast.hloc }
           :: ctx.env.lifted;
         { Tast.htype = type_id name; hfn = fname })
      clauses
  in
  (* The flag is set on [ctx] itself and restored, not on a copy: [ctx.slots]
     and [ctx.slot_tys] are mutable, so a copy would allocate the body's slots
     into a record the function never sees again and the indices would
     collide. *)
  let saved = ctx.in_frames in
  ctx.in_frames <- Some "handler-bind";
  let body =
    barrier ctx "a handler-bind" (fun () -> map_lr (fun e -> check ctx e) body)
  in
  ctx.in_frames <- saved;
  mk loc Types.Unit (Tast.Handled (frames, body))

(* (restart-case BODY (name [] BODY-1) ...) — spec-conditions.md §3 and §6.

   Unlike a handler, a clause runs *at* the restart-case, which is where it was
   written, so it is a branch in this function and sees this function's scope.
   What arrives from elsewhere is only the answer to "which clause": a transfer
   names the frame it is aimed at, and this form compares that against the
   frames it itself pushed.

   Every clause body and the body have the same type, and that is the type of
   the whole form — which is what makes the fall-through path visible in the
   source (§1): a restart-case in value position has to produce its type when
   no restart is invoked too. *)
and check_restart_case ctx ?want loc body clauses =
  let saved = ctx.in_frames in
  ctx.in_frames <- Some "restart-case";
  let tbody = barrier ctx "a restart-case" (fun () -> check ctx ?want body) in
  ctx.in_frames <- saved;
  (* With no expectation from outside, the body's own type is the expectation
     the clauses are checked against — unless it produced no value at all, in
     which case the first clause that does decides. *)
  let want =
    match want with
    | Some _ -> want
    | None -> if tbody.Tast.ty = Types.Never then None else Some tbody.Tast.ty
  in
  let ty = ref (match want with Some t -> Some t | None -> None) in
  let seen = ref [] in
  let clauses =
    map_lr
      (fun (c : Ast.rclause) ->
         (* Two clauses of one name would make §4's "the first frame offering
            the name" pick between them by an order nothing in the source
            shows. *)
         if List.mem c.Ast.rname !seen then
           fail c.Ast.rloc "this restart-case offers %s twice" c.Ast.rname;
         seen := c.Ast.rname :: !seen;
         (* §3's parameters. They are slots in *this* function — a clause runs
            here, not where the invoke was — and the invoker stores into a
            buffer this frame owns, because its own frame is gone by the time
            the clause body starts (§5). Bound like a function's parameters:
            visible only in the clause, and not assignable. *)
         let params, b =
           scoped ctx (fun () ->
             let params =
               List.map
                 (fun (p : Ast.field) ->
                    let ty = resolve ctx.env p.Ast.fty in
                    (match ty with
                     | Types.Unit | Types.Never ->
                       fail p.Ast.floc
                         "%s would be a restart parameter of type %s, which is \
                          not a value" p.Ast.fname (Types.to_string ty)
                     | _ -> ());
                    (bind ctx p.Ast.fname ty ~assignable:false, ty))
                 c.Ast.rparams
             in
             (* Each is checked against what the form has settled on so far, so
                a clause that disagrees fails where it is written. The first one
                to produce a value is what settles it when nothing outside
                did. *)
             (params,
              (* The same barrier the body gets, and for the same reason: a
                 clause runs after a transfer landed at this restart-case, with
                 its frames still to be popped. *)
              barrier ctx "a restart-case"
                (fun () -> block ctx ?want:!ty c.Ast.rloc c.Ast.rbody)))
         in
         if !ty = None && b.Tast.ty <> Types.Never then ty := Some b.Tast.ty;
         let sg = restart_sig (List.map snd params) in
         { Tast.rname_id = type_id c.Ast.rname; rname = c.Ast.rname;
           rparams = params; rsig = sg; rsig_id = type_id sg; rbody = [ b ] })
      clauses
  in
  let ty = match !ty with Some t -> t | None -> Types.Never in
  mk loc ty (Tast.RestartCase (clauses, tbody))

(* The forms of a [defer], checked in place and hung on the function. It emits
   nothing where it stands, so what is left behind is [unit]. *)
and register_defer ctx loc forms =
  ctx.in_defer <- true;
  (* A barrier, for the reason [defer] itself exists: these forms are *copied*
     into every exit path of the function, where the loop they were written
     beside is not running. A loop written inside the defer is below the
     barrier and breaks out of itself perfectly well. *)
  let forms =
    barrier ctx "a defer" (fun () -> map_lr (fun d -> check ctx d) forms)
  in
  ctx.in_defer <- false;
  ctx.defers <- mk loc Types.Unit (Tast.Do forms) :: ctx.defers;
  unit_at loc

(* [defer_ok] says whether *this* let has the function's extent. If it does, so
   does every form in its body, including a nested let — which is why the flag
   is handed to the body rather than consumed here. *)
and check_let ctx ?(tail = false) ?want ?(defer_ok = false) loc bs body =
  scoped ctx (fun () ->
    let bs =
      map_lr
        (fun (b : Ast.binding) ->
           let want = Option.map (resolve ctx.env) b.Ast.bty in
           let v = check ctx ?want b.Ast.bval in
           (match v.Tast.ty with
            | Types.Unit | Types.Never ->
              fail b.Ast.bloc "%s would be bound to %s, which is not a value"
                b.Ast.bname (Types.to_string v.Tast.ty)
            | _ -> ());
           (* Locals are assignable places; parameters are not. *)
           let slot = bind ctx b.Ast.bname v.Tast.ty ~assignable:true in
           (slot, v))
        bs
    in
    (* After the bindings, because checking each of them withdrew it. *)
    ctx.tail <- tail;
    let body = block ctx ?want ~defer_ok loc body in
    mk loc body.Tast.ty (Tast.Let (bs, [ body ])))

(* (dotimes [i n] body...) is a counting loop, not a new IR node: bind [i] to 0
   and the bound to a hidden slot — [n] is evaluated once, before the loop, so
   a body that changes it cannot change the trip count — then step [i] at the
   end of the body. [i] is not assignable, so the step below is the only writer. *)
(* What a loop still contributes to checking after the repeal is scoping, not
   ownership: the entry below is what [break] and [continue] resolve against,
   and the defer_block name is what makes a [defer] in here refused as "a loop
   body" — it would fire once at function exit rather than once per iteration,
   and the message says so. [fresh] and the iteration move-diff that used it
   are gone with the flow analysis. *)
and in_loop ctx ?label ?entry f =
  (* The loop goes on the stack before the body is checked and comes off after,
     so a [break] inside it can see it and one outside it cannot. *)
  let loops = ctx.loops in
  ctx.loops <- (match entry with Some e -> e | None -> Lloop label) :: loops;
  let blocker = ctx.defer_block in
  ctx.defer_block <- "a loop body";
  let r = f () in
  ctx.defer_block <- blocker;
  ctx.loops <- loops;
  r

(* Which loop a [break] or a [continue] means, as a count of loops outwards
   from the innermost — which is what [Tast.Break] carries and what [emit]
   indexes. Refuses three things, each by its own reason: nothing to break out
   of, a label naming no loop this form is inside, and a jump that would cross
   a barrier. *)
and loop_target ctx loc verb label =
  let rec go depth = function
    | [] ->
      (match label with
       | None ->
         fail loc "%s is only allowed inside a loop" verb
       | Some l ->
         fail loc
           "no loop named :%s encloses this %s. A label names one of the loops \
            this form is written inside — it is not a goto, so it cannot name a \
            loop somewhere else" l verb)
    | Lloop name :: rest ->
      (match label with
       | None -> depth
       | Some l when name = Some l -> depth
       | Some _ -> go (depth + 1) rest)
    (* A [loop] answers with the value of its body. A jump out of one would
       have to produce that value from somewhere and there is nowhere, so it is
       a barrier like the others, named as what it is. A [while] written inside
       a loop sits below this entry and keeps its own break. *)
    | Lrecur _ :: _ ->
      (match label with
       | None ->
         fail loc
           "%s is not allowed here: the nearest loop is a (loop ...), which \
            answers with the value of its body, so leaving it this way would \
            have no value to give. Answer with the value, or use a while"
           verb
       | Some l ->
         fail loc
           "%s :%s would leave a (loop ...), which it may not: a loop answers \
            with the value of its body and a jump out of one has no value to \
            give" verb l)
    | Lbarrier what :: rest ->
      (* Crossing it would skip whatever the construct does on the way out —
         the handler or restart frames it pushed, or, for a defer, would jump
         to a loop that is not there on the path the forms were copied into.
         A loop nested inside the construct is below this entry and is never
         reached here, which is the whole point of the rule being relative. *)
      ignore rest;
      (match label with
       | None ->
         fail loc
           "%s is not allowed here: the nearest loop is outside %s, and leaving \
            it that way would skip what %s does on the way out. Write the loop \
            inside it, or leave with a value and test that after"
           verb what what
       | Some l ->
         fail loc
           "%s :%s would leave %s, which it may not: whatever %s does on the way \
            out would be skipped. A break may only leave loops that are inside \
            the same %s it is"
           verb l what what what)
  in
  go 0 ctx.loops

and check_dotimes ctx ~want loc label name count body =
  let count = check ctx ~want:index_ty count in
  scoped ctx (fun () ->
    let i = bind ctx name index_ty ~assignable:false in
    let limit = fresh_slot ctx index_ty in
    let body = in_loop ctx ?label (fun () -> map_lr (fun b -> check ctx b) body) in
    let iv = mk loc index_ty (Tast.Local i) in
    let one = mk loc index_ty (Tast.Int (1L, Types.I32)) in
    let cond =
      mk loc Types.Bool
        (Tast.Prim (Tast.Lt, [ iv; mk loc index_ty (Tast.Local limit) ]))
    in
    let step =
      mk loc Types.Unit
        (Tast.Set (Tast.Plocal i,
                   mk loc index_ty (Tast.Prim (Tast.Add, [ iv; one ]))))
    in
    let zero = mk loc index_ty (Tast.Int (0L, Types.I32)) in
    (* The step is the *latch* and not the last form of the body. Folded onto
       the body it would be skipped by a [continue], which branches past the
       rest of the body — so [i] would never advance and the loop would hang.
       That is the whole reason [Tast.While] carries a third list. *)
    let loop = mk loc Types.Unit (Tast.While (cond, body, [ step ])) in
    expect loc ~want
      (mk loc Types.Unit (Tast.Let ([ (i, zero); (limit, count) ], [ loop ]))))

(* ── (loop [...] ...) and (recur ...) ───────────────────────────────────

   A loop is a [let] over its names, a [While] whose condition is [true], and
   two jumps: [recur] rebinds every name and continues, and falling off the end
   of the body breaks. Nothing new reaches the backend, which is the whole
   argument for [recur] over tail calls — the machinery is the one [while] and
   the labelled [break]/[continue] already needed.

   **The value.** A loop answers with the value of its body, so the result is
   written into a slot of its own on the way out and read after the loop. A
   body that is [Unit] needs no slot, and a body that is [Never] — one that
   only ever recurs or returns — needs neither a slot nor the break, because
   nothing falls off the end of it.

   **Why [Set] of a [Never] body is safe.** [emit] closes a block at its
   terminator and drops what follows ([ins] checks [f.live]), so when the body
   ends in a jump the store is simply never written. The one ordering that
   matters is inside [Tast.Set]: the place is resolved before the value, and a
   local's place is an address with no instruction behind it.

   **Why the invented [While] may carry jumps.** [tast.ml] says a [While] the
   checker invents contains none, because the depths it would carry were minted
   against a stack it is not on. This one is different and the difference is
   the licence: it is pushed on [ctx.loops] like any other, so the [Break 0]
   below and every [continue] a [recur] mints count from the same stack [emit]
   indexes. *)
and check_loop ctx ?want loc bs body =
  scoped ctx (fun () ->
    (* Each initial value is evaluated once, before the loop, exactly as a
       [let]'s is and as [dotimes]'s bound is. *)
    let inits =
      map_lr
        (fun (n, v) ->
           let v = check ctx v in
           (match v.Tast.ty with
            | Types.Unit | Types.Never ->
              fail v.Tast.loc "%s would be bound to %s, which is not a value" n
                (Types.to_string v.Tast.ty)
            | _ -> ());
           (n, v))
        bs
    in
    let binds =
      List.map (fun (n, v) -> (bind ctx n v.Tast.ty ~assignable:true, v)) inits
    in
    let names = List.map (fun (slot, v) -> (slot, v.Tast.ty)) binds in
    (* The singleton is [in_loop]'s doing: it sits in this recursive group and
       is therefore monomorphic, and every other caller hands it a list. *)
    let tbody =
      match
        in_loop ctx ~entry:(Lrecur names) (fun () ->
          [ scoped ctx (fun () ->
              (* The body's last form is the loop's tail, which is the only
                 place a [recur] may stand. [block] distributes it. *)
              ctx.tail <- true;
              block ctx ?want loc body) ])
      with
      | [ b ] -> b
      | _ -> assert false
    in
    let ty = tbody.Tast.ty in
    let yes = mk loc Types.Bool (Tast.Bool true) in
    let leave = mk loc Types.Never (Tast.Break 0) in
    let inner, result =
      if ty = Types.Never then ([ tbody ], None)
      else if ty = Types.Unit then ([ tbody; leave ], None)
      else
        let r = fresh_slot ctx ty in
        ([ mk loc Types.Unit (Tast.Set (Tast.Plocal r, tbody)); leave ], Some r)
    in
    let loop = mk loc Types.Unit (Tast.While (yes, inner, [])) in
    match result with
    | None -> expect loc ~want (mk loc ty (Tast.Let (binds, [ loop ])))
    | Some r ->
      expect loc ~want
        (mk loc ty
           (Tast.Let (binds @ [ (r, mk loc ty (Tast.Zero ty)) ],
                      [ loop; mk loc ty (Tast.Local r) ]))))

(* Which loop a [recur] means, and what it has to rebind. The same walk
   [break] and [continue] make, over the same stack and refusing on the same
   barriers — [recur] asks "may this jump cross that" and gets the answer that
   was already settled, not a second mechanism. *)
and recur_target ctx loc =
  let rec go depth = function
    | [] ->
      fail loc
        "recur is only allowed inside a (loop ...). There are no tail calls in \
         this compiler, so a function cannot recur into itself and two \
         functions cannot recur into each other — write the repetition as a \
         loop with a recur in its tail"
    | Lrecur names :: _ -> (depth, names)
    (* Unreachable while the tail rule holds — a loop body is not a tail
       position, so no [recur] is ever written inside one — but the depth is
       counted rather than assumed, because it is what [emit] indexes. *)
    | Lloop _ :: rest -> go (depth + 1) rest
    | Lbarrier what :: _ ->
      fail loc
        "recur would leave %s, which it may not: whatever %s does on the way \
         out would be skipped. Write the loop inside it, or leave with a value \
         and test that after"
        what what
  in
  go 0 ctx.loops

and check_recur ctx ~tail loc args =
  let depth, names = recur_target ctx loc in
  (* Checked, which is the whole of why this is better than a silent TCO: a
     recur that is not in tail position is a compile error here, where under
     tail calls it would have been a stack overflow at run time. *)
  if not tail then
    fail loc
      "recur must be in the tail position of its loop — the last thing the \
       body does, or the last thing in an if, match or let arm that is itself \
       in the tail. Here something would still have to run afterwards, and a \
       recur is a jump back to the top, not a call that returns";
  let want = List.length names and got = List.length args in
  if want <> got then
    fail loc "this loop binds %d name%s and this recur passes %d" want
      (if want = 1 then "" else "s") got;
  let vals = List.map2 (fun a (_, ty) -> check ctx ~want:ty a) args names in
  (* Every name is rebound at once. The new values go into temporaries first,
     so that (recur y x) swaps rather than writing y over x and then reading it
     back — the same reason Clojure's recur is simultaneous. *)
  let temps = List.map2 (fun v (_, ty) -> (fresh_slot ctx ty, v)) vals names in
  let sets =
    List.map2
      (fun (t, _) (slot, ty) ->
         mk loc Types.Unit
           (Tast.Set (Tast.Plocal slot, mk loc ty (Tast.Local t))))
      temps names
  in
  mk loc Types.Never
    (Tast.Let (temps, sets @ [ mk loc Types.Never (Tast.Continue depth) ]))

and check_if ctx ?(tail = false) ?want loc c t e =
  let c = check ctx ~want:Types.Bool c in
  (* Both arms are the tail, and a one-armed [if] counts: [(when c (recur ...))]
     is how nearly every loop is written, and the branch is still the last
     thing the body does. *)
  let in_tail f = ctx.tail <- tail; f () in
  match e with
  | None ->
    (* A one-armed if produces Unit whatever the branch evaluates to: there is
       no value on the missing side. `when` desugars to this. *)
    let t = branch ctx (fun () -> in_tail (fun () -> check ctx t)) in
    expect loc ~want (mk loc Types.Unit (Tast.If (c, t, unit_at loc)))
  | Some e ->
    let t = branch ctx (fun () -> in_tail (fun () -> check ctx ?want t)) in
    (* With no expectation the then-branch supplies one for the else-branch,
       unless it diverges, in which case the else-branch decides. *)
    let ewant =
      match want with
      | Some _ -> want
      | None -> if t.Tast.ty = Types.Never then None else Some t.Tast.ty
    in
    let e = branch ctx (fun () -> in_tail (fun () -> check ctx ?want:ewant e)) in
    let ty =
      if t.Tast.ty = Types.Never then e.Tast.ty
      else if e.Tast.ty = Types.Never then t.Tast.ty
      else if Types.equal t.Tast.ty e.Tast.ty then t.Tast.ty
      else
        fail loc "the branches of this if have different types: %s and %s"
          (Types.to_string t.Tast.ty) (Types.to_string e.Tast.ty)
    in
    mk loc ty (Tast.If (c, t, e))

(* A record-shaped literal: one form for both, because [(Name {.f v})] is the
   same syntax whether [Name] is a struct or a data type case, and the two differ
   only in what is built at the end. Deciding here rather than in the parser is
   what lets the decision be made against the tables, exactly. *)
and check_struct ctx ~want loc name kvs =
  match Hashtbl.find_opt ctx.env.structs name with
  | None when Hashtbl.mem ctx.env.unions name ->
    check_union ctx ~want loc name kvs
  | None ->
    (match Hashtbl.find_opt ctx.env.cases name with
     (* The full spelling [U.C], which is how a data type value is written. Checked
        before the diagnostics below, since the bare-name entry in the same
        table is only ever a hint. *)
     | Some (dname, c) when String.contains name '.' ->
       check_case ctx ~want loc dname c kvs
     (* A bare case name. This is the bug NEXT.md listed under "Bugs found and
        not yet fixed": [(A {.x 1})] on a case of a data type reported "unknown
        struct A", because nothing in [env] could tell a case name from a
        misspelling. It can now, so it says what was meant. *)
     | Some (dname, c) ->
       fail loc
         "%s is a case of the data type %s, not a struct — a data type value names \
          both, as (%s.%s {.field value ...})"
         name dname dname c.Tast.vname
     | None ->
       if Hashtbl.mem ctx.env.datas name then
         fail loc
           "%s is a data type, and a data type value names the case as well as the \
            type — write (%s.%s {.field value ...}) for one of %s"
           name name (first_case_name ctx.env name) (case_list ctx.env name)
       else
         Loc.failk "check/unknown-struct" loc ~notes:(declared_note ctx.env name)
           "unknown struct %s" name)
  | Some s ->
    let seen = Hashtbl.create 8 in
    List.iter
      (fun (k, (v : Ast.expr)) ->
         (match Hashtbl.find_opt seen k with
          | Some (first : Ast.expr) ->
            Loc.failk "check/duplicate-field" v.Ast.loc
              ~notes:[ Loc.note first.Ast.loc (k ^ " is given here first") ]
              "field %s is given twice" k
          | None -> ());
         if Tast.field_index s k = None then
           Loc.failk "check/unknown-field" v.Ast.loc
             ~notes:(declared_note ctx.env name)
             "%s has no field %s" name k;
         Hashtbl.add seen k v)
      kvs;
    (* Omitted fields are zeroed — ZII, the same rule as a declaration with no
       initialiser (plan.org, Data model). Every field is present from here on,
       in declaration order, so no backend has to know about omission. *)
    let fields =
      map_lr
        (fun (f : Tast.field) ->
           match Hashtbl.find_opt seen f.Tast.fname with
           | Some v -> check ctx ~want:f.Tast.fty v
           | None -> mk loc f.Tast.fty (Tast.Zero f.Tast.fty))
        s.Tast.fields
    in
    expect loc ~want (mk loc (Types.Named name) (Tast.Make (name, fields)))

(* [(U {.member v})] — an untagged union value.

   At most one member, because the members are one storage: giving two would
   be writing two values over each other and the result would be whichever the
   compiler happened to store last. That is a real question with no answer, so
   it is refused rather than ordered. Giving none is the ordinary ZII value and
   is all-bytes-zero, the same as a struct with every field omitted.

   The one member is lowered here into a zeroed temporary and a store, rather
   than into a node of its own. A union value *is* a store into overlaid
   storage — [Set] over [Pfield] is exactly that operation and every backend
   already has it — so a [MakeUnion] node would have been the same three
   instructions written a fourth and fifth time, in each backend, with the
   layout rule spelled out again in each. Nothing downstream learns anything
   new from this form. *)
and check_union ctx ~want loc name kvs =
  let u = Hashtbl.find ctx.env.unions name in
  List.iter
    (fun (k, (v : Ast.expr)) ->
       if Tast.field_index u k = None then
         Loc.failk "check/unknown-field" v.Ast.loc
           ~notes:(declared_note ctx.env name)
           "%s has no member %s" name k)
    kvs;
  let seen = Hashtbl.create 8 in
  List.iter
    (fun (k, (v : Ast.expr)) ->
       (* Before the two-member refusal below, so [(U {.i 1 .i 2})] is told it
          named one member twice rather than that [i] and [i] are the same
          bytes — which is true and useless. Same words and same note as the
          struct path, because it is the same mistake. *)
       (match Hashtbl.find_opt seen k with
        | Some (first : Ast.expr) ->
          Loc.failk "check/duplicate-field" v.Ast.loc
            ~notes:[ Loc.note first.Ast.loc (k ^ " is given here first") ]
            "member %s is given twice" k
        | None -> ());
       Hashtbl.add seen k v)
    kvs;
  (match kvs with
   | (a, _) :: (b, (second : Ast.expr)) :: _ ->
     Loc.failk "check/union-two-members" second.Ast.loc
       "%s is a union, so %s and %s are the same bytes and only one of them \
        can be written — give the one this value is, and read the other \
        member when you want to see those bytes that way"
       name a b
   | _ -> ());
  match kvs with
  (* The two-member case left above, so this sees one or none. *)
  | _ :: _ :: _ -> assert false
  | [] -> expect loc ~want (mk loc (Types.Named name) (Tast.Zero (Types.Named name)))
  | [ (k, v) ] ->
    let i = Option.get (Tast.field_index u k) in
    let fty = (List.nth u.Tast.fields i).Tast.fty in
    let v = check ctx ~want:fty v in
    let slot = fresh_slot ctx (Types.Named name) in
    let here = mk loc (Types.Named name) (Tast.Local slot) in
    expect loc ~want
      (mk loc (Types.Named name)
         (Tast.Let
            ([ (slot, mk loc (Types.Named name) (Tast.Zero (Types.Named name))) ],
             [ mk loc Types.Unit (Tast.Set (Tast.Pfield (here, i), v)); here ])))

(* The cases of a data type, as written, for a message that has to name them. *)
and case_list env dname =
  match Hashtbl.find_opt env.datas dname with
  | None -> "its cases"
  | Some u ->
    String.concat ", "
      (List.map (fun (c : Tast.variant) -> dname ^ "." ^ c.Tast.vname)
         u.Tast.cases)

and first_case_name env dname =
  match Hashtbl.find_opt env.datas dname with
  | Some { Tast.cases = c :: _; _ } -> c.Tast.vname
  | _ -> "Case"

(* [(U.C {.f v ...})]. The fields are checked and filled in exactly as a
   struct's are — same ZII, same duplicate and unknown-field refusals — and the
   only difference is the node at the end and the type it carries. *)
and check_case ctx ~want loc dname (c : Tast.variant) kvs =
  let full = dname ^ "." ^ c.Tast.vname in
  let seen = Hashtbl.create 8 in
  List.iter
    (fun (k, (v : Ast.expr)) ->
       (match Hashtbl.find_opt seen k with
        | Some (first : Ast.expr) ->
          Loc.failk "check/duplicate-field" v.Ast.loc
            ~notes:[ Loc.note first.Ast.loc (k ^ " is given here first") ]
            "field %s is given twice" k
        | None -> ());
       if Tast.vfield_index c k = None then
         Loc.failk "check/unknown-field" v.Ast.loc
           ~notes:(declared_note ctx.env dname)
           "%s has no field %s" full k;
       Hashtbl.add seen k v)
    kvs;
  let fields =
    map_lr
      (fun (f : Tast.field) ->
         match Hashtbl.find_opt seen f.Tast.fname with
         | Some v -> check ctx ~want:f.Tast.fty v
         | None -> mk loc f.Tast.fty (Tast.Zero f.Tast.fty))
      c.Tast.vfields
  in
  expect loc ~want
    (mk loc (Types.Named dname) (Tast.MakeCase (dname, c.Tast.vname, fields)))

and check_arr ctx ~want loc items =
  let elem_want =
    match want with
    | Some (Types.Array (_, t)) -> Some t
    | Some (Types.Slice t) -> Some t
    | _ -> None
  in
  let items = map_lr (fun i -> check ctx ?want:elem_want i) items in
  let n = Int64.of_int (List.length items) in
  let elem =
    match elem_want, items with
    | Some t, _ -> t
    | None, first :: _ -> first.Tast.ty
    | None, [] ->
      fail loc "an empty array literal needs a type — annotate the binding"
  in
  List.iter
    (fun (i : Tast.expr) ->
       if not (Types.fits ~expected:elem ~actual:i.Tast.ty) then
         fail i.Tast.loc "this array's elements are %s, but this one is %s"
           (Types.to_string elem) (Types.to_string i.Tast.ty))
    items;
  (match want with
   | Some (Types.Array (m, _)) when not (Int64.equal m n) ->
     fail loc "expected %Ld elements, found %Ld" m n
   | _ -> ());
  (* [n T] and [T] are distinct in type and in ownership (spec-memory.md), so
     an array literal does not satisfy a slice expectation. *)
  expect loc ~want (mk loc (Types.Array (n, elem)) (Tast.Arr items))

and check_match ctx ?(tail = false) ?want loc scrutinee arms =
  let s = check ctx scrutinee in
  (* What the arms are alternatives over. An [Option] is a two-case data type
     wearing a special coat, so the two shapes below are the same shape: a set
     of case names, an arity and a payload type per case, and a tag. Keeping
     them apart here rather than desugaring [Option] into a declared data type is
     deliberate — [Option] is generic and no declared data type is, so the coat is
     the part that cannot yet be taken off. *)
  let subject =
    match s.Tast.ty with
    | Types.Option t -> `Option t
    | Types.Named n when Hashtbl.mem ctx.env.datas n ->
      `Data (Hashtbl.find ctx.env.datas n)
    (* An enum is the one scrutinee that is not a milestone away: it is an i32
       at run time and its members are all known, so the arms would be a chain
       of [=] with an exhaustiveness check over [env.enums] — a desugaring, not
       a new IR node. What blocks it is upstream of here: a keyword has no case
       in [Ast.pattern], and [lib/load.ml] matches that type exhaustively, so
       the variant cannot be added. Said as itself rather than folded into the
       milestone answer below, because the milestone is not the reason. *)
    | Types.Enum n ->
      fail loc
        "match over the enum %s is not implemented — the lowering is a chain \
         of (= k :member), but a keyword has no case in the pattern type yet. \
         Use cond" n
    (* An untagged union has nothing for the arms to be alternatives over.
       This is not a milestone and not a missing lowering: [match] reads a tag
       and decides, and the absence of a tag is the whole definition of this
       type. Said by name, because the two kinds of union are one keyword
       apart in the source and someone will write it. *)
    | Types.Named n when Hashtbl.mem ctx.env.unions n ->
      fail loc
        "%s is a union, and there is nothing in one to match on: its members \
         overlay the same bytes and nothing records which was written. Read \
         the member you mean with (.member u), or keep a tag of your own \
         beside it in a struct and match on that. A tagged alternative is \
         what defdata is" n
    | other ->
      fail loc "match works on an Option or a data type, not on %s"
        (Types.to_string other)
  in
  (* Which case each arm names, and the type of each name it binds. This is the
     whole of what differs between the two subjects; everything below it is
     shared. *)
  let resolve_pat (a : Ast.arm) =
    match subject, a.Ast.pat with
    | _, Ast.Pwild -> None, []
    | `Option elem, Ast.Pctor ("Some", [ x ]) -> Some "Some", [ (x, elem) ]
    | `Option _, Ast.Pctor ("Some", _) ->
      fail a.Ast.aloc "the Some pattern binds exactly one name"
    | `Option _, Ast.Pctor ("None", []) -> Some "None", []
    | `Option _, Ast.Pctor ("None", _) -> fail a.Ast.aloc "None binds no names"
    | `Option _, Ast.Pctor (c, _) ->
      fail a.Ast.aloc
        "%s is not a case of Option — the cases are Some and None" c
    | `Data u, Ast.Pctor (c, names) ->
      (* A pattern names the case bare: the scrutinee's type already says which
         data type, so [(Node l r)] is unambiguous even where two data types
         share the case name. The qualified spelling is accepted too, since
         that is how
         the value was written and writing it again should not be an error. *)
      let bare =
        let full = u.Tast.dname ^ "." in
        let n = String.length full in
        if String.length c > n && String.sub c 0 n = full then
          String.sub c n (String.length c - n)
        else c
      in
      (match Tast.case_index u bare with
       | None ->
         fail a.Ast.aloc "%s is not a case of %s — the cases are %s" c
           u.Tast.dname
           (String.concat ", "
              (List.map (fun (v : Tast.variant) -> v.Tast.vname) u.Tast.cases))
       | Some (_, v) ->
         (* Positional, in declaration order, and all of them or none: a
            pattern that bound some of a case's fields would be silently
            reading the wrong one after a field is inserted. Refused with the
            count, which is the thing that is wrong. *)
         if List.length names <> List.length v.Tast.vfields then
           fail a.Ast.aloc
             "%s.%s has %d field%s, and this pattern binds %d — a case pattern \
              binds every field, in declaration order (%s)"
             u.Tast.dname bare (List.length v.Tast.vfields)
             (if List.length v.Tast.vfields = 1 then "" else "s")
             (List.length names)
             (String.concat " "
                (List.map (fun (f : Tast.field) -> f.Tast.fname)
                   v.Tast.vfields));
         Some bare,
         List.map2 (fun n (f : Tast.field) -> (n, f.Tast.fty))
           names v.Tast.vfields)
  in
  let want = ref want in
  let seen = Hashtbl.create 8 in
  let saw_wild = ref false in
  let arms =
    map_lr
      (fun (a : Ast.arm) ->
         let ctor, binds = resolve_pat a in
         (match ctor with
          | None -> saw_wild := true
          | Some c ->
            if Hashtbl.mem seen c then
              fail a.Ast.aloc "this match has two %s arms" c;
            Hashtbl.add seen c ());
         branch ctx (fun () ->
           let binds =
             List.map
               (fun (n, ty) -> bind ctx n ty ~assignable:false) binds
           in
           (* Every arm is the tail, exactly as an [if]'s two arms are.
              Restored here because checking the scrutinee withdrew it. *)
           ctx.tail <- tail;
           let body = block ctx ?want:!want a.Ast.aloc a.Ast.body in
           if !want = None && body.Tast.ty <> Types.Never then
             want := Some body.Tast.ty;
           { Tast.acase = ctor; binds; abody = [ body ] }))
      arms
  in
  (* Exhaustiveness is refused, not defaulted. A match that silently fell
     through would have to produce a value of the match's type out of nothing,
     and there is no such value for most types; and the case a data type grows
     tomorrow is exactly the one a reader wants to be told about today. A [_]
     arm is the way to say "the rest", written where it can be seen. *)
  let missing =
    match subject with
    | `Option _ -> List.filter (fun c -> not (Hashtbl.mem seen c)) [ "Some"; "None" ]
    | `Data u ->
      List.filter_map
        (fun (c : Tast.variant) ->
           if Hashtbl.mem seen c.Tast.vname then None
           else Some (u.Tast.dname ^ "." ^ c.Tast.vname))
        u.Tast.cases
  in
  if not !saw_wild && missing <> [] then
    (* The data type's declaration, because that is where the case list this match
       failed to cover actually lives, and because adding a case there is what
       makes a match non-exhaustive in the first place. *)
    Loc.failk "check/non-exhaustive-match" loc
      ~notes:(match subject with `Data u -> declared_note ctx.env u.Tast.dname
                               | _ -> [])
      "this match is not exhaustive — %s %s no arm. Add %s, or a _ arm for \
       the rest"
      (String.concat ", " missing)
      (if List.length missing = 1 then "has" else "have")
      (if List.length missing = 1 then "it" else "them");
  let ty = match !want with Some t -> t | None -> Types.Never in
  mk loc ty (Tast.Match (s, arms))

(* ── Places ────────────────────────────────────────────────────────── *)

(* The fields a name has, whether it is a struct or an untagged union. The two
   are one record and differ only in what the offsets come out as, which is a
   question for the layout and not for this — so [.x] is one path and not two,
   and a union member is read with the accessor everything else is read with.
   That is the whole of what makes punning ordinary code. *)
and fields_named env n : Tast.structure option =
  match Hashtbl.find_opt env.structs n with
  | Some s -> Some s
  | None -> Hashtbl.find_opt env.unions n

(* The target of [.field] is a struct or an untagged union, or one level of
   pointer to one. The auto-deref is inserted here as a real node, so no
   backend re-derives it. *)
and struct_target ctx (target : Ast.expr) : Tast.expr * string =
  let t = check ctx target in
  let has n = fields_named ctx.env n <> None in
  match t.Tast.ty with
  | Types.Named n when has n -> t, n
  | Types.Ptr (Types.Named n) when has n ->
    mk t.Tast.loc (Types.Named n) (Tast.Deref t), n
  (* A data type's fields belong to one case, and which case it is holding is
     only known after the tag has been read. [.field] would have to be a read
     that might be reading something else, so it is not one: [match] is how a
     data type is opened, and it binds the fields it has proved are there. *)
  | (Types.Named n | Types.Ptr (Types.Named n))
    when Hashtbl.mem ctx.env.datas n ->
    fail target.Ast.loc
      "%s is a data type, and a data type's fields belong to a case — which \
       one it is holding is what the tag says, so they are reached by (match ...), \
       whose arms bind the fields of the case they matched"
      n
  | other ->
    fail target.Ast.loc "%s is not a struct, so it has no fields"
      (Types.to_string other)

and check_place ctx loc (p : Ast.place) : Tast.place * Types.t =
  match p with
  | Ast.Pvar name ->
    (match lookup ctx name with
     | Some b ->
       if not b.assignable then
         fail loc
           "%s is a parameter, and parameters are not assignable places \
            (spec-memory.md) — bind a local with let" name;
       Tast.Plocal b.slot, b.bty
     | None ->
       match Hashtbl.find_opt ctx.env.globals name with
       | Some (_, true) -> fail loc "%s is a constant" name
       | Some (ty, false) -> Tast.Pglobal name, ty
       | None -> captured ctx loc name;
         Loc.failk "check/unknown-name" loc "unknown name %s" name)
  | Ast.Pfield (target, name) ->
    let target, sname = struct_target ctx target in
    let s = Option.get (fields_named ctx.env sname) in
    (match Tast.field_index s name with
     | None ->
       Loc.failk "check/unknown-field" loc ~notes:(declared_note ctx.env sname)
         "%s has no field %s" sname name
     | Some i -> Tast.Pfield (target, i), (List.nth s.Tast.fields i).Tast.fty)
  | Ast.Pindex (target, idx) ->
    let target = check ctx target in
    (match target.Tast.ty with
     (* The same bounds and epoch check the value form gets, through the same
        helper: an element of a Vec is a place because a Vec element is
        assignable, and a set that skipped the checks would be the asymmetry
        [nth] was removed for. *)
     | Types.Vec _ ->
       let p, ty = vec_at ctx loc target idx in
       Tast.Pderef p, ty
     | _ ->
       let idx, ty = indexed ctx target idx in
       Tast.Pindex (target, idx), ty)
  | Ast.Pderef target ->
    let target = check ctx target in
    (match target.Tast.ty with
     | Types.Ptr t -> Tast.Pderef target, t
     | other ->
       fail loc "deref takes a (Ptr T), found %s" (Types.to_string other))

(* An index or a slice bound that is a literal is known now, so it is an error
   now rather than a trap later. Only literals: a [defconst] is a global in the
   typed IR, not a folded constant, so [(at arr size)] still traps at runtime —
   which is what the emitted bounds check is for. A negative literal is wrong
   whatever the target, but a length is static only for [n T]. *)
and static_index loc (ty : Types.t) ~past_end what k =
  if k < 0L then
    fail loc "%s %Ld is negative — indices count from 0" what k;
  match ty with
  (* [past_end] is the difference between an index and a slice bound: the last
     valid index is len - 1, but a slice may end at len. *)
  | Types.Array (n, _) when if past_end then k > n else k >= n ->
    fail loc "%s %Ld is out of bounds for length %Ld" what k n
  | _ -> ()

(* The literal value of a checked expression, if it has one. *)
and literal (e : Tast.expr) =
  match e.Tast.e with Tast.Int (k, _) -> Some k | _ -> None

(* An index is [i32] internally, but a *narrower* integer may be written as
   one: indexing is not arithmetic on the value, so there is nothing for a
   visible cast to warn about, and requiring (i32 c) at every subscript would
   be noise. A u32 is included because it cannot lose a value the bounds check
   would then miss — anything above 2^31 truncates to a negative i32, which
   the unsigned comparison rejects. i64 and u64 are not: 2^32 + 5 truncates to
   5 and would read the wrong element with no trap at all, so those need the
   cast written out. *)
and index_expr ctx (e : Ast.expr) =
  (* No [want]: an expectation of [i32] would reject a [u32] index outright,
     before there is anything here to convert. An untyped literal still
     defaults to [i32] on its own. *)
  let v = check ctx e in
  match v.Tast.ty with
  | Types.Int Types.I32 -> v
  | Types.Int k when Types.bits k <= 32 ->
    { v with Tast.ty = index_ty;
             Tast.e = Tast.Prim (Tast.Cast index_ty, [ v ]) }
  | Types.Int k ->
    fail e.Ast.loc
      "an index is an i32, and %s is wider — write (i32 …), because a value \
       that does not fit truncates to one that does and would read the wrong \
       element without tripping the bounds check" (Types.ikind_name k)
  | other ->
    fail e.Ast.loc "an index is an integer, found %s" (Types.to_string other)

(* [(at a i)] and [(at grid row col)]: one index per dimension. *)
and indexed ctx (target : Tast.expr) (idx : Ast.expr list) =
  let rec go ty = function
    | [] -> [], ty
    | i :: rest ->
      let elem =
        match ty with
        | Types.Array (_, t) | Types.Slice t -> t
        | other ->
          fail i.Ast.loc "%s cannot be indexed" (Types.to_string other)
      in
      let loc = i.Ast.loc in
      let i = index_expr ctx i in
      (match literal i with
       | Some k -> static_index loc ty ~past_end:false "index" k
       | None -> ());
      let rest, ty = go elem rest in
      i :: rest, ty
  in
  go target.Tast.ty idx

(* ── Calls ─────────────────────────────────────────────────────────── *)

and check_call ctx ~want loc (head : Ast.expr) (args : Ast.expr list) =
  match head.Ast.e with
  | Ast.Var name -> named_call ctx ~want loc name args
  (* A computed head: ((choose k) 3). The head is an ordinary expression and
     the only thing asked of it is that it be a function. *)
  | _ -> call_value ctx ~want loc (check ctx head) args

(* The indirect call, once the callee is checked. Shared by the computed head
   above and by a name that resolved to a local or a parameter of function
   type, which is the shape every caller of [map] has. *)
and call_value ctx ~want loc (callee : Tast.expr) args =
  match callee.Tast.ty with
  | Types.Fn (params, ret) ->
    if List.length args <> List.length params then
      fail loc "this function value takes %d argument%s, given %d"
        (List.length params)
        (if List.length params = 1 then "" else "s")
        (List.length args);
    let args = map2_lr (fun p a -> check ctx ~want:p a) params args in
    expect loc ~want (mk loc ret (Tast.CallPtr (callee, args)))
  | other ->
    fail loc "this is a %s and not a function, so it cannot be called"
      (Types.to_string other)

and arity loc name n args =
  if List.length args <> n then
    fail loc "%s takes %d argument%s, given %d" name n
      (if n = 1 then "" else "s") (List.length args)

(* The operators that fold: [+ - * /], [min]/[max] and the three bitwise
   combining operators all take two operands or more, and mean the same thing
   applied left to right. [%] and the shifts are not in that set — a chain of
   remainders or of shifts has no reading a reader would agree on in advance,
   so there the arity error is the useful answer.

   Two is the floor, and the two missing cases are refused rather than
   invented. Zero operands would have to mean an identity element, 0 for + and
   1 for *, and a sum with no terms in it is a typo far more often than it is
   an intent. One operand would have to mean negation for [-] and reciprocal
   for [/], and this language has no unary minus anywhere: the prelude writes
   every negation as [(- 0 n)] or [(- 0.0 x)], and [(- x)] meaning something
   else than the [-] two lines above it is a rule a reader has to carry rather
   than see. *)
and fold_arity loc name args =
  match args with
  | _ :: _ :: _ -> ()
  | [ _ ] when String.equal name "-" ->
    fail loc
      "- takes two arguments or more, given 1 — there is no unary minus; \
       write (- 0 x) to negate, which is what the prelude does"
  | [ _ ] when String.equal name "/" ->
    fail loc
      "/ takes two arguments or more, given 1 — there is no reciprocal; \
       write (/ 1.0 x)"
  | _ ->
    fail loc "%s takes two arguments or more, given %d" name (List.length args)

(* The first two operands decide the type — [binary] picks which of them is
   allowed to, and that decision is not re-made per pair — and every operand
   after them is checked against it. *)
and fold_left_prim ctx ~want loc name p ok what args =
  let x, y, rest =
    match args with x :: y :: rest -> x, y, rest | _ -> assert false
  in
  let a, b = binary ctx name loc ~want:(numeric_want want) [ x; y ] in
  unconstrained ctx.env loc name ~needs:"numeric?" a.Tast.ty;
  (* Past [unconstrained] a variable here is one the [where] clause admitted,
     so the concrete predicate below has nothing to say about it — it is
     answered again, per copy, at the instantiation. *)
  if not (ok a.Tast.ty || generic_ty a.Tast.ty) then
    fail loc "%s takes %s, found %s" name what (Types.to_string a.Tast.ty);
  let ty = a.Tast.ty in
  let acc =
    List.fold_left
      (fun acc arg ->
         mk loc ty (Tast.Prim (p, [ acc; check ctx ~want:ty arg ])))
      (mk loc ty (Tast.Prim (p, [ a; b ])))
      rest
  in
  expect loc ~want acc

(* ── Allocation failure, spec-memory.md ────────────────────────────────
   No allocating operation returns an error and none can fail silently. When
   the allocator cannot satisfy a request the operation signals

     (StorageExhausted {.bytes n .align a .allocator id})

   with [error] — whose type is Never — inside a [restart-case] offering
   [retry]. That is one rule over every allocating operation, which is what
   keeps [push] and [reserve] at Unit, [clone] at the container, and no
   signature anywhere growing a Result. Odin's [append] returns an ignorable
   Allocator_Error and its type-erased path returns the old length on a failed
   reserve; an append that appends nothing and says nothing is the outcome this
   rule exists to make impossible.

   It is *compiler-emitted at the point of failure*, which spec-memory.md names
   as the exception to plan.org's "restarts go at the resync point, once": a
   restart established at a parser's top-level loop cannot re-attempt an
   allocation, and only the allocation site can.

   The shape is built out of nodes that already exist — a while, a restart-case
   and an error — so the backend learns nothing new about allocation:

     (let [ok false]
       (while (not ok)
         (restart-case
           (do (set ok ATTEMPT)
               (if (not ok) (error (StorageExhausted {...}))))
           (retry []))))

   A handler that frees something, releases a scratch region or grows the arena
   and then invokes [retry] lands in the clause, the clause falls through, and
   the while re-tests and re-attempts the *same* request. With nothing handling
   it, [error] stops the program on the frame that erred, as §2 says.

   [attempt] must be a call that can be repeated: every argument to it is bound
   to a slot before the loop, so a retry does not re-evaluate the element
   expression a push was given. *)
and alloc_guard ctx loc (attempt : Tast.expr) =
  let ok = fresh_slot ctx Types.Bool in
  let okv = mk loc Types.Bool (Tast.Local ok) in
  let notok () = mk loc Types.Bool (Tast.Prim (Tast.Not, [ okv ])) in
  let i8 n = mk loc (Types.Int Types.I8) (Tast.Int (n, Types.I8)) in
  (* The runtime answers 1 or 0 and never reports failure any other way. *)
  let attempt = mk loc Types.Bool (Tast.Prim (Tast.Ne, [ attempt; i8 0L ])) in
  (* A value struct on the signalling frame's stack, with fixed numeric fields
     and no rendered message: formatting would allocate, and this is the one
     path that must not. Rendering happens in the handler or the break loop,
     where a working allocator is known. *)
  let cond =
    mk loc (Types.Named "StorageExhausted")
      (Tast.Make
         ("StorageExhausted",
          [ rt loc (Types.Int Types.I64) "flan_alloc_fail_bytes" [];
            rt loc (Types.Int Types.I64) "flan_alloc_fail_align" [];
            rt loc (Types.Int Types.I64) "flan_alloc_fail_id" [] ]))
  in
  let signal =
    mk loc Types.Never
      (Tast.Signal (Tast.Serror, type_id "StorageExhausted", cond))
  in
  let attempt_then_signal =
    mk loc Types.Unit
      (Tast.Do
         [ mk loc Types.Unit (Tast.Set (Tast.Plocal ok, attempt));
           mk loc Types.Unit (Tast.If (notok (), signal, unit_at loc)) ])
  in
  let clause =
    (* Compiler-emitted, so it takes no parameters: nothing outside can hand
       this one a value. [rsig] is therefore the empty signature, and its hash
       the same one a written [(retry [] ...)] gets — the two must agree, since
       an [invoke-restart] cannot tell them apart. *)
    let sg = restart_sig [] in
    { Tast.rname_id = type_id "retry"; rname = "retry"; rparams = [];
      rsig = sg; rsig_id = type_id sg; rbody = [ unit_at loc ] }
  in
  let body =
    mk loc Types.Unit (Tast.RestartCase ([ clause ], attempt_then_signal))
  in
  mk loc Types.Unit
    (Tast.Let ([ (ok, mk loc Types.Bool (Tast.Bool false)) ],
               [ mk loc Types.Unit (Tast.While (notok (), [ body ], [])) ]))

(* ── File failure, decisions 2 and 5 ───────────────────────────────────
   The same shape [alloc_guard] has, for the same reason and out of the same
   nodes: the operation signals inside a [restart-case] it establishes itself,
   so nothing anywhere grows a Result and neither [slurp] nor [barf] can fail
   silently. Compiler-emitted at the point of failure, which spec-memory.md
   already names as the exception to plan.org's "restarts go at the resync
   point, once" — a restart at an outer loop cannot re-open a file.

   Two restarts, and they are the textbook pair Common Lisp establishes for a
   file-error:

     retry              the file may be there now — the handler made a
                        directory, mounted something, or waited.
     use-value [p string]   try this other path instead.

   [use-value]'s parameter *is* the path slot, so the clause body is [unit]:
   emit.ml's [bind_params] stores the invoker's argument straight into the slot
   the attempt reads, the clause falls through, and the while re-tests and
   re-attempts against the new path. Typed restarts landed this session and
   this is the first thing the compiler itself emits one for.

   [attempt] must be repeatable, so the path is a slot read at each turn of the
   loop rather than an expression re-evaluated. *)
and file_guard ctx loc ~path_slot ~op mk_steps =
  let ok = fresh_slot ctx Types.Bool in
  let okv = mk loc Types.Bool (Tast.Local ok) in
  let notok () = mk loc Types.Bool (Tast.Prim (Tast.Not, [ okv ])) in
  let i8 n = mk loc (Types.Int Types.I8) (Tast.Int (n, Types.I8)) in
  (* Fixed fields and no rendered message, exactly as StorageExhausted: the
     condition is built on the failing frame's stack and formatting is the
     handler's job. [path] is whatever the attempt last used, so a handler that
     supplied one through [use-value] sees the path that actually failed. *)
  let cond =
    mk loc (Types.Named "FileError")
      (Tast.Make
         ("FileError",
          [ mk loc Types.String (Tast.Local path_slot);
            mk loc (Types.Int Types.I32) (Tast.Int (Int64.of_int op, Types.I32));
            mk loc (Types.Int Types.I32)
              (Tast.Prim (Tast.Cast (Types.Int Types.I32),
                          [ rt loc (Types.Int Types.I64)
                              "flan_file_fail_reason" [] ])) ]))
  in
  let signal () =
    mk loc Types.Never (Tast.Signal (Tast.Serror, type_id "FileError", cond))
  in
  (* One step of the attempt: run the runtime call, record whether it worked,
     and signal if it did not. The last step a caller gives is what leaves [ok]
     true, which is what stops the loop. *)
  let try_ (attempt : Tast.expr) =
    mk loc Types.Unit
      (Tast.Do
         [ mk loc Types.Unit
             (Tast.Set (Tast.Plocal ok,
                        mk loc Types.Bool (Tast.Prim (Tast.Ne, [ attempt; i8 0L ]))));
           mk loc Types.Unit (Tast.If (notok (), signal (), unit_at loc)) ])
  in
  let clause name params =
    let sg = restart_sig (List.map snd params) in
    { Tast.rname_id = type_id name; rname = name; rparams = params;
      rsig = sg; rsig_id = type_id sg; rbody = [ unit_at loc ] }
  in
  let body =
    mk loc Types.Unit
      (Tast.RestartCase
         ([ clause "retry" [];
            clause "use-value" [ (path_slot, Types.String) ] ],
          mk loc Types.Unit (Tast.Do (mk_steps try_))))
  in
  mk loc Types.Unit
    (Tast.Let ([ (ok, mk loc Types.Bool (Tast.Bool false)) ],
               [ mk loc Types.Unit (Tast.While (notok (), [ body ], [])) ]))

(* Is this bare symbol the name of a type? Every table [resolve_name] will look
   in, and the data type table is one of them: a data type is [Named] exactly as a
   struct is, so (vec-new Form) is as ordinary as (vec-new Cell). It was left
   out when data types landed, which made the prelude's own (vec-new Form) fail
   with "nothing here says what (vec-new) is a Vec of" — a message about a
   missing annotation for a program that had written one. One list, read by
   both callers, so the next kind of type added cannot be added to one of
   them. *)
and type_named ctx n =
  (* A type variable names a type here too, which is what lets [(vec-new t)]
     be written in a generic body: inside an instantiation [resolve_name]
     answers with the concrete element type, and during the abstract pass it
     answers [Var t] and the [Vec] that comes back is a [(Vec t)] — generic,
     and refused by anything that needs a size. *)
  List.mem n ctx.env.tyvars
  || List.mem_assoc n ctx.env.subst
  || List.mem n Types.primitive_names
  || Hashtbl.mem ctx.env.structs n
  || Hashtbl.mem ctx.env.datas n
  || Hashtbl.mem ctx.env.unions n
  || Hashtbl.mem ctx.env.enums n
  || Hashtbl.mem ctx.env.aliases n

(* The element type for [vec-new]: a leading bare symbol naming a type, or the
   expectation at the site. A bare symbol shadowed by a local or a global is
   that binding — an allocator, in practice — and not a type. *)
and vec_new_elem ctx ~want loc args =
  let named =
    match args with
    | { Ast.e = Ast.Var n; _ } :: rest
      when lookup ctx n = None
        && (not (Hashtbl.mem ctx.env.globals n))
        && type_named ctx n ->
      Some (resolve_name ctx.env ~seen:[] loc n, rest)
    | _ -> None
  in
  match named with
  | Some (t, rest) -> t, rest
  | None ->
    (match want with
     | Some (Types.Vec t) -> t, args
     | _ ->
       fail loc
         "nothing here says what (vec-new) is a Vec of — write the element \
          type, as (vec-new i32), or give the binding a type")

(* The key and value types, or the reason this is not a Map. *)
and map_kv loc what (t : Types.t) =
  match t with
  | Types.Map (k, v) -> k, v
  | other -> fail loc "%s takes a (Map K V), found %s" what (Types.to_string other)

(* The key and value for [map-new]: two leading bare symbols naming types, or
   the expectation at the site. The same rule [vec-new] uses, with the same
   escape for a symbol that is really a binding — an allocator, in practice —
   and the pair is written together or not at all, because (map-new string)
   says half of a type and half is not a type. *)
and map_new_types ctx ~want loc args =
  let is_type n =
    lookup ctx n = None
    && (not (Hashtbl.mem ctx.env.globals n))
    && type_named ctx n
  in
  match args with
  | { Ast.e = Ast.Var k; _ } :: { Ast.e = Ast.Var v; _ } :: rest
    when is_type k && is_type v ->
    resolve_name ctx.env ~seen:[] loc k, resolve_name ctx.env ~seen:[] loc v, rest
  | { Ast.e = Ast.Var k; _ } :: rest when is_type k && rest = [] ->
    fail loc
      "(map-new %s) names a key and no value — write both, as (map-new %s \
       i32), or give the binding a type" k k
  | _ ->
    (match want with
     | Some (Types.Map (k, v)) -> k, v, args
     | _ ->
       fail loc
         "nothing here says what (map-new) maps — write the key and value \
          types, as (map-new string i32), or give the binding a type")

(* The element type, or the reason this is not a Vec. *)
and vec_elem loc what (t : Types.t) =
  match t with
  | Types.Vec e -> e
  | other -> fail loc "%s takes a (Vec T), found %s" what (Types.to_string other)

(* The allocator an operation uses: the one named at the site, or the current
   implicit one. spec-memory.md: an operation never falls back to a hidden
   global allocator, and an explicit allocator can override the context. *)
and allocator_arg ctx loc = function
  | [] -> rt loc Types.Alloc "flan_context_allocator" []
  | [ a ] -> check ctx ~want:Types.Alloc a
  | _ -> fail loc "at most one allocator may be named here"

(* The address of an element, bounds-checked, with the allocator's epoch
   checked first. Both the value form [(at v i)] and the place form
   [(set (at v i) x)] come through here, so they cannot drift apart — which is
   the asymmetry [nth] was removed for. *)
and vec_at ctx loc (target : Tast.expr) (idx : Ast.expr list) =
  let elem = vec_elem loc "at" target.Tast.ty in
  match idx with
  | [ i ] ->
    let i = index_expr ctx i in
    rt loc (Types.Ptr elem) "flan_vec_at"
      [ target; i; size_of loc elem; here loc ], elem
  | _ ->
    fail loc
      "a Vec takes exactly one index — (at v i) — and its element is indexed \
       separately"

(* Every arm below is a name an editor can be asked about and no program ever
   wrote down, so each one needs a line in [builtins] further down this file.
   A new arm without an entry fails the build — test_flan reads both. *)
and named_call ctx ~want loc name args =
  let prim p ty args = expect loc ~want (mk loc ty (Tast.Prim (p, args))) in
  match name with
  (* ── arithmetic and comparison ─────────────────────────────────── *)
  | "+" | "-" | "*" | "/" ->
    let p = match name with
      | "+" -> Tast.Add | "-" -> Tast.Sub | "*" -> Tast.Mul
      | _ -> Tast.Div
    in
    fold_arity loc name args;
    fold_left_prim ctx ~want loc name p Types.is_numeric "numbers" args
  (* Remainder stays at two: (% a b c) is (% (% a b) c), which is a thing
     nobody writes on purpose. *)
  | "%" ->
    arity loc name 2 args;
    let a, b = binary ctx name loc ~want:(numeric_want want) args in
    unconstrained ctx.env loc name ~needs:"numeric?" a.Tast.ty;
    if not (Types.is_numeric a.Tast.ty || generic_ty a.Tast.ty) then
      fail loc "%s takes numbers, found %s" name (Types.to_string a.Tast.ty);
    prim Tast.Rem a.Tast.ty [ a; b ]
  | "=" | "!=" | "<" | "<=" | ">" | ">=" ->
    let p = match name with
      | "=" -> Tast.Eq | "!=" -> Tast.Ne | "<" -> Tast.Lt
      | "<=" -> Tast.Le | ">" -> Tast.Gt | _ -> Tast.Ge
    in
    arity loc name 2 args;
    let a, b = binary ctx name loc ~want:None args in
    (* [=] and [!=] admit one type [<] does not: a handle, which is a pair of
       numbers in one word and where "the same entity" is the question the
       type exists to answer. Ordering handles would order a slot index, which
       is a free-list artefact and means nothing. *)
    let ok =
      match name with
      | "=" | "!=" -> Types.is_equatable a.Tast.ty
      | _ -> Types.is_comparable a.Tast.ty
    in
    unconstrained ctx.env loc name
      ~needs:(match name with "=" | "!=" -> "equal?" | _ -> "ordered?")
      a.Tast.ty;
    if not (ok || generic_ty a.Tast.ty) then
      fail loc
        "%s compares machine numbers; %s has no built-in comparison \
         (plan.org, Types)" name (Types.to_string a.Tast.ty);
    prim p Types.Bool [ a; b ]
  | "not" ->
    arity loc name 1 args;
    prim Tast.Not Types.Bool [ check ctx ~want:Types.Bool (List.hd args) ]
  (* Bitwise operators are integers-only, and the shift count has the same type
     as the value shifted — there is no implicit widening anywhere else either. *)
  | "bit-and" | "bit-or" | "bit-xor" ->
    let p = match name with
      | "bit-and" -> Tast.BitAnd | "bit-or" -> Tast.BitOr
      | _ -> Tast.BitXor
    in
    fold_arity loc name args;
    fold_left_prim ctx ~want loc name p
      (function Types.Int _ -> true | _ -> false) "integers" args
  (* The shifts stay at two, and not only because a shift chain reads badly:
     each count would be checked against the same width below, so (<< x 30 30)
     would pass two legal shifts and still shift the value away entirely. *)
  | "<<" | ">>" ->
    let p = if String.equal name "<<" then Tast.Shl else Tast.Shr in
    arity loc name 2 args;
    let a, b = binary ctx name loc ~want:(numeric_want want) args in
    (match a.Tast.ty with
     | Types.Int _ -> ()
     | other -> fail loc "%s takes integers, found %s" name
                  (Types.to_string other));
    (* A shift by the operand's own width or more is poison in LLVM, which at
       -O2 turns the whole function into an undefined value rather than into a
       wrong number. A literal count is rejected here — that is the typo — and
       [emit] masks a computed one, so no shift can reach the hardware out of
       range. *)
    (match a.Tast.ty, b.Tast.e with
     | Types.Int k, Tast.Int (n, _) when p = Tast.Shl || p = Tast.Shr ->
       let w = Int64.of_int (Types.bits k) in
       if Int64.unsigned_compare n w >= 0 then
         fail loc
           "%s by %Ld is out of range for %s, which is %d bits wide" name n
           (Types.to_string a.Tast.ty) (Types.bits k)
     | _ -> ());
    prim p a.Tast.ty [ a; b ]
  (* (min a b) and (max a b) evaluate each operand once — hence the slots —
     because a min over two calls must not call either of them twice.

     Which is also why this one does not go through [fold_left_prim]: there is
     no Prim to fold, and the pair it folds is a whole comparison. Each step
     puts *both* of its sides in slots, the accumulated pick included, so the
     three-operand form is two nested lets and still exactly one evaluation of
     each operand — where reusing the previous [If] as an operand of the next
     would have duplicated everything inside it. *)
  | "min" | "max" ->
    fold_arity loc name args;
    let x, y, rest =
      match args with x :: y :: rest -> x, y, rest | _ -> assert false
    in
    let a, b = binary ctx name loc ~want:(numeric_want want) [ x; y ] in
    (* [min] and [max] are [<] with a pick, so [ordered?] is what they want —
       not [numeric?]. A generic that declares [ordered?] gets both. *)
    unconstrained ctx.env loc name ~needs:"ordered?" a.Tast.ty;
    if not (Types.is_numeric a.Tast.ty || generic_ty a.Tast.ty) then
      fail loc "%s takes numbers, found %s" name (Types.to_string a.Tast.ty);
    let ty = a.Tast.ty in
    let cmp = if String.equal name "min" then Tast.Lt else Tast.Gt in
    let pick a b =
      let sa = fresh_slot ctx ty and sb = fresh_slot ctx ty in
      let la = mk loc ty (Tast.Local sa) and lb = mk loc ty (Tast.Local sb) in
      let test = mk loc Types.Bool (Tast.Prim (cmp, [ la; lb ])) in
      mk loc ty (Tast.Let ([ (sa, a); (sb, b) ],
                           [ mk loc ty (Tast.If (test, la, lb)) ]))
    in
    expect loc ~want
      (List.fold_left (fun acc arg -> pick acc (check ctx ~want:ty arg))
         (pick a b) rest)
  (* (zeroed) is the all-bytes-zero value of whatever it is being stored into,
     so it only means anything where a type is expected of it. *)
  | "zeroed" ->
    arity loc name 0 args;
    (match want with
     | Some ty when ty <> Types.Never ->
       no_zeroed_fn loc "this" ty;
       mk loc ty (Tast.Zero ty)
     | _ ->
       fail loc
         "zeroed needs to know the type it is zeroing — use it where one is \
          expected, as in (set grid (zeroed))")

  (* The one half of a destructuring [let] that [Parse] cannot do on its own.
     Everything else about a pattern is bindings and field accesses it already
     wrote; the arity is a *type* question — how many elements the value has —
     and there are no types in the parser. So the pattern's shape travels here
     as arguments: which element this binding wants, how many names the pattern
     binds, and whether that count is exact or a minimum (it is a minimum when
     the pattern ends in [& rest]).

     No source symbol can contain a [~] — the reader makes it a delimiter — so
     this name is unspellable and nothing but [Parse] can reach it. *)
  | "destructure~nth" ->
    (match args with
     | [ target;
         { Ast.e = Ast.Int i; _ }; { Ast.e = Ast.Int n; _ };
         { Ast.e = Ast.Int exact; _ } ] ->
       let plural k = if Int64.equal k 1L then "" else "s" in
       let target = check ctx target in
       (match target.Tast.ty with
        | Types.Array (m, elem) ->
          if Int64.equal exact 1L && not (Int64.equal m n) then
            fail loc
              "this pattern binds %Ld name%s, but %s has %Ld element%s — a \
               pattern over a fixed array names every element, or ends in \
               [& rest]"
              n (plural n) (Types.to_string target.Tast.ty) m (plural m);
          if Int64.equal exact 0L && Int64.compare m n < 0 then
            fail loc
              "this pattern binds %Ld name%s before the &, but %s has only %Ld \
               element%s" n (plural n) (Types.to_string target.Tast.ty) m
              (plural m);
          prim Tast.At elem
            [ target; mk loc index_ty (Tast.Int (i, Types.I32)) ]
        (* The asymmetry is real and is the reason this is refused rather than
           lowered to a bounds-checked [at]: a fixed array's length is in its
           type, so [[a b]] over a [[2 f32]] is a claim the checker can settle,
           and over a [[T]] it is a claim about a number that does not exist
           until the program runs. Turning it into a runtime trap would be a
           pattern that type checks and then kills the program, which is the
           trade this language does not make. *)
        | Types.Slice _ ->
          fail loc
            "a pattern cannot destructure %s: a slice's length is a runtime \
             value, so nothing here can check that it has %Ld element%s. Use \
             (at s i) and test (len s) yourself"
            (Types.to_string target.Tast.ty) n (plural n)
        | other ->
          fail loc
            "%s is not a fixed array, so [a b ...] cannot destructure it"
            (Types.to_string other))
     | _ ->
       fail loc
         "destructure~nth is written by the compiler and cannot be called")

  (* ── allocators, spec-memory.md ────────────────────────────────── *)
  (* Every one of these is an ordinary named call, which is the whole of the
     escape NEXT.md describes: [check_call] already routes a named call through
     here, so none of the four function-value refusals is anywhere near it. *)
  (* A *user-written* allocator, and the reason it is still refused now that
     function values exist. NEXT.md said it needed "a defn's name in value
     position"; it has that, and it is still two things short, both of them
     nameable and neither of them a function-value question any more.

     The built-in set needs none of it: heap-allocator and arena-new are C
     symbols the emitter names, and no Flan type mentions them. *)
  | "make-allocator" | "allocator-from" | "allocator" ->
    fail loc
      "a user-written allocator is not implemented yet, and a defn's name in \
       value position — which is what this used to wait for — is no longer \
       what is missing. Two things are. The runtime calls an allocator as \
       proc(a, mode, p, old, size, align): six C arguments and no transfer \
       channel, and every Flan function value's signature ends with one, so \
       the pointer would be called with the wrong shape (the same mismatch a \
       foreign function's address is refused for). And Allocator is opaque \
       and pointer-width, so there is nowhere for a program to put the \
       flan_allocator the pointer would have to point at. Use \
       (arena-new ...) with a backing buffer, which is the parameterised \
       allocator that does exist"
  | "heap-allocator" ->
    arity loc name 0 args;
    expect loc ~want
      (mk loc Types.Alloc (Tast.Prim (Tast.Rt "flan_heap_allocator", [])))
  (* The capacity is explicit and there is no growing backing store: an arena
     whose size is decided by the program is one a program can reason about,
     and it is the only shape under which "exhausted" is a state a test can
     reach on purpose. *)
  | "arena-new" ->
    arity loc name 1 args;
    let cap = check ctx ~want:(Types.Int Types.I64) (List.hd args) in
    expect loc ~want
      (mk loc Types.Alloc (Tast.Prim (Tast.Rt "flan_arena_new", [ cap ])))
  (* Hands the pages back, which [free-all] deliberately does not — see
     docs/BUILT.md, "free-all is retain-capacity". *)
  | "arena-destroy" ->
    arity loc name 1 args;
    let a = check ctx ~want:Types.Alloc (List.hd args) in
    expect loc ~want
      (mk loc Types.Unit (Tast.Prim (Tast.Rt "flan_arena_destroy", [ a ])))
  (* One of spec-memory.md's two release points. It takes the source location
     as a string so that an allocator with no region to release names the site
     rather than the runtime. *)
  | "free-all" ->
    arity loc name 1 args;
    let a = check ctx ~want:Types.Alloc (List.hd args) in
    expect loc ~want
      (mk loc Types.Unit
         (Tast.Prim (Tast.Rt "flan_alloc_free_all", [ a; here loc ])))
  (* The capability set, read off the allocator value. Odin asks its procedure
     (Query_Features returning an Allocator_Mode_Set); a field is the same
     answer without the round trip, which is NEXT.md's call. *)
  | "can-free?" ->
    arity loc name 1 args;
    let a = check ctx ~want:Types.Alloc (List.hd args) in
    expect loc ~want
      (mk loc Types.Bool
         (Tast.Prim (Tast.Ne,
                     [ mk loc (Types.Int Types.I8)
                         (Tast.Prim (Tast.Rt "flan_alloc_can_free", [ a ]));
                       mk loc (Types.Int Types.I8) (Tast.Int (0L, Types.I8)) ])))
  | "can-free-all?" ->
    arity loc name 1 args;
    let a = check ctx ~want:Types.Alloc (List.hd args) in
    expect loc ~want
      (mk loc Types.Bool
         (Tast.Prim (Tast.Ne,
                     [ mk loc (Types.Int Types.I8)
                         (Tast.Prim (Tast.Rt "flan_alloc_can_free_all", [ a ]));
                       mk loc (Types.Int Types.I8) (Tast.Int (0L, Types.I8)) ])))
  (* The counter [free-all] bumps. A container records it and traps if it
     moved; this is the same number, readable, so a program can say what it
     saw. *)
  | "alloc-epoch" ->
    arity loc name 1 args;
    let a = check ctx ~want:Types.Alloc (List.hd args) in
    expect loc ~want
      (mk loc (Types.Int Types.I64)
         (Tast.Prim (Tast.Rt "flan_alloc_epoch", [ a ])))
  (* The allocator's identity — its address — which is what the condition's
     :allocator field carries, so a handler holding several regions can tell
     which one ran out. *)
  | "alloc-id" ->
    arity loc name 1 args;
    let a = check ctx ~want:Types.Alloc (List.hd args) in
    expect loc ~want
      (mk loc (Types.Int Types.I64) (Tast.Prim (Tast.Rt "flan_alloc_id", [ a ])))
  (* A ceiling on live bytes, 0 for none. spec-memory.md's retry restart is
     answerable only by a handler that can make the *same* request succeed, and
     for a fixed backing store the handler that works is the one that grows it:
     releasing the region a container lives in invalidates the container, which
     is what the epoch check catches. So the spec's "grows the arena and then
     invokes retry" needs a ceiling to raise, and this is it. It is also how a
     program exhausts an allocator on purpose. *)
  | "alloc-budget" ->
    arity loc name 1 args;
    let a = check ctx ~want:Types.Alloc (List.hd args) in
    expect loc ~want
      (mk loc (Types.Int Types.I64)
         (Tast.Prim (Tast.Rt "flan_alloc_budget", [ a ])))
  | "set-alloc-budget" ->
    arity loc name 2 args;
    (match args with
     | [ a; n ] ->
       let a = check ctx ~want:Types.Alloc a in
       let n = check ctx ~want:(Types.Int Types.I64) n in
       expect loc ~want
         (mk loc Types.Unit (Tast.Prim (Tast.Rt "flan_alloc_set_budget", [ a; n ])))
     | _ -> assert false)
  (* "Did you forget to free" is an allocator-tier question and this is the
     tier answering it — spec-memory.md, "Leaking is defined behaviour". *)
  | "alloc-live-blocks" ->
    arity loc name 1 args;
    let a = check ctx ~want:Types.Alloc (List.hd args) in
    expect loc ~want
      (mk loc (Types.Int Types.I64)
         (Tast.Prim (Tast.Rt "flan_alloc_live_blocks", [ a ])))
  (* (with-allocator A BODY...). It rebinds and releases nothing: not at the
     end of the body, not anywhere. spec-memory.md is explicit that this is not
     a scope-end release point and that it is the point on which Odin's
     [defer delete] and Carp's scope-end frees were both rejected. *)
  | "with-allocator" ->
    (match args with
     | [] -> fail loc "with-allocator is (with-allocator allocator body ...)"
     | a :: body ->
       let a = check ctx ~want:Types.Alloc a in
       let body, ty =
         scoped ctx (fun () ->
           match body with
           | [] -> [ unit_at loc ], Types.Unit
           | _ ->
             let rec go = function
               | [ last ] -> let l = check ctx ?want last in [ l ], l.Tast.ty
               | e :: rest ->
                 let e = check ctx e in
                 let rest, ty = go rest in
                 e :: rest, ty
               | [] -> assert false
             in
             go body)
       in
       expect loc ~want (mk loc ty (Tast.WithAlloc (a, body))))

  (* ── (Vec T), spec-memory.md ───────────────────────────────────── *)
  (* Every one of these is a named call over a type-erased runtime, with
     size_of and align_of produced here because here is where the concrete
     element type is known. No generics are involved and none are needed. *)
  (* (vec-new), (vec-new T), (vec-new a), (vec-new T a).
     [let] has no type annotation — parse.ml settles that a triple binding is
     ambiguous and types are inferred — so a local Vec has nowhere to say what
     it holds, and the element type is written at the call instead. This is not
     the explicit instantiation syntax the generics section rules out: nothing
     here is generic, and the name is resolved as an ordinary type, not bound
     to a type variable. Where the context does say — a defvar's type, a
     function's return type, an argument — it is not needed and may be left
     out. *)
  | "vec-new" ->
    let elem, args = vec_new_elem ctx ~want loc args in
    let a = allocator_arg ctx loc args in
    let v = fresh_slot ctx (Types.Vec elem) in
    let attempt =
      rt loc (Types.Int Types.I8) "flan_vec_init"
        [ mk loc (Types.Vec elem) (Tast.Local v); a; i64_at loc 0L;
          size_of loc elem; align_of loc elem; here loc ]
    in
    expect loc ~want
      (mk loc (Types.Vec elem)
         (Tast.Let ([ (v, mk loc (Types.Vec elem) (Tast.Zero (Types.Vec elem))) ],
                    [ with_note loc (alloc_guard ctx loc attempt)
                        (reg_note loc "flan_dev_reg_note_vec"
                           (mk loc (Types.Vec elem) (Tast.Local v))
                           [ size_of loc elem ] elem);
                      region_check ctx.env loc
                        (mk loc (Types.Vec elem) (Tast.Local v))
                        (mk loc (Types.Vec elem) (Tast.Local v)) ])))
  (* Unit, not a Result and not an ignorable error code: see [alloc_guard]. *)
  | "push" ->
    arity loc name 2 args;
    (match args with
     | [ target; x ] ->
       let target = check ctx target in
       let elem = vec_elem loc "push" target.Tast.ty in
       let x = check ctx ~want:elem x in
       (* The element is bound before the loop so that a [retry] re-attempts
          the allocation and not the expression that produced the value. *)
       let e = fresh_slot ctx elem in
       let attempt =
         rt loc (Types.Int Types.I8) "flan_vec_push"
           [ target; addr_of loc (mk loc elem (Tast.Local e));
             size_of loc elem; align_of loc elem; here loc ]
       in
       (* Re-noted after every push, not only the first: a push that grows the
          Vec moves the storage, and the note is keyed on the base address, so
          an unmoved block costs a probe and an overwrite with the same
          numbers. This is the insert per allocation NEXT.md settles on, and
          the settled answer to what it costs is "measure a real program". *)
       expect loc ~want
         (mk loc Types.Unit
            (Tast.Let ([ (e, x) ],
                       [ region_check ctx.env loc target
                           (with_note loc (alloc_guard ctx loc attempt)
                              (reg_note loc "flan_dev_reg_note_vec" target
                                 [ size_of loc elem ] elem)) ])))
     | _ -> assert false)
  | "reserve" ->
    arity loc name 2 args;
    (match args with
     | [ target; n ] ->
       let target = check ctx target in
       let n = check ctx ~want:index_ty n in
       let n64 =
         mk loc (Types.Int Types.I64) (Tast.Prim (Tast.Cast (Types.Int Types.I64), [ n ]))
       in
       (* Deferred: the sizes are known abstractly but the hash is not, so
          the node is a unit no-op and the copy builds the real one. *)
       if (match target.Tast.ty with
           | Types.Map (k, _) -> deferred_key ctx.env loc "reserve" k
           | _ -> false) then
         expect loc ~want (mk loc Types.Unit Tast.Unit)
       else
       let attempt, note =
         match target.Tast.ty with
         (* For a map the number is entries, not slots: the runtime sizes the
            block so that [n] still sits under the 75% load factor, which is
            the only reading of "room for n" that does not reallocate on the
            nth put. *)
         | Types.Map (k, v) ->
           let hash, _ = key_fns ctx.env loc k in
           rt loc (Types.Int Types.I8) "flan_map_reserve"
             [ target; n64; size_of loc k; size_of loc v; hash; here loc ],
           reg_note loc "flan_dev_reg_note_map" target
             [ size_of loc k; size_of loc v ] target.Tast.ty
         | _ ->
           let elem = vec_elem loc "reserve" target.Tast.ty in
           rt loc (Types.Int Types.I8) "flan_vec_reserve"
             [ target; n64; size_of loc elem; align_of loc elem; here loc ],
           reg_note loc "flan_dev_reg_note_vec" target
             [ size_of loc elem ] elem
       in
       expect loc ~want
         (region_check ctx.env loc target
            (with_note loc (alloc_guard ctx loc attempt) note))
     | _ -> assert false)
  (* (as-slice v) and (as-slice v lo hi) — spec-memory.md, "Borrowing". The
     result is a non-owning view: copying it copies ptr+len and never the
     elements, and it carries no allocator, so freeing through one is not
     expressible. A push, a put or a reserve may invalidate it; that is the
     explicit Zig/Odin contract the spec chose over a borrow checker. *)
  | "as-slice" ->
    (match args with
     | target :: rest when List.length rest = 0 || List.length rest = 2 ->
       let target = check ctx target in
       let elem = vec_elem loc "as-slice" target.Tast.ty in
       let lo, hi =
         match rest with
         | [] ->
           mk loc index_ty (Tast.Int (0L, Types.I32)),
           (* -1 is "to the end": (as-slice v) has no static length to pass. *)
           mk loc index_ty (Tast.Int (-1L, Types.I32))
         | [ lo; hi ] -> index_expr ctx lo, index_expr ctx hi
         | _ -> assert false
       in
       let out = fresh_slot ctx (Types.Slice elem) in
       let fill =
         rt loc Types.Unit "flan_vec_as_slice"
           [ target; addr_of loc (mk loc (Types.Slice elem) (Tast.Local out));
             lo; hi; size_of loc elem; here loc ]
       in
       expect loc ~want
         (mk loc (Types.Slice elem)
            (Tast.Let ([ (out, mk loc (Types.Slice elem)
                                 (Tast.Zero (Types.Slice elem))) ],
                       [ fill; mk loc (Types.Slice elem) (Tast.Local out) ])))
     | _ -> fail loc "as-slice is (as-slice v) or (as-slice v lo hi)")
  (* spec-memory.md's first release point. Since the repeal, what it consumes
     it consumes at run time only: nothing marks the binding dead, so a second
     [free] or a read after this one type-checks and misbehaves at run time —
     the allocator aborts on a double free it can see, and the epoch word
     traps a read through a released region. That is the Odin contract: free
     is a thing you write, and writing it twice is yours to not do. *)
  | "free" ->
    arity loc name 1 args;
    let target = check ctx (List.hd args) in
    (* A container of owning elements is refused here, and a reader will
       assume the opposite — that [free] recurses — so this says why it does
       not and what does.

       The bytes this container holds are element *headers*, and releasing the
       block those headers sit in says nothing about the blocks they point at.
       Nothing type-erased can walk them: the runtime sees a size and an
       alignment and has never heard of the element type. That is the same
       fact the type-level refusals used to state, and the arena did not change
       it — what the arena changed is that it no longer matters there, because
       the inner blocks came out of the same region and [free-all] takes them
       with everything else.

       So the honest answer is not to recurse, and it is not to release the
       backing store quietly either. Releasing the outer block alone would be
       "I freed it" spelt over a program that leaked everything inside, and
       this file refuses that collapse everywhere else — [flan_alloc_free_all]
       traps rather than no-op for the same reason. It is refused instead, at
       the one place a reader is looking when they want to know.

       The guard at construction is what makes the advice reachable: such a
       container is region-allocated or it does not exist, so there is always a
       [free-all] to point at. *)
    (match target.Tast.ty with
     | (Types.Vec _ | Types.Map _)
       when region_only ctx.env target.Tast.ty ->
       fail loc
         "%s holds elements that own storage, and free releases the block \
          those elements sit in — not the blocks they point at, which nothing \
          type-erased can reach. This container was built against a region \
          allocator, because the guard at its construction admits no other, so \
          release the region: (free-all a) takes it and everything its \
          elements own, in one operation and with no per-element teardown"
         (Types.to_string target.Tast.ty)
     | Types.Vec elem ->
       expect loc ~want
         (rt loc Types.Unit "flan_vec_free"
            [ target; size_of loc elem; align_of loc elem; here loc ])
     | Types.Map (k, v) ->
       expect loc ~want
         (rt loc Types.Unit "flan_map_free"
            [ target; size_of loc k; size_of loc v; here loc ])
     | other ->
       (* A field is never freed on its own: it would leave its owner partly
          dead with no way to say so. *)
       fail loc
         "free takes an owning container — a Vec or a Map — found %s. A \
          resource type with a drop hook is step 5 and does not exist yet"
         (Types.to_string other))
  (* (clone v) uses the current allocator, (clone v a) names one. A deep,
     independent copy: spec-memory.md's "copying is always explicit". *)
  | "clone" ->
    (match args with
     | target :: rest when List.length rest <= 1 ->
       (* Checked once, then dispatched on what it turned out to be: checking
          it inside a guard as well would allocate the target's slots twice and
          evaluate whatever it was written as twice. *)
       let target = check ctx target in
       let a = allocator_arg ctx loc rest in
       (match target.Tast.ty with
        (* The refusal that did *not* come down with the type-level ones, and
           the distinction is worth being exact about, because the sentence
           they all used to share bundled two different failures: that a clone
           would duplicate inner headers instead of copying, and that a free
           would leak what those headers own. Only the second was about
           teardown, and only the second is answered by a region.

           What disqualifies [clone] is not that it copies a header — so do
           [at] and [get], and they are fine, because they promise nothing and
           hand back an alias into a region nobody individually frees. It is
           that [clone] *allocates a new block and promises independence*.
           spec-memory.md calls it a deep copy; what a memcpy of the slots
           delivers is a second container whose elements still point into the
           first one's blocks. Two containers, one set of inner buffers, under
           a name that says otherwise — and putting the copy in a second arena
           makes it worse, not better, because tipping that arena leaves the
           copy's elements pointing into an arena that is still live while its
           own storage is gone.

           Refused at the operation rather than at the type, because that is
           where the promise is made. *)
        | (Types.Vec _ | Types.Map _) when region_only ctx.env target.Tast.ty ->
          fail loc
            "%s cannot be cloned: clone is a deep, independent copy, and the \
             type-erased runtime copies slots bytewise — so the copy's \
             elements would still point at the original's blocks, which is an \
             alias under a name that promises the opposite. Nothing here can \
             walk an element to copy what it owns. Build a second container \
             and insert into it, or keep the one you have — a region makes \
             sharing safe, not copying"
            (Types.to_string target.Tast.ty)
        (* A map's clone reinserts rather than copying the block, because the
           seed is derived from the block's address — see flan_rt.c. That is
           the runtime's business; from here it is one more allocating call
           under the same guard. *)
        | Types.Map (k, v) when deferred_key ctx.env loc "clone" k ->
          (* Deferred, and the placeholder is a zeroed map of the same type —
             the value a (map-new) starts from, so everything written around
             the clone still checks against the type it will have. *)
          let mty = Types.Map (k, v) in
          expect loc ~want (mk loc mty (Tast.Zero mty))
        | Types.Map (k, v) ->
          let mty = Types.Map (k, v) in
          let hash, _ = key_fns ctx.env loc k in
          let d = fresh_slot ctx mty in
          let attempt =
            rt loc (Types.Int Types.I8) "flan_map_clone"
              [ mk loc mty (Tast.Local d); target; a;
                size_of loc k; size_of loc v; hash; here loc ]
          in
          expect loc ~want
            (mk loc mty
               (Tast.Let ([ (d, mk loc mty (Tast.Zero mty)) ],
                          [ with_note loc (alloc_guard ctx loc attempt)
                              (reg_note loc "flan_dev_reg_note_map"
                                 (mk loc mty (Tast.Local d))
                                 [ size_of loc k; size_of loc v ] mty);
                            mk loc mty (Tast.Local d) ])))
        | _ ->
          let elem = vec_elem loc "clone" target.Tast.ty in
          let d = fresh_slot ctx (Types.Vec elem) in
          let attempt =
            rt loc (Types.Int Types.I8) "flan_vec_clone"
              [ mk loc (Types.Vec elem) (Tast.Local d); target; a;
                size_of loc elem; align_of loc elem; here loc ]
          in
          expect loc ~want
            (mk loc (Types.Vec elem)
               (Tast.Let ([ (d, mk loc (Types.Vec elem)
                                  (Tast.Zero (Types.Vec elem))) ],
                          [ with_note loc (alloc_guard ctx loc attempt)
                              (reg_note loc "flan_dev_reg_note_vec"
                                 (mk loc (Types.Vec elem) (Tast.Local d))
                                 [ size_of loc elem ] elem);
                            mk loc (Types.Vec elem) (Tast.Local d) ]))))
     | _ -> fail loc "clone is (clone v) or (clone v allocator)")

  (* ── (Map K V), spec-memory.md ─────────────────────────────────── *)
  (* Every one of these is a named call over the same type-erased runtime the
     Vec uses, with the two sizes and the key's hash and equality pair produced
     here because here is where the concrete types are known. No generics are
     involved and none are needed — which is exactly what Odin's Map_Info says
     too, being two sizes and two contextless procs. *)

  (* (map-new), (map-new K V), (map-new a), (map-new K V a). The same shape
     [vec-new] has and for the same reason: a [let] has no type annotation, so
     a local map has nowhere else to say what it holds. Where the context does
     say — a defvar's type, a parameter, a return type — the pair may be left
     out. *)
  | "map-new" ->
    let k, v, args = map_new_types ctx ~want loc args in
    let a = allocator_arg ctx loc args in
    let mty = map_type ~preds:ctx.env.tvpreds loc k v in
    let m = fresh_slot ctx mty in
    let attempt =
      rt loc (Types.Int Types.I8) "flan_map_init"
        [ mk loc mty (Tast.Local m); a; size_of loc k; size_of loc v;
          here loc ]
    in
    expect loc ~want
      (mk loc mty
         (Tast.Let ([ (m, mk loc mty (Tast.Zero mty)) ],
                    [ with_note loc (alloc_guard ctx loc attempt)
                        (reg_note loc "flan_dev_reg_note_map"
                           (mk loc mty (Tast.Local m))
                           [ size_of loc k; size_of loc v ] mty);
                      region_check ctx.env loc (mk loc mty (Tast.Local m))
                        (mk loc mty (Tast.Local m)) ])))

  (* (put m k v) — the upsert. Unit, not a Result and not an ignorable error
     code: see [alloc_guard]. spec-memory.md is explicit that it either
     inserts or replaces, and that (set (get m k) v) is not map syntax. *)
  | "put" ->
    arity loc name 3 args;
    (match args with
     | [ target; k; v ] ->
       let target = check ctx target in
       let kt, vt = map_kv loc "put" target.Tast.ty in
       let k = check ctx ~want:kt k in
       let v = check ctx ~want:vt v in
       (* Deferred: the arguments are checked — so a move here is still a move
          and a borrow still a borrow — and the node itself is a unit no-op,
          thrown away with the rest of the abstract pass. *)
       if deferred_key ctx.env loc "put" kt then
         expect loc ~want (mk loc Types.Unit Tast.Unit)
       else
       (* Both are bound before the loop, so that a [retry] re-attempts the
          allocation and not the expressions that produced the key and the
          value. The same rule [push] follows for its element. *)
       let ks = fresh_slot ctx kt and vs = fresh_slot ctx vt in
       let hash, eq = key_fns ctx.env loc kt in
       let attempt =
         rt loc (Types.Int Types.I8) "flan_map_put"
           [ target; addr_of loc (mk loc kt (Tast.Local ks));
             addr_of loc (mk loc vt (Tast.Local vs));
             size_of loc kt; size_of loc vt; hash; eq; here loc ]
       in
       expect loc ~want
         (mk loc Types.Unit
            (Tast.Let ([ (ks, k); (vs, v) ],
                       [ region_check ctx.env loc target
                           (with_note loc (alloc_guard ctx loc attempt)
                              (reg_note loc "flan_dev_reg_note_map" target
                                 [ size_of loc kt; size_of loc vt ]
                                 target.Tast.ty)) ])))
     | _ -> assert false)

  (* (get m k) -> (Option V). Absence is None, not an untyped nil, and the
     answer is a copy of the value's bytes — for an owning value, a copy of
     its header, aliasing what the map's slot points at.
     There is no allocation here and therefore no guard: a lookup that finds
     nothing is an answer, not a failure. *)
  | "get" ->
    arity loc name 2 args;
    (match args with
     | [ target; k ] ->
       let target = check ctx target in
       let kt, vt = map_kv loc "get" target.Tast.ty in
       let k = check ctx ~want:kt k in
       (* Deferred, and the placeholder is [None] rather than [Unit]: this
          form answers an (Option V), and the abstract pass still has to
          type-check whatever the body does with the answer. *)
       if deferred_key ctx.env loc "get" kt then
         expect loc ~want (mk loc (Types.Option vt) Tast.None_)
       else
       let hash, eq = key_fns ctx.env loc kt in
       let ks = fresh_slot ctx kt in
       let out = fresh_slot ctx vt in
       let found =
         rt loc (Types.Int Types.I8) "flan_map_get"
           [ target; addr_of loc (mk loc kt (Tast.Local ks));
             addr_of loc (mk loc vt (Tast.Local out));
             size_of loc kt; size_of loc vt; hash; eq; here loc ]
       in
       let oty = Types.Option vt in
       (* The runtime answers 1/0 and fills [out] only when it answers 1, so
          the Option is built here rather than there: the runtime has no idea
          what an Option's layout is, and keeping it that way is what lets one
          entry point serve every value type. *)
       let some = mk loc oty (Tast.Some_ (mk loc vt (Tast.Local out))) in
       let none = mk loc oty Tast.None_ in
       let cond =
         mk loc Types.Bool
           (Tast.Prim (Tast.Ne,
                       [ found;
                         mk loc (Types.Int Types.I8) (Tast.Int (0L, Types.I8)) ]))
       in
       expect loc ~want
         (mk loc oty
            (Tast.Let ([ (ks, k);
                         (out, mk loc vt (Tast.Zero vt)) ],
                       [ mk loc oty (Tast.If (cond, some, none)) ])))
     | _ -> assert false)

  (* (map-remove m k) -> (Option V): the value that was there, or None when
     the key was not. The same answer [get] gives, for the same reason — a key
     that is not in the map is an answer and not a failure — and the value
     comes back rather than being dropped on the floor, which is what makes
     "take this out and use it" one call instead of a get and a remove that
     hash the key twice.

     It allocates nothing and releases nothing, so unlike [put] there is no
     alloc_guard and no region check around it: a key and a value live inside
     the one block the map allocated, and removal moves entries within that
     block. That is what makes it mean the same thing on a map backed by an
     arena — or by any allocator that refuses can-free — as on a heap-backed
     one. Nothing is freed per entry because nothing was allocated per entry. *)
  | "map-remove" ->
    arity loc name 2 args;
    (match args with
     | [ target; k ] ->
       let target = check ctx target in
       let kt, vt = map_kv loc "map-remove" target.Tast.ty in
       let k = check ctx ~want:kt k in
       (* Deferred exactly as [get] is, and with [None] for the same reason:
          the abstract pass still has to check whatever the body does with the
          answer. *)
       if deferred_key ctx.env loc "map-remove" kt then
         expect loc ~want (mk loc (Types.Option vt) Tast.None_)
       else
       let hash, eq = key_fns ctx.env loc kt in
       let ks = fresh_slot ctx kt in
       let out = fresh_slot ctx vt in
       let found =
         rt loc (Types.Int Types.I8) "flan_map_remove"
           [ target; addr_of loc (mk loc kt (Tast.Local ks));
             addr_of loc (mk loc vt (Tast.Local out));
             size_of loc kt; size_of loc vt; hash; eq; here loc ]
       in
       let oty = Types.Option vt in
       (* Built here and not there, as [get]'s is: the runtime fills [out] only
          when it answers 1 and has no idea what an Option's layout is. *)
       let some = mk loc oty (Tast.Some_ (mk loc vt (Tast.Local out))) in
       let none = mk loc oty Tast.None_ in
       let cond =
         mk loc Types.Bool
           (Tast.Prim (Tast.Ne,
                       [ found;
                         mk loc (Types.Int Types.I8) (Tast.Int (0L, Types.I8)) ]))
       in
       expect loc ~want
         (mk loc oty
            (Tast.Let ([ (ks, k);
                         (out, mk loc vt (Tast.Zero vt)) ],
                       [ mk loc oty (Tast.If (cond, some, none)) ])))
     | _ -> assert false)

  (* (map-next m (addr cur) (addr k) (addr v)) -> bool, and the whole of map
     iteration. Before it there was no way to read a map's keys or its values
     at all: every other map operation addresses one entry by hashing it, and
     nothing walked the block.

     Three out-pointers rather than a returned pair, because there are no
     tuples and a (Option K) would answer only half of an entry — the value
     would then cost a second hash of the key just answered. The cursor is an
     i64 the caller owns and the loop reads as one:

       (let [cur 0  k 0  v 0]
         (while (map-next m (addr cur) (addr k) (addr v))
           ...))

     It is *not* a generic (map-keys m): a Vec of them needs a signature naming
     K, and a prelude defn cannot be written at every K. That one is generics,
     not iteration, and it stays refused for that reason.

     No hash and no equality pair go with it — walking asks nothing about a
     key — so this is the one map entry point whose signature carries neither,
     and the sizes are still needed because the runtime is type-erased. *)
  | "map-next" ->
    arity loc name 4 args;
    (match args with
     | [ target; cur; k; v ] ->
       let target = check ctx target in
       let kt, vt = map_kv loc "map-next" target.Tast.ty in
       let cur = check ctx ~want:(Types.Ptr (Types.Int Types.I64)) cur in
       let k = check ctx ~want:(Types.Ptr kt) k in
       let v = check ctx ~want:(Types.Ptr vt) v in
       let found =
         rt loc (Types.Int Types.I8) "flan_map_next"
           [ target; cur; k; v; size_of loc kt; size_of loc vt; here loc ]
       in
       expect loc ~want
         (mk loc Types.Bool
            (Tast.Prim
               (Tast.Ne,
                [ found;
                  mk loc (Types.Int Types.I8) (Tast.Int (0L, Types.I8)) ])))
     | _ -> assert false)

  (* (has-key? m k). (get m k) answers the same question, but through an
     Option the caller then has to match; this is the form a condition wants,
     and it copies no value. *)
  | "has-key?" ->
    arity loc name 2 args;
    (match args with
     | [ target; k ] ->
       let target = check ctx target in
       let kt, vt = map_kv loc "has-key?" target.Tast.ty in
       let k = check ctx ~want:kt k in
       (* Deferred, and the placeholder is a [bool] — the form a condition
          wants, so the condition around it still has to check. *)
       if deferred_key ctx.env loc "has-key?" kt then
         expect loc ~want (mk loc Types.Bool (Tast.Bool false))
       else
       let hash, eq = key_fns ctx.env loc kt in
       let ks = fresh_slot ctx kt in
       let found =
         rt loc (Types.Int Types.I8) "flan_map_has"
           [ target; addr_of loc (mk loc kt (Tast.Local ks));
             size_of loc kt; size_of loc vt; hash; eq; here loc ]
       in
       expect loc ~want
         (mk loc Types.Bool
            (Tast.Let ([ (ks, k) ],
                       [ mk loc Types.Bool
                           (Tast.Prim
                              (Tast.Ne,
                               [ found;
                                 mk loc (Types.Int Types.I8)
                                   (Tast.Int (0L, Types.I8)) ])) ])))
     | _ -> assert false)

  (* ── Assets, decision 1: embedded at compile time ──────────────
     Odin's #load and #load_directory are the model (src/parser.cpp,
     src/check_builtin.cpp's check_load_directive), and the reason it is the
     right answer here is the one NEXT.md gives: it is a *compiler* feature, so
     it needs no build flags, no linker arguments and no per-target packaging,
     and it works identically on desktop and web. That matters more here than
     it does for Odin, because [Load] gives link flags only to a directory
     package — the single file doing (rl/load-texture "brush.png") is
     structurally the one file with no link channel. Embedding has no such
     hole.

     Odin's `#` is not imported. An s-expression language already has a head
     position for a name, so these are ordinary named calls spelled [embed] and
     [embed-dir], resolved here exactly as [vec-new] and [heap-allocator] are.

     The result costs nothing at run time: the bytes become a
     `private unnamed_addr constant` string, the same one every string literal
     already becomes, and emit.ml's [escape] is byte-exact, so a PNG survives
     the round trip through the .ll. Bound with [defconst], an [embed-dir]
     becomes an LLVM constant outright (emit.ml's [const]).

     The one sharp edge, and it is not new: the slice this hands back points
     into .rodata, so a store through it either segfaults at -O0 or is deleted
     at -O2 — the same measured trap the prelude's ASCII-case note describes
     for (bytes "Hi"). Clone the bytes into a Vec for a mutable copy. Nothing
     here widens that hole; it inherits it, and provenance is what would close
     it. *)
  | "embed" ->
    (match args with
     | [ p ] | [ p; _ ] ->
       (* The spelling is settled before the file is opened, so a program that
          asks for a type embed cannot read a file as is told that, rather than
          being told the file is missing and left to discover the other half
          after fixing it. *)
       (match args with
        | [ _; { Ast.e = Ast.Var "string"; _ } ] | [ _ ] -> ()
        | [ _; t ] ->
          fail t.Ast.loc
            "embed's second argument is the type to read the file as, and \
             `string` is the only one — (embed \"p\") is the [u8]"
        | _ -> ());
       let data = read_embed_file (embed_path loc p) p.Ast.loc in
       let as_string () = mk loc Types.String (Tast.Str data) in
       (* A [Str] node typed [u8] rather than a [Bytes] prim over one. [Bytes]
          is identity — emit.ml lowers String and Slice _ to the same %slice —
          and the prim would make the node non-constant, so an (embed-dir) in a
          defconst could not be an LLVM constant. Both of emit.ml's string
          emitters take the bytes and ignore the node's type, so this is the
          same constant either way, and it is one a global can hold. *)
       let as_bytes () = mk loc (Types.Slice (Types.Int Types.U8)) (Tast.Str data) in
       (* Two spellings rather than one that changes type with its context.
          Odin threads a type_hint everywhere and can afford (embed "p") to
          mean a string here and a []u8 there; with structural equality and no
          implicit widening anywhere, the same text meaning two types would be
          a wart. [want] is a fallback only, and nothing depends on it. *)
       (match args with
        | [ _; { Ast.e = Ast.Var "string"; _ } ] ->
          expect loc ~want (as_string ())
        | _ ->
          (match want with
           | Some Types.String -> as_string ()
           | _ -> expect loc ~want (as_bytes ())))
     | _ ->
       fail loc
         "embed is (embed \"path\") for a [u8], or (embed \"path\" string)")
  | "embed-dir" ->
    arity loc name 1 args;
    let arg = List.hd args in
    let entries = read_embed_dir (embed_path loc arg) arg.Ast.loc in
    if not (Hashtbl.mem ctx.env.structs "EmbedFile") then
      fail loc
        "embed-dir answers a [n EmbedFile] and EmbedFile is not in scope — it \
         is a prelude type and something has replaced the prelude";
    let ety = Types.Named "EmbedFile" in
    let elems =
      List.map
        (fun (nm, data) ->
           mk loc ety
             (Tast.Make
                ("EmbedFile",
                 [ mk loc Types.String (Tast.Str nm);
                   mk loc (Types.Slice (Types.Int Types.U8)) (Tast.Str data) ])))
        entries
    in
    expect loc ~want
      (mk loc (Types.Array (Int64.of_int (List.length entries), ety))
         (Tast.Arr elems))

  (* ── slurp and barf, decisions 2 and 5 ─────────────────────────
     [slurp] reads a whole file and answers a (Vec u8). It allocates, which is
     why it waited for Vec, and it follows spec-memory.md's rule to the letter:
     no allocating operation returns an error, so there is no Result here and
     no out-parameter — a failure to allocate is StorageExhausted under [retry]
     and a failure to read is FileError under [retry] and [use-value].

     The two guards nest rather than merge, and that is the point: they are two
     different failures with two different answerable questions, and a handler
     that grows an arena is not the handler that supplies another path.

     Everything is inside the file loop, so a [use-value] that names a
     different file re-measures it and re-allocates for its size. The Vec is
     freed at the top of each turn, which is why a retry does not leak; freeing
     a Vec that never allocated is a no-op (flan_rt.c, flan_vec_free). *)
  | "slurp" ->
    (match args with
     | path :: rest when List.length rest <= 1 ->
       let path = check ctx ~want:Types.String path in
       let a = allocator_arg ctx loc rest in
       let ps = fresh_slot ctx Types.String in
       let psv () = mk loc Types.String (Tast.Local ps) in
       let u8 = Types.Int Types.U8 in
       let vt = Types.Vec u8 in
       let v = fresh_slot ctx vt in
       let vv () = mk loc vt (Tast.Local v) in
       let n = fresh_slot ctx (Types.Int Types.I64) in
       let nv () = mk loc (Types.Int Types.I64) (Tast.Local n) in
       let steps try_ =
         [ (* The size first, because it is the step that does not allocate:
              a missing file is found before any storage is committed to it. *)
           try_ (rt loc (Types.Int Types.I8) "flan_file_size"
                   [ psv (); addr_of loc (nv ()) ]);
           (* Previous turn's storage, if a retry brought us back here. *)
           rt loc Types.Unit "flan_vec_free"
             [ vv (); size_of loc u8; align_of loc u8; here loc ];
           with_note loc
             (alloc_guard ctx loc
                (rt loc (Types.Int Types.I8) "flan_vec_init"
                   [ vv (); a; nv (); size_of loc u8; align_of loc u8;
                     here loc ]))
             (reg_note loc "flan_dev_reg_note_vec" (vv ())
                [ size_of loc u8 ] u8);
           (* Fills the Vec the line above sized. A file that grew since the
              measurement is truncated to the buffer; one that shrank leaves a
              shorter Vec. Both are successful reads of what was there. *)
           try_ (rt loc (Types.Int Types.I8) "flan_slurp_into"
                   [ vv (); psv (); size_of loc u8; here loc ]) ]
       in
       expect loc ~want
         (mk loc vt
            (Tast.Let
               ([ (ps, path);
                  (n, i64_at loc 0L);
                  (v, mk loc vt (Tast.Zero vt)) ],
                [ file_guard ctx loc ~path_slot:ps ~op:0 steps; vv () ])))
     | _ -> fail loc "slurp is (slurp path) or (slurp path allocator)")
  (* [barf] writes a whole file, and on the web target it signals — every time,
     with the path in the condition. Decision 2, and the reason is worth having
     at the call site: Flan has NO conditional compilation, so "isolate this to
     desktop" is not expressible in source and a build-time refusal would be
     unusable; a silent no-op is worse than either, because that is how a save
     file disappears with nothing said. So the program gets a condition and
     decides. Nothing here reads the target — the refusal is flan_rt.c's, one
     #ifdef in the host layer, which is exactly where the two targets are
     already implemented twice. *)
  | "barf" ->
    arity loc name 2 args;
    (match args with
     | [ path; data ] ->
       let path = check ctx ~want:Types.String path in
       let data = byte_slice ctx data in
       let ps = fresh_slot ctx Types.String in
       let ds = fresh_slot ctx (Types.Slice (Types.Int Types.U8)) in
       let steps try_ =
         [ try_ (rt loc (Types.Int Types.I8) "flan_file_write"
                   [ mk loc Types.String (Tast.Local ps);
                     mk loc (Types.Slice (Types.Int Types.U8)) (Tast.Local ds) ]) ]
       in
       (* Both operands are bound before the loop so that a retry re-attempts
          the write and not the expressions that produced it — the same rule
          alloc_guard states for push. *)
       expect loc ~want
         (mk loc Types.Unit
            (Tast.Let ([ (ps, path); (ds, data) ],
                       [ file_guard ctx loc ~path_slot:ps ~op:1 steps ])))
     | _ -> assert false)

  (* ── the three that change the filesystem ──────────────────────────
     [delete-file], [rename-file] and [make-directory] are [barf]'s shape with
     a different runtime call, and they are here rather than as prelude
     [declare]s for the one thing a declare cannot do: signal [FileError] with
     the two restarts the compiler emits. A declare could only answer a bool,
     and "the delete failed, here is a boolean" is the shape decision 5 exists
     to keep out of this language — a handler that made the parent directory
     and wants [retry], or that has another path and wants [use-value], has
     nothing to hold onto.

     Each answers [()] and not a bool for the same reason [barf] does: the
     failure is the condition, so a return value would only ever be true. The
     questions that are *not* failures — does this exist, how big is it —
     answer a value instead, and those two are prelude functions over one
     [declare] because nothing about them needs a restart.

     [op] continues the FileError numbering the prelude names: 0 read, 1 write,
     and 2, 3, 4 here. A handler matching on it is matching on the prelude's
     [file-op-delete] and friends, not on a literal. *)
  | "delete-file" | "make-directory" ->
    arity loc name 1 args;
    let sym, op =
      if String.equal name "delete-file" then "flan_file_delete", 2
      else "flan_file_mkdir", 4
    in
    let path = check ctx ~want:Types.String (List.hd args) in
    let ps = fresh_slot ctx Types.String in
    let steps try_ =
      [ try_ (rt loc (Types.Int Types.I8) sym
                [ mk loc Types.String (Tast.Local ps) ]) ]
    in
    expect loc ~want
      (mk loc Types.Unit
         (Tast.Let ([ (ps, path) ],
                    [ file_guard ctx loc ~path_slot:ps ~op steps ])))

  (* Two paths and one restart slot, so the guard holds the *source*: a
     [use-value] renames a different file to the same destination. That is the
     direction a handler can act on — the destination it asked for is the one
     thing it already knows — and it is written down here because the other
     reading is equally plausible until somebody says which it is.

     The destination is bound before the loop, exactly as [barf] binds its
     data, so a retry re-attempts the rename and not the expression that
     computed where to. *)
  | "rename-file" ->
    arity loc name 2 args;
    (match args with
     | [ from_; to_ ] ->
       let from_ = check ctx ~want:Types.String from_ in
       let to_ = check ctx ~want:Types.String to_ in
       let ps = fresh_slot ctx Types.String in
       let ds = fresh_slot ctx Types.String in
       let steps try_ =
         [ try_ (rt loc (Types.Int Types.I8) "flan_file_rename"
                   [ mk loc Types.String (Tast.Local ps);
                     mk loc Types.String (Tast.Local ds) ]) ]
       in
       expect loc ~want
         (mk loc Types.Unit
            (Tast.Let ([ (ps, from_); (ds, to_) ],
                       [ file_guard ctx loc ~path_slot:ps ~op:3 steps ])))
     | _ -> assert false)

  (* ── containers ────────────────────────────────────────────────── *)
  (* [at] and [len] were already the names for a fixed array and a slice, so a
     Vec extends them rather than adding a parallel pair — which is the
     asymmetry [nth] was removed for. A Vec's length is i32 like every other
     length here (index_ty): widening indices is one change across all of them
     and not a Vec question. *)
  | "len" ->
    arity loc name 1 args;
    let target = List.hd args in
    let a = check ctx target in
    (match a.Tast.ty with
     | Types.Array _ | Types.Slice _ | Types.String ->
       prim Tast.Len index_ty [ a ]
     | Types.Vec _ ->
       let n = rt loc (Types.Int Types.I64) "flan_vec_len" [ a; here loc ] in
       expect loc ~want (mk loc index_ty (Tast.Prim (Tast.Cast index_ty, [ n ])))
     (* Extended rather than given a name of its own, for the reason [at] and
        [len] were extended over Vec: one question, one word. *)
     | Types.Map _ ->
       let n = rt loc (Types.Int Types.I64) "flan_map_len" [ a; here loc ] in
       expect loc ~want (mk loc index_ty (Tast.Prim (Tast.Cast index_ty, [ n ])))
     | other ->
       fail loc
         "len takes an array, a slice, a string, a Vec or a Map, found %s"
         (Types.to_string other))
  | "at" ->
    (match args with
     | target :: idx when idx <> [] ->
       let target = check ctx target in
       (match target.Tast.ty with
        | Types.Vec _ ->
          let p, elem = vec_at ctx loc target idx in
          expect loc ~want (mk loc elem (Tast.Deref p))
        | _ ->
          let idx, ty = indexed ctx target idx in
          prim Tast.At ty (target :: idx))
     | _ -> fail loc "%s is (%s collection index ...)" name name)
  | "slice" ->
    arity loc name 3 args;
    (match args with
     | [ target; lo; hi ] ->
       let target = check ctx target in
       let elem = match target.Tast.ty with
         | Types.Array (_, t) | Types.Slice t -> t
         | other -> fail loc "slice takes an array or a slice, found %s"
                      (Types.to_string other)
       in
       prim Tast.Slice (Types.Slice elem)
         (let lo_loc = lo.Ast.loc and hi_loc = hi.Ast.loc in
          let lo = check ctx ~want:index_ty lo in
          let hi = check ctx ~want:index_ty hi in
          let ty = target.Tast.ty in
          (* A bound may sit one past the end, so the length is checked against
             lo and hi both, not against the last valid index. *)
          (match literal lo with
           | Some k -> static_index lo_loc ty ~past_end:true "slice bound" k
           | None -> ());
          (match literal hi with
           | Some k -> static_index hi_loc ty ~past_end:true "slice bound" k
           | None -> ());
          (match literal lo, literal hi with
           | Some a, Some b when a > b ->
             fail loc "slice [%Ld %Ld) runs backwards — lo must not exceed hi" a b
           | _ -> ());
          [ target; lo; hi ])
     | _ -> assert false)

  (* (slice-from-ptr p n) — NEXT.md, "a pointer from C needs a length before
     it can be indexed". A (Ptr T) that came back from C is readable at
     element 0 through [deref] and nowhere else, because [indexed] takes an
     Array or a Slice and a pointer is neither. C hands back an address and no
     length, so the length has to come from the caller, and this is the form
     that says so out loud.

     **What the caller is promising**, and the compiler checks none of it: that
     [p] really addresses [n] consecutive [T], that they are initialised, and
     that they outlive every use of the result. Get it wrong and this reads
     memory that is not there — the bounds check the result carries will agree
     with a length that was a lie, because the length *is* the lie. It is the
     same trust [declare-c] already extends, written at the one site where
     somebody had to know the answer anyway.

     No marker on the name. A [?] in this language means *asks*
     ([font-valid?]), and this does not ask; [zeroed], the nearest
     neighbour — a value conjured rather than
     derived — carries no marker either. [ptr] is the marker: a (Ptr T) only
     ever arrives from a [declare-c], so the word already names the C boundary,
     and a reader who sees it has already been told where the promise comes
     from.

     **It owns nothing.** The result is a [Types.Slice], which carries no
     allocator and is the same non-owning view (as-slice v) answers — so
     [free] refuses it by the rule it already had ("free takes an owning
     container"). *)
  | "slice-from-ptr" ->
    arity loc name 2 args;
    (match args with
     | [ target; n ] ->
       let target = check ctx target in
       let elem =
         match target.Tast.ty with
         | Types.Ptr t -> t
         | other ->
           fail loc
             "slice-from-ptr takes a (Ptr T) and the number of elements behind \
              it, found %s. It is for a pointer that came back from C, whose \
              length only the caller knows"
             (Types.to_string other)
       in
       let n_loc = n.Ast.loc in
       let n = check ctx ~want:index_ty n in
       (* A negative literal is a lie the checker can see, so it does not wait
          for the run-time test emit.ml plants beside it. *)
       (match literal n with
        | Some k when k < 0L ->
          fail n_loc
            "slice-from-ptr length %Ld is negative — the length is what the \
             caller promises the pointer addresses, and no pointer addresses \
             fewer than zero elements" k
        | _ -> ());
       prim Tast.SliceFromPtr (Types.Slice elem) [ target; n ]
     | _ -> assert false)

  (* ── pointers ──────────────────────────────────────────────────── *)
  | "addr" ->
    arity loc name 1 args;
    let a = List.hd args in
    (match place_of_expr a with
     | None ->
       fail a.Ast.loc
         "addr takes the address of a place — a name, (.field x), (at a i) \
          or (deref p)"
     | Some p ->
       let p, ty = check_place ctx a.Ast.loc p in
       expect loc ~want (mk loc (Types.Ptr ty) (Tast.Addr p)))
  | "deref" ->
    arity loc name 1 args;
    let a = check ctx (List.hd args) in
    (match a.Tast.ty with
     | Types.Ptr t -> expect loc ~want (mk loc t (Tast.Deref a))
     | other -> fail loc "deref takes a (Ptr T), found %s"
                  (Types.to_string other))

  (* ── Option ────────────────────────────────────────────────────── *)
  | "Some" ->
    arity loc name 1 args;
    let inner = match want with Some (Types.Option t) -> Some t | _ -> None in
    let a = check ctx ?want:inner (List.hd args) in
    expect loc ~want (mk loc (Types.Option a.Tast.ty) (Tast.Some_ a))

  (* ── the milestone-2 host primitives (plan.org) ────────────────── *)
  | "bytes" ->
    arity loc name 1 args;
    prim Tast.Bytes (Types.Slice (Types.Int Types.U8))
      [ check ctx ~want:Types.String (List.hd args) ]

  (* (string b): a [u8] seen as a string. The mirror of (bytes s), spelled the
     same way — a type name in head position, like (bytes s) and unlike the
     numeric casts, which go through [is_cast] and really do convert.

     It costs nothing. emit.ml lowers Types.String and Types.Slice _ to the
     same %slice, 16 bytes at align 8, so a string and a [u8] are already the
     identical value at run time; both this and [Bytes] emit as the argument
     itself. What changes is only what the checker will let the value be
     passed to — which is the whole gap: i64->bytes answers a [u8] and every
     declare-c text parameter wants a string, and nothing joined them.

     Two decisions are baked in here.

     1. It does NOT check UTF-8, because `string` does not claim UTF-8. The
        prelude settles this: valid-utf8? is an ordinary function you call when
        you care, decode-rune/rune-at/rune-count all take [u8] rather than
        string, and decode-rune answers {.ok false .width 1} on a malformed
        byte rather than assuming its input is well-formed. The one place the
        runtime treats a string differently from a byte slice is
        flan_escape_bytes, for a string nested in a printed structure, and that
        is a byte-wise escape table with no decoding in it. So there is no code
        that would be wrong about a string of arbitrary bytes, and a check here
        would be the only enforcement point in the language — a claim the rest
        of it does not make.

     2. It does not widen the literal-write hole (NEXT.md, "Writing through a
        string literal"). That hole is the other direction: (bytes "Hi") hands
        you a writable-looking slice over constant data. This direction only
        loses the ability to write — a string is read-only everywhere — so the
        result of (string b) can reach strictly fewer stores than b could.
        Provenance is still what the other direction needs; nothing here
        depends on having it.

     The sharp edge left here is one of lifetime and no longer one of sharing:
     the slice that i64->bytes / f64->bytes / u64->bytes answer is a view into
     a frame slot belonging to *that call site* (see [to_bytes]), so two of
     them can be held at once and the text of one survives the making of the
     next. What it does not survive is its frame — calling it a string does not
     copy it, so storing one in a container or returning it hands back a view
     of storage that has been reused. Copy the bytes for that. *)
  | "string" ->
    arity loc name 1 args;
    prim Tast.StrOfBytes Types.String [ byte_slice ctx (List.hd args) ]
  | "bytes->f64" ->
    arity loc name 1 args;
    prim Tast.BytesToF64 (Types.Float Types.F64) [ byte_slice ctx (List.hd args) ]
  | "bytes->i64" ->
    arity loc name 1 args;
    prim Tast.BytesToI64 (Types.Int Types.I64) [ byte_slice ctx (List.hd args) ]
  | "f64->bytes" ->
    arity loc name 1 args;
    expect loc ~want
      (to_bytes ctx loc Tast.F64ToBytes
         (check ctx ~want:(Types.Float Types.F64) (List.hd args)))
  | "i64->bytes" ->
    arity loc name 1 args;
    expect loc ~want
      (to_bytes ctx loc Tast.I64ToBytes
         (check ctx ~want:(Types.Int Types.I64) (List.hd args)))
  | "write-stdout" ->
    arity loc name 1 args;
    prim Tast.WriteStdout Types.Unit [ byte_slice ctx (List.hd args) ]

  (* (println x) and (print x): the structural printer, selected on the type
     the argument checked to. plan.org, Milestone 5 — "compiler-provided,
     per concrete type". That is not overloading and needs no type variables:
     there is no dispatch at run time and no user-supplied printer to pick
     between. The walk itself is render.ml, shared with the REPL, which is what
     stops the two from drifting apart.

     [min]/[max]/[zeroed] above dispatch on the resolved argument type the same
     way. The slots the slice arm needs come out of the frame of whatever
     function this call is written in, via [fresh_slot] — allocated once per
     call site, at check time, not once per iteration of a loop around it.

     A string prints raw here and quoted inside a structure. Those are not in
     conflict: (println "hello") has to print hello or it is useless, and
     (println b) where b has a string field has to quote it or the field
     cannot be told from the punctuation. The split is exactly top level vs
     nested, which is why it lives here and not in the walk. *)
  | "print" | "println" ->
    arity loc name 1 args;
    (* Printing is a read, not a move: the walk goes over the value and keeps
       nothing. Without this, (println v) would consume a Vec and every
       printing of one would be its last. *)
    let target = List.hd args in
    let a = check ctx target in
    (* ── The allow-list, and what it takes to get on it ───────────────
       plan.org names [println] as the one compiler-provided exception — it
       "selects a structural printer at each concrete instantiation" — and
       that cannot be reconciled with an abstract pass as written: a pass that
       decides an operator's legality *without* substituting cannot make an
       exception for the one operator whose legality is only decidable after
       substituting. So the exception is made explicit: these two forms are
       *deferred* to instantiation, and every other operator is answered where
       it is written.

       Every member of this list is a place where a refusal moves from the
       definition to a call site, which is the thing the abstract pass exists
       to prevent. **That cost is not the same for every member, and the list
       is not closed.** What makes it bearable is whether the call site has a
       *stated requirement* to be refused against.

       [print] and [println] have none and need none: every type prints, so
       there is no [where] predicate for printability — one would always hold
       and would be noise on a signature — and there is correspondingly no
       call site these can be refused at. They are deferred and then always
       succeed. That is the cheapest possible membership.

       The map operations — [put], [get], [has-key?], [map-remove], [reserve], [clone],
       through [deferred_key] beside [key_fns] — are the other kind, and they
       are here on a different argument. They *can* fail at a concrete type,
       so deferring them does move a refusal. But [{:where (hashable? $t)}] is
       in the signature, and it is the author's own written requirement: an
       instantiation at a non-hashable type is refused against that clause, by
       name, at the call that asked for the type. That is a refusal the caller
       can act on and one the generic's author chose to be responsible for —
       categorically different from an unconstrained [(+ a b)] failing deep in
       a body with no signature to blame, which is the case the abstract pass
       exists to prevent and which stays refused at the definition. A generic
       that does *not* declare the predicate gets no deferral: [deferred_key]
       checks first, and [map_type] has usually refused the signature already.

       So the rule for adding to this list is not a headcount. It is: either
       the operation cannot fail after substituting, or a declared predicate
       gives its failure a place to land. Anything else is answered here.

       The node produced here is a unit no-op, thrown away with the rest of
       the abstract pass. The real printer is selected when the copy is
       checked with [t] concrete. *)
    if generic_ty a.Tast.ty then
      mk loc Types.Unit Tast.Unit
    else
    let bslice = Types.Slice (Types.Int Types.U8) in
    let write x = mk loc Types.Unit (Tast.Prim (Tast.WriteStdout, [ x ])) in
    (* One frame slot per conversion the printer emits, which is what
       [to_bytes] is for. The printer writes each number out before making the
       next, so a shared buffer would in fact have served it — but the slot is
       what the node now carries, and a printer that assembled its own buffer
       would be a second answer to the same question. [escape] is the one that
       still renders into a static: it is reachable from nowhere but here, and
       its 1KB buffer per printed string field is a frame cost with no bug
       behind it. Said here so the asymmetry is a decision and not an
       oversight. *)
    let conv pr x = to_bytes ctx loc pr x in
    let emitter : Render.emitter =
      { Render.ebytes = write;
        estr = (fun x -> write (mk loc bslice
                                  (Tast.Prim (Tast.EscapeBytes, [ x ]))));
        ei64 = (fun x -> write (conv Tast.I64ToBytes x));
        eu64 = (fun x -> write (conv Tast.U64ToBytes x));
        ef64 = (fun x -> write (conv Tast.F64ToBytes x)) }
    in
    let rc =
      { Render.structs =
          Hashtbl.fold (fun _ v acc -> v :: acc) ctx.env.structs [];
        datas = Hashtbl.fold (fun _ v acc -> v :: acc) ctx.env.datas [];
        unions = Hashtbl.fold (fun _ v acc -> v :: acc) ctx.env.unions [];
        enums = Hashtbl.fold (fun k v acc -> (k, v) :: acc) ctx.env.enums [];
        emit = emitter;
        (* [println] never follows a pointer, and the allocation registry does
           not change that. spec-memory.md fixes what it prints — "Ptr and
           Handle print their address or identity rather than recursively
           dereferencing" — and a printed line belongs to the program, so it
           must read the same in a release build, where there is no registry to
           ask. Following one is the *inspector's* move, and session.ml is
           where that context is built. *)
        ptrs = None;
        alloc = (fun ty -> fresh_slot ctx ty) }
    in
    let parts =
      match a.Tast.ty with
      | Types.String | Types.Slice (Types.Int Types.U8) ->
        [ write (mk loc bslice (Tast.Prim (Tast.Bytes, [ a ]))) ]
      | _ -> Render.render rc 0 a
    in
    let nl =
      if String.equal name "println" then
        [ write
            (mk loc bslice
               (Tast.Prim (Tast.Bytes, [ mk loc Types.String (Tast.Str "\n") ])))
        ]
      else []
    in
    expect loc ~want (mk loc Types.Unit (Tast.Do (parts @ nl)))
  | "exit" ->
    arity loc name 1 args;
    prim Tast.Exit Types.Never [ check ctx ~want:index_ty (List.hd args) ]
  | "argv" ->
    arity loc name 0 args;
    prim Tast.Argv (Types.Slice Types.String) []

  (* ── casts: (i32 x), (f64 x), and an enum both ways ────────────────

     (i32 e) and (GamepadAxis n) are written here rather than in an arm of
     their own because they are the same operation: an enum is an i32 at run
     time — Types.Enum says so — and emit.ml's [cast] already reduces one to
     its i32 before choosing an instruction. So both directions cost nothing:
     src and target are equal after that reduction and [cast] answers the
     value unchanged.

     Why this does not give the typo back. The property worth keeping is that
     :spcae at a call site is an error at that site, and it still is: a
     keyword resolves against the parameter's enum and a bare integer does not
     fit one. What changes is only that a program can *say* it means the
     conversion, by name, at the site. The rule was never "an integer is
     dangerous", it was "an integer must not arrive silently", and a written
     (GamepadAxis i) is not silent.

     Three sub-decisions:

     1. enum → any numeric is always allowed and never checked. It is lossless
        to i32 by construction, and a narrower target truncates by the same
        rule every int→int cast already follows — no special case, and (f32 e)
        means (f32 (i32 e)) rather than an arbitrary refusal.

     2. integer → enum accepts a value that is not a declared member. raylib's
        gesture is a bitfield and an OR of flags is a legal Gesture that is no
        single member, so refusing it would refuse correct programs; and
        session.ml's printer already falls through to the number for an
        out-of-range enum, on purpose, so refusing to *construct* one while
        blessing its display would be incoherent. An Option would make every
        site unwrap for no safety bought, and a literal-only refusal would
        catch nothing — the bitfield case is a run-time value.

     3. Only an integer converts *to* an enum. Not a float, which has no
        meaning here, and not another enum: an enum-to-enum hop goes through
        (i32 x) so that both ends are written down. *)
  | _ when Hashtbl.mem ctx.env.enums name ->
    arity loc name 1 args;
    let target = resolve_name ctx.env ~seen:[] loc name in
    let a = check ctx (List.hd args) in
    (match a.Tast.ty with
     | Types.Int _ -> ()
     | other ->
       fail loc "%s converts an integer to an enum, found %s — an enum or a \
                 float goes through (i32 x) first" name
         (Types.to_string other));
    prim (Tast.Cast target) target [ a ]
  (* A cast to a *type variable*: [(t x)] inside a generic body. The name is
     not one [is_cast] knows, because [is_cast] asks whether the name is a
     machine type and [t] is not — so this is its own arm, above the ordinary
     one and below the enums, and it reaches the same [Cast] prim.

     Inside an instantiation [resolve_name] has already answered with the
     concrete target, so the copy casts to a real type and the emitter sees
     nothing unusual. During the abstract pass the target is [Var t] and the
     [where] clause is what says the cast means anything at all: a cast
     produces a number, so [numeric?] is what admits it. *)
  | _ when (List.mem name ctx.env.tyvars || List.mem_assoc name ctx.env.subst)
           && List.length args = 1 ->
    let target = resolve_name ctx.env ~seen:[] loc name in
    unconstrained ctx.env loc ("a cast to " ^ name) ~needs:"numeric?" target;
    let a = check ctx (List.hd args) in
    (match a.Tast.ty with
     | Types.Enum _ -> ()
     | t when Types.is_numeric t || generic_ty t -> ()
     | t -> fail loc "%s converts a number, found %s" name (Types.to_string t));
    prim (Tast.Cast target) target [ a ]
  | _ when is_cast name && List.length args = 1 ->
    let target = resolve_name ctx.env ~seen:[] loc name in
    let a = check ctx (List.hd args) in
    (match a.Tast.ty with
     | Types.Enum _ -> ()
     | t when Types.is_numeric t -> ()
     | t -> fail loc "%s converts a number, found %s" name (Types.to_string t));
    prim (Tast.Cast target) target [ a ]

  (* ── ordinary calls ────────────────────────────────────────────── *)
  (* A local or a parameter holding a function value, called by the name it is
     bound to — which is what the body of [map] looks like. It is checked
     before the global function table and after every builtin: a binding
     shadows a defn of the same name (one namespace, ordinary lexical
     scoping), and nothing shadows [+]. A local of any *other* type falls
     through to the table, so a program that shadows a function name with an
     i32 and then calls the function still means the function. *)
  | _ when (match lookup ctx name with
            | Some b -> (match b.bty with Types.Fn _ -> true | _ -> false)
            | None -> false) ->
    (* The binding the guard already found, read directly. Going back through
       [check] would repeat the lookup and walk the capture path for a type
       that is not capturable. *)
    (match lookup ctx name with
     | Some b -> call_value ctx ~want loc (mk loc b.bty (Tast.Local b.slot)) args
     | None -> assert false)
  | _ when Hashtbl.mem ctx.env.gsigs name ->
    let vars, params, ret = Hashtbl.find ctx.env.gsigs name in
    generic_call ctx ~want loc name vars params ret args
  | _ ->
    match Hashtbl.find_opt ctx.env.fns name with
    | Some (params, ret) ->
      if List.length args <> List.length params then
        fail loc "%s takes %d argument%s, given %d" name
          (List.length params)
          (if List.length params = 1 then "" else "s")
          (List.length args);
      let args = map2_lr (fun p a -> check ctx ~want:p a) params args in
      expect loc ~want (mk loc ret (Tast.Call (name, args)))
    | None ->
      if Hashtbl.mem ctx.env.datas name then
        fail loc
          "%s is a data type — a data type value names the case too, as (%s.%s            {.field value ...})"
          name name (first_case_name ctx.env name)
      else if Hashtbl.mem ctx.env.cases name then
        (* [(U.C)] and [(C)]: a case written as a call. Both are how someone
           reaches for a constructor, and neither is one. *)
        let dname, c = Hashtbl.find ctx.env.cases name in
        fail loc
          "%s is a case of the data type %s — write (%s.%s {.field value ...}), \
           or %s.%s on its own when it has no fields"
          name dname dname c.Tast.vname dname c.Tast.vname
      else if Hashtbl.mem ctx.env.structs name then
        fail loc
          "%s is a type — a struct value is written (%s {.field value ...})"
          name name
      else if String.contains name '/' then
        unimplemented loc
          (Printf.sprintf "the call %s into an imported package" name) 4
      else Loc.failk "check/unknown-function" loc "unknown function %s" name

(* ── A call to a generic function ───────────────────────────────────────
   The whole of instantiation, and it is at the call site because the call
   site is the only place the concrete types exist. Odin does the same thing
   in the same place: [check_expr.cpp]'s
   [find_or_generate_polymorphic_procedure] runs from call checking, builds
   the concrete proc type from the operands, scans the base entity's
   [gen_procs] for an [are_types_identical] match, and generates a new
   [Entity] only on a miss. *)
and generic_call ctx ~want loc name vars pats pret args =
  if List.length args <> List.length pats then
    fail loc "%s takes %d argument%s, given %d" name (List.length pats)
      (if List.length pats = 1 then "" else "s") (List.length args);
  (* Arguments first, and with no expectation where the parameter's type still
     mentions a variable — there is nothing to expect until the argument has
     said what it is. So an untyped literal falls to its own default and
     [(id 3)] instantiates at i32, which is the one place inference at a
     generic call site is weaker than at a monomorphic one.

     A variable already bound by an earlier argument is substituted back into
     the parameters still to come, so [(sort-by (slice ns 0 4) (fn [a b] (< a
     b)))] works: by the time the [fn] is reached, [(Fn [$t $t] bool)] has
     become [(Fn [i32 i32] bool)] and the literal has the position it needs to
     take its types from. Left to right, which is the order Odin's operands
     are gathered in and the order [map2_lr] already guarantees. *)
  let subst = ref [] in
  let targs =
    map2_lr
      (fun p a ->
         let p = subst_ty !subst p in
         let a = if generic_ty p then check ctx a else check ctx ~want:p a in
         if not (bind_ty subst p a.Tast.ty) then
           fail a.Tast.loc "%s expects %s here, found %s" name
             (Types.to_string p) (Types.to_string a.Tast.ty);
         a)
      pats args
  in
  (* Every variable has to be determined by an argument. A return-only
     variable has nothing to bind it — there is no explicit instantiation
     syntax by design (plan.org) — so it is refused here, where the signature
     can be named, rather than producing a copy with a hole in it. *)
  List.iter
    (fun v ->
       if not (List.mem_assoc v !subst) then
         fail loc
           "%s's type variable $%s is not determined by any argument — a \
            generic function is instantiated from its call site, and there is \
            no syntax for naming the type" name v)
    vars;
  let cparams = List.map (subst_ty !subst) pats in
  let cret = subst_ty !subst pret in
  if List.exists generic_ty cparams || generic_ty cret then begin
    (* One generic function calling another at its *own* variable, seen from
       the abstract pass over the caller's body — [sort-by] calling [swap]
       at [t]. There is no copy to make yet: [t] is not a type. The node is
       built so the call still type-checks and is thrown away with the rest of
       the abstract pass; the real copy is generated when the caller is
       instantiated and the same call site resolves [t] to a concrete type.

       But the callee's [where] clause is answerable here, and has to be. The
       whole promise of the abstract pass is that a generic's refusals arrive
       at its definition; if the predicate were left to the instantiation,
       [(defn f [x $t] () (sort [x]))] would be accepted at its definition
       and refused at whichever call site first instantiated it — a refusal in
       code the caller did not write, which is the thing the pass exists to
       avoid. So the caller has to declare at least what the callee asks for,
       and [pred_entails] means [ordered?] covers a callee wanting
       [equal?] without anyone writing both. *)
    (match Hashtbl.find_opt ctx.env.generics name with
     | None -> ()
     | Some gfn ->
       List.iter
         (fun (p : Ast.pred) ->
            match List.assoc_opt p.Ast.pvar !subst with
            | Some (Types.Var v) when not (declares ctx.env.tvpreds v p.Ast.pname) ->
              Loc.failk "check/predicate-not-carried" loc
                "%s is written {:where (%s $%s)}, and this call passes the \
                 type variable %s, which nothing here declares %s. Add \
                 {:where (%s $%s)} to this function's own clause — a \
                 predicate a body relies on has to be carried by every \
                 signature between it and the call site"
                name p.Ast.pname p.Ast.pvar v p.Ast.pname p.Ast.pname v
            | Some t when not (generic_ty t) && not (pred_holds p.Ast.pname t) ->
              Loc.failk "check/predicate-unsatisfied" loc
                "%s is written {:where (%s $%s)}, and this call passes %s, \
                 which is not %s"
                name p.Ast.pname p.Ast.pvar (Types.to_string t) p.Ast.pname
            | _ -> ())
         gfn.Ast.fwhere);
    expect loc ~want (mk loc cret (Tast.Call (name, targs)))
  end
  else
    let sym = instantiate ctx.env loc name vars !subst cparams cret in
    expect loc ~want (mk loc cret (Tast.Call (sym, targs)))

(* Cache or generate, Odin's loop. The key is the whole concrete signature
   compared pairwise with [Types.equal] — [are_types_identical] — so calling
   at the same type twice makes one copy. *)
and instantiate env loc gname vars subst cparams cret =
  let cache =
    match Hashtbl.find_opt env.insts gname with
    | Some r -> r
    | None -> let r = ref [] in Hashtbl.replace env.insts gname r; r
  in
  let same (ps, r, _) =
    List.length ps = List.length cparams
    && List.for_all2 Types.equal ps cparams && Types.equal r cret
  in
  match List.find_opt same !cache with
  | Some (_, _, sym) -> sym
  | None ->
    let sym =
      gname ^ "-"
      ^ String.concat "-" (List.map (fun v -> mangle_ty (List.assoc v subst)) vars)
    in
    if Hashtbl.mem env.fns sym then
      fail loc
        "%s at these types is called %s, and %s is already defined — rename \
         one of them" gname sym sym;
    runaway env loc gname cparams;
    (* Each instantiation checks the concrete types answer the [where] clause.
       This is the half of the feature that only exists per copy: the abstract
       pass took the predicates on trust, and here is where the trust is
       settled, at the call site that asked, naming it. *)
    let fn = Hashtbl.find env.generics gname in
    List.iter
      (fun (p : Ast.pred) ->
         match List.assoc_opt p.Ast.pvar subst with
         | None -> ()
         | Some t ->
           if not (pred_holds p.Ast.pname t) then
             Loc.failk "check/predicate-unsatisfied" loc
               "this call instantiates %s at $%s = %s, and %s does not \
                answer %s — which %s requires, being written {:where (%s \
                $%s)}. The requirement is the signature's, so the refusal is \
                here, at the call that asked for the type: pass one the \
                predicate admits"
               gname p.Ast.pvar (Types.to_string t) (Types.to_string t)
               p.Ast.pname gname p.Ast.pname p.Ast.pvar)
      fn.Ast.fwhere;
    (* The entry goes in *before* the body is checked, which is what makes a
       recursive generic function terminate: the call to itself at the same
       types finds this and does not generate a second copy. *)
    cache := (cparams, cret, sym) :: !cache;
    Hashtbl.replace env.fns sym (cparams, cret);
    let saved_subst = env.subst and saved_vars = env.tyvars
    and saved_preds = env.tvpreds and saved_chain = env.chain in
    (* Inside the copy there are no variables left: [resolve_name] answers
       [t] with the concrete type, so every node the body produces is as
       concrete as one written out by hand. The [where] clause goes out of
       scope with them — there is nothing abstract left for it to permit, and
       every operator is answered by the concrete type it now has. *)
    env.subst <- List.map (fun v -> (v, List.assoc v subst)) vars;
    env.tyvars <- [];
    env.tvpreds <- [];
    env.chain <- env.chain @ [ (gname, cparams, loc) ];
    let restore () =
      env.subst <- saved_subst; env.tyvars <- saved_vars;
      env.tvpreds <- saved_preds; env.chain <- saved_chain
    in
    let tfn =
      match !check_fn_ref env { fn with Ast.name = sym } with
      | tfn -> restore (); tfn
      | exception e ->
        restore ();
        (* A copy whose body did not check is not a copy. Both entries go back
           out, so a second call at the same types is the same refusal again
           rather than a cache hit on a function that does not exist. *)
        cache := List.filter (fun (_, _, s) -> s <> sym) !cache;
        Hashtbl.remove env.fns sym;
        raise e
    in
    env.instances <- tfn :: env.instances;
    sym

and is_cast name =
  Types.ikind_of_name name <> None || Types.fkind_of_name name <> None

and byte_slice ctx (a : Ast.expr) =
  check ctx ~want:(Types.Slice (Types.Int Types.U8)) a

and numeric_want want =
  match want with Some (Types.Int _ | Types.Float _) -> want | _ -> None

(* Both operands of a binary operator have one type, and there is no implicit
   widening, so one side has to decide it. Check the side that carries the most
   information first: a non-literal over a literal, and a float literal over an
   integer one, since an integer constant converts to a float and not back. *)
and binary ctx name loc ~want args =
  match args with
  | [ x; y ] ->
    let y_decides =
      (is_literal x && not (is_literal y))
      || (match x.Ast.e, y.Ast.e with
          | (Ast.Int _ | Ast.Byte _), Ast.Float _ -> true
          | _ -> false)
    in
    if y_decides then begin
      let b = check ctx ?want y in
      let a = check ctx ~want:b.Tast.ty x in
      a, b
    end else begin
      let a = check ctx ?want x in
      let b = check ctx ~want:a.Tast.ty y in
      a, b
    end
  | _ -> fail loc "%s takes two arguments" name

(* ── The builtins, said out loud ───────────────────────────────────────
   A name, a signature and one line, for every name [named_call] and [var]
   answer without the program having written it. The editor's C-c C-v used to
   say "the running program defines no arena-new", which was true and useless:
   a builtin is in the compiler, so it is in no program's symbol table and
   [Dev.defs] had nothing to hand over. This is what it hands over instead.

   It lives here rather than in dev.ml because it describes the arms above it,
   and a table in another file drifts from them silently. [test_flan]'s
   [builtin_table] reads this file and the arms and fails on either one having
   a name the other does not, so the drift is a failing build rather than a
   name that answers nothing.

   The signature follows [Dev.signature_of_fn]'s shape — [name [params] ret] —
   so eldoc reads a builtin the way it reads a defn. Where an arm does not
   have one shape the signature says what is true rather than inventing one:
   [?] marks an argument that may be left out, [|] separates the types an arm
   really does accept, and the predicate names are the compiler's own
   ([numeric?], [ordered?], [equal?] — check.ml's [where] evaluator), because
   a generic's author already writes them. Three names have no shape at all
   and carry a bare name instead of a bracket list; their line says why.

   One line each, because this is read in an echo area and a help buffer. The
   lines are the arms' own reasons, cut down — where an arm argues for a
   decision above itself, the sentence a person needs at the call site is the
   conclusion, not the argument. *)
let builtins : (string * string * string) list =
  [ (* arithmetic and comparison *)
    ("+", "+ [numeric? ...] numeric?",
     "Sum, folded left over two or more operands that share one numeric \
      type — nothing widens implicitly.");
    ("-", "- [numeric? ...] numeric?",
     "Difference, folded left: (- a b c) is ((a - b) - c).");
    ("*", "* [numeric? ...] numeric?",
     "Product, folded left over two or more operands of one numeric type.");
    ("/", "/ [numeric? ...] numeric?",
     "Quotient, folded left. Integer division truncates toward zero.");
    ("%", "% [numeric? numeric?] numeric?",
     "Remainder, and it stays at two operands: (% a b c) would mean \
      (% (% a b) c), which is a thing nobody writes on purpose.");
    ("=", "= [equal? equal?] bool",
     "Equality. It admits one type < does not — a handle, where \"the same \
      entity\" is the question the type exists to answer.");
    ("!=", "!= [equal? equal?] bool",
     "Inequality, over everything = accepts.");
    ("<", "< [ordered? ordered?] bool",
     "Less than. Machine numbers only: ordering a handle would order a \
      free-list slot index, which means nothing.");
    ("<=", "<= [ordered? ordered?] bool", "Less than or equal.");
    (">", "> [ordered? ordered?] bool", "Greater than.");
    (">=", ">= [ordered? ordered?] bool", "Greater than or equal.");
    ("not", "not [bool] bool",
     "Negates a bool. Nothing else in this language is a truth value.");
    ("bit-and", "bit-and [int ...] int",
     "Bitwise and, folded left. Integers only, and every operand has the \
      same width.");
    ("bit-or", "bit-or [int ...] int", "Bitwise or, folded left over integers.");
    ("bit-xor", "bit-xor [int ...] int",
     "Bitwise exclusive or, folded left over integers.");
    ("<<", "<< [int int] int",
     "Left shift. The count has the shifted value's own type, and a literal \
      count at or past its width is refused — LLVM calls that poison.");
    (">>", ">> [int int] int",
     "Right shift, by a count of the value's own type; a literal count at or \
      past the width is refused, as it is for <<.");
    ("min", "min [ordered? ...] ordered?",
     "The smallest of two or more operands, each of them evaluated exactly \
      once however many there are.");
    ("max", "max [ordered? ...] ordered?",
     "The largest of two or more operands, each evaluated exactly once.");
    ("zeroed", "zeroed [] T",
     "The all-bytes-zero value of whatever it is being stored into, so it \
      only means anything where a type is expected of it.");
    ("destructure~nth", "destructure~nth [[n T] i32 i32 i32] T",
     "Written by the compiler for a destructuring let, and unspellable: the \
      reader makes ~ a delimiter, so no source symbol can name this.");

    (* allocators, spec-memory.md *)
    ("make-allocator", "make-allocator",
     "A user-written allocator, not implemented and refused wherever it is \
      written. Use (arena-new n), which is the parameterised allocator that \
      does exist.");
    ("allocator-from", "allocator-from",
     "A user-written allocator, not implemented — see make-allocator.");
    ("allocator", "allocator",
     "A user-written allocator, not implemented — see make-allocator.");
    ("heap-allocator", "heap-allocator [] Allocator",
     "The process heap as an Allocator: it releases one block at a time, so \
      can-free? is true of it.");
    ("arena-new", "arena-new [i64] Allocator",
     "A new arena of exactly this many bytes. The capacity is explicit and \
      the backing store never grows, which is what makes \"exhausted\" a \
      state a test can reach on purpose.");
    ("arena-destroy", "arena-destroy [Allocator] ()",
     "Hands the arena's pages back to the system, which free-all \
      deliberately does not.");
    ("free-all", "free-all [Allocator] ()",
     "Releases everything the allocator holds and bumps its epoch, keeping \
      the capacity. It traps rather than quietly doing nothing when there is \
      no region to release.");
    ("can-free?", "can-free? [Allocator] bool",
     "Whether this allocator can release a single block, read off its \
      capability set rather than asked of a query procedure.");
    ("can-free-all?", "can-free-all? [Allocator] bool",
     "Whether this allocator can release everything it holds at once.");
    ("alloc-epoch", "alloc-epoch [Allocator] i64",
     "The counter free-all bumps. A container records it and traps if it \
      moved; this is the same number, readable, so a program can say what it \
      saw.");
    ("alloc-id", "alloc-id [Allocator] i64",
     "The allocator's identity — its address — which is what a condition's \
      :allocator field carries, so a handler holding several regions can \
      tell which one ran out.");
    ("alloc-budget", "alloc-budget [Allocator] i64",
     "The ceiling on live bytes, 0 for none. A handler that answers \
      StorageExhausted with retry is the one that raises it.");
    ("set-alloc-budget", "set-alloc-budget [Allocator i64] ()",
     "Sets the ceiling on live bytes; 0 for none. It is also how a program \
      exhausts an allocator on purpose.");
    ("alloc-live-blocks", "alloc-live-blocks [Allocator] i64",
     "How many blocks are still live — \"did you forget to free\", answered \
      at the tier that can answer it.");
    ("with-allocator", "with-allocator [Allocator body ...] T",
     "Runs the body with this allocator in the context, and answers the \
      body's last expression. It releases nothing: not at the end of the \
      body, not anywhere.");

    (* (Vec T) *)
    ("vec-new", "vec-new [T? Allocator?] (Vec T)",
     "An empty Vec. A let has no type annotation, so the element type is \
      written at the call — (vec-new i32) — wherever the context does not \
      say it; an allocator may be named the same way.");
    ("push", "push [(Vec T) T] ()",
     "Appends one element, growing the Vec through its allocator. Unit and \
      not an error code: a failed allocation signals StorageExhausted.");
    ("reserve", "reserve [(Vec T)|(Map K V) i32] ()",
     "Makes room for n more. For a map the number is entries rather than \
      slots — the block is sized so that n still sits under the load \
      factor.");
    ("as-slice", "as-slice [(Vec T) i32? i32?] [T]",
     "A non-owning view of the whole Vec, or of the half-open range \
      [lo hi). It carries no allocator, and a push, a put or a reserve may \
      invalidate it.");
    ("free", "free [(Vec T)|(Map K V)] ()",
     "Releases the container's block. It does not recurse into elements that \
      own storage — such a container is refused here, and releasing its \
      region with free-all is the answer.");
    ("clone", "clone [(Vec T)|(Map K V) Allocator?] (Vec T)|(Map K V)",
     "A deep, independent copy, from the current allocator or one named. \
      Refused for a container whose elements own storage: a bytewise copy \
      would alias the original's blocks under a name promising otherwise.");

    (* (Map K V) *)
    ("map-new", "map-new [K? V? Allocator?] (Map K V)",
     "An empty map. The key and value types are written at the call — \
      (map-new string i32) — wherever the context does not say them.");
    ("put", "put [(Map K V) K V] ()",
     "Inserts or replaces. Unit rather than an error code, and \
      (set (get m k) v) is not map syntax.");
    ("get", "get [(Map K V) K] (Option V)",
     "The value at the key, or None. Nothing signals here — a lookup that \
      finds nothing is an answer — and the value comes back as a copy of \
      its bytes.");
    ("map-remove", "map-remove [(Map K V) K] (Option V)",
     "Removes the entry and answers the value it held, or None if there was \
      none.");
    ("map-next", "map-next [(Map K V) (Ptr i64) (Ptr K) (Ptr V)] bool",
     "Walks the map one entry per call through a cursor the caller owns, and \
      is the whole of map iteration: (while (map-next m (addr cur) (addr k) \
      (addr v)) ...).");
    ("has-key?", "has-key? [(Map K V) K] bool",
     "Whether the key is present, copying no value — the form a condition \
      wants, where get would hand back an Option to match on.");

    (* assets, embedded at compile time *)
    ("embed", "embed [\"path\" string?] [u8]",
     "The file's bytes, read at compile time and baked in as a constant; \
      (embed \"p\" string) reads it as a string instead. The path is \
      relative to the file the form is written in, and the slice points into \
      read-only data.");
    ("embed-dir", "embed-dir [\"path\"] [n EmbedFile]",
     "Every file in the directory, read at compile time, as a fixed array of \
      EmbedFile. It does not descend.");

    (* files *)
    ("slurp", "slurp [string Allocator?] (Vec u8)",
     "Reads a whole file. No Result and no out-parameter: a failure to read \
      signals FileError under retry and use-value, and a failure to allocate \
      signals StorageExhausted.");
    ("barf", "barf [string [u8]] ()",
     "Writes a whole file. On the web target it signals FileError every \
      time, with the path — there is no conditional compilation, so the \
      program decides rather than the build.");
    ("delete-file", "delete-file [string] ()",
     "Removes the file, or signals FileError with retry and use-value. It \
      answers () and not a bool, because the failure is the condition.");
    ("make-directory", "make-directory [string] ()",
     "Creates the directory, or signals FileError. () for the reason \
      delete-file answers one.");
    ("rename-file", "rename-file [string string] ()",
     "Renames the first path to the second, or signals FileError. A \
      use-value names a different source for the same destination, which is \
      the direction a handler can act on.");

    (* containers *)
    ("len", "len [[n T]|[T]|string|(Vec T)|(Map K V)] i32",
     "How many elements. One question and one word across an array, a slice, \
      a string, a Vec and a Map.");
    ("at", "at [collection i32 ...] T",
     "The element at an index, bounds-checked — and for a Vec with the \
      allocator's epoch checked first. It is also a place, so \
      (set (at v i) x) goes through the same check.");
    ("slice", "slice [[n T]|[T] i32 i32] [T]",
     "The half-open range [lo hi) as a non-owning view. A bound may sit one \
      past the end; a literal pair that runs backwards is refused here.");
    ("slice-from-ptr", "slice-from-ptr [(Ptr T) i32] [T]",
     "Puts a length on a pointer that came back from C. The caller promises \
      it addresses that many initialised T and that they outlive the result; \
      the compiler checks none of it.");
    ("addr", "addr [place] (Ptr T)",
     "The address of a place — a name, (.field x), (at a i) or (deref p) — \
      and not of an arbitrary expression.");
    ("deref", "deref [(Ptr T)] T",
     "The value behind a pointer, and a place, so (set (deref p) x) writes \
      through it.");

    (* Option *)
    ("Some", "Some [T] (Option T)",
     "Wraps a value as a present Option. None is the other half, and is \
      written as a name rather than as a call.");

    (* the host primitives *)
    ("bytes", "bytes [string] [u8]",
     "A string seen as a byte slice. It costs nothing — both are a ptr and a \
      length at run time — and it decodes nothing. A literal's bytes are \
      constant data, so the slice looks writable and is not.");
    ("string", "string [[u8]] string",
     "A byte slice seen as a string, and free at run time. It does not check \
      UTF-8, because `string` does not claim UTF-8 — valid-utf8? is an \
      ordinary function you call when you care.");
    ("bytes->f64", "bytes->f64 [[u8]] f64", "Parses a float out of the bytes.");
    ("bytes->i64", "bytes->i64 [[u8]] i64",
     "Parses an integer out of the bytes.");
    ("f64->bytes", "f64->bytes [f64] [u8]",
     "The number's text, in a frame slot belonging to this call site — so \
      two of them can be held at once, and neither survives its frame. Copy \
      the bytes to keep one.");
    ("i64->bytes", "i64->bytes [i64] [u8]",
     "The number's text, in a frame slot belonging to this call site; it \
      does not survive the frame.");
    ("write-stdout", "write-stdout [[u8]] ()",
     "Writes the bytes to standard output exactly as given: no newline and \
      no formatting.");
    ("print", "print [T] ()",
     "The structural printer, selected for the argument's concrete type. A \
      string prints raw at the top level and quoted inside a structure, and \
      a Ptr or a Handle prints its address rather than being followed. \
      Printing is a read, so it does not consume the value.");
    ("println", "println [T] ()", "print, with a newline after it.");
    ("exit", "exit [i32] never",
     "Ends the process with this status. It has no value, so nothing written \
      after it runs.");
    ("argv", "argv [] [string]", "The command line, as a slice of strings.");

    (* the five that are names rather than calls — [var]'s arms. Their
       signature is the [name type] shape [Dev.defs] gives a global, because
       that is what they are at the site: a value, not a call. *)
    ("true", "true bool", "The true boolean literal.");
    ("false", "false bool", "The false boolean literal.");
    ("None", "None (Option T)",
     "The absent Option. It takes its type from its context — a return type \
      or an annotated binding — because nothing about the word says what it \
      is an Option of.");
    ("context/allocator", "context/allocator Allocator",
     "The allocator in effect here: what with-allocator rebinds, and what an \
      allocating operation uses when none is named at the site.");
    ("context/temp", "context/temp Allocator",
     "The scratch allocator the calling convention carries beside \
      context/allocator.")
  ]

(* ── Declarations: pass 1, collect ─────────────────────────────────── *)

(* Constant folding, only over integers and only for defconst — enough for an
   array length like (/ screen-height cell-size). *)
let rec const_int env (e : Ast.expr) : int64 option =
  match e.Ast.e with
  | Ast.Int n -> Some n
  | Ast.Byte b -> Some (Int64.of_int b)
  | Ast.Var n -> Hashtbl.find_opt env.consts n
  (* Left to right over any number of operands, because that is how the
     checker reads the same form: an array length that type-checks as a
     product of three literals and is then not a constant would be a
     distinction with nothing behind it. [%] is still two, as it is there. *)
  | Ast.Call ({ Ast.e = Ast.Var op; _ }, x :: y :: rest) ->
    let step a b =
      match op with
      | "+" -> Some (Int64.add a b)
      | "-" -> Some (Int64.sub a b)
      | "*" -> Some (Int64.mul a b)
      | "/" when b <> 0L -> Some (Int64.div a b)
      | "%" when b <> 0L && rest = [] -> Some (Int64.rem a b)
      | _ -> None
    in
    List.fold_left
      (fun acc e ->
         match acc, const_int env e with
         | Some a, Some b -> step a b
         | _ -> None)
      (const_int env x) (y :: rest)
  | _ -> None

let collect env (decls : Ast.decl list) =
  (* One pass over every declaration kind before any of the others, because
     the tables below are per-kind — structs, data types, aliases, enums, functions
     and globals each have their own — and a collision between two of them
     would otherwise be found by LLVM, as [redefinition of function
     '@flan.item'], or not at all. A [defn item] and a [defvar item] are two
     declarations of one name and are rejected here. *)
  let claimed = Hashtbl.create 64 in
  List.iter
    (fun (d : Ast.decl) ->
       match Ast.declared_name d with
       | None -> ()
       | Some n ->
         (match Hashtbl.find_opt claimed n with
          | Some first ->
            (* The second one is the error, because it is the one to delete;
               the first is the note, because without it the message is a
               claim the reader has to go and verify. *)
            Loc.failk "check/defined-twice" d.Ast.dloc
              ~notes:[ Loc.note first (n ^ " is already defined here") ]
              "%s is defined twice" n
          | None -> ());
         Hashtbl.add claimed n d.Ast.dloc)
    decls;
  (* Names first, so a struct may mention one declared below it. *)
  List.iter
    (fun (d : Ast.decl) ->
       match d.Ast.d with
       | Ast.Defstruct (n, _) ->
         Hashtbl.replace env.locs n d.Ast.dloc;
         Hashtbl.replace env.structs n { Tast.sname = n; fields = [] }
       | Ast.Defdata (n, _) ->
         Hashtbl.replace env.locs n d.Ast.dloc;
         Hashtbl.replace env.datas n { Tast.dname = n; cases = [] }
       | Ast.Defunion (n, _) ->
         Hashtbl.replace env.locs n d.Ast.dloc;
         Hashtbl.replace env.unions n { Tast.sname = n; fields = [] }
       | Ast.Defalias (n, t) -> Hashtbl.replace env.aliases n t
       | _ -> ())
    decls;
  (* Compile-time integer constants next, to a fixpoint, because an array
     length may name a constant declared below it — top-level names in a
     package are order-independent (plan.org, Modules). *)
  let fold_consts () =
    let progress = ref false in
    List.iter
      (fun (d : Ast.decl) ->
         match d.Ast.d with
         | Ast.Defconst (n, _, v) when not (Hashtbl.mem env.consts n) ->
           (match const_int env v with
            | Some i -> Hashtbl.replace env.consts n i; progress := true
            | None -> ())
         | _ -> ())
      decls;
    !progress
  in
  while fold_consts () do () done;
  let field (f : Ast.field) : Tast.field =
    let fty = resolve env f.Ast.fty in
    no_zeroed_fn f.Ast.fty.Ast.tloc
      (Printf.sprintf "the field %s" f.Ast.fname) fty;
    { Tast.fname = f.Ast.fname; fty }
  in
  (* Constants with no declared type are inferred from their value, which needs
     every other signature in hand — so they are deferred to a pass of their
     own below. *)
  let untyped = ref [] in
  (* Enums come first, in a pass of their own: a signature below may name one,
     and [resolve] has to find it before it resolves that signature. *)
  List.iter
    (fun (d : Ast.decl) ->
       match d.Ast.d with
       | Ast.Defenum (n, members) ->
         let names = List.map fst members in
         if List.length (List.sort_uniq compare names) <> List.length names then
           fail d.Ast.dloc "%s declares the same member twice" n;
         Hashtbl.replace env.enums n members;
         Hashtbl.replace env.locs n d.Ast.dloc
       | _ -> ())
    decls;
  (* Every type name is registered by here — structs, data types and unions by
     the names-first pass, aliases with them, enums by the pass just above — so
     this is the first point at which a [defn]'s parameter vector can be paired.
     It is done before the signature loop below rather than inside it, because a
     signature may name a type declared further down and pairing must not depend
     on the order the file was written in. *)
  let decls = pair_decls env decls in
  List.iter
    (fun (d : Ast.decl) ->
       let loc = d.Ast.dloc in
       match d.Ast.d with
       | Ast.Package _ -> ()
       | Ast.Defenum _ -> ()
       (* Imports are gone by now: [Load] resolved them into these very decls,
          so one reaching the checker is a driver that skipped that step. *)
       | Ast.Import (alias, _) ->
         fail loc "internal: the import of %s was not resolved before checking"
           alias
       (* [Shim.expand] rewrote every one of these into a [Declare] and a
          [Defn] before [collect] ran, so one arriving here is a driver that
          skipped that step. *)
       | Ast.DeclareC (fn, _) ->
         fail loc "internal: the declare-c of %s was not expanded before checking"
           fn.Ast.name
       | Ast.Declare (fn, csym) ->
         if Hashtbl.mem env.fns fn.Ast.name then
           fail loc "%s is declared twice" fn.Ast.name;
         let params =
           List.map (fun (p : Ast.field) -> resolve env p.Ast.fty) fn.Ast.params
         in
         let ret =
           match fn.Ast.ret with None -> Types.Unit | Some t -> resolve env t
         in
         (* What may cross the boundary. A slice or a string goes as ptr+len,
            a scalar as itself; an aggregate does not go at all, because how
            one is passed differs per target and reproducing that here would
            be three calling conventions to maintain. Pass (Ptr T) instead and
            let the C shim dereference it — that is what the shim is for. *)
         let crossable what (t : Types.t) =
           match t with
           | Types.Int _ | Types.Float _ | Types.Bool | Types.Ptr _
           | Types.Enum _ | Types.Unit -> ()
           | Types.String | Types.Slice _ when what = "a parameter" -> ()
           | _ ->
             fail loc
               "%s of %s is %s, which cannot cross to C directly — pass \
                (Ptr %s) and let the shim read it" what fn.Ast.name
               (Types.to_string t) (Types.to_string t)
         in
         List.iter (crossable "a parameter") params;
         crossable "the return type" ret;
         Hashtbl.replace env.fns fn.Ast.name (params, ret);
         Hashtbl.replace env.externs fn.Ast.name csym
       | Ast.Defalias _ -> ()
       | Ast.Defstruct (n, fs) ->
         let names = List.map (fun (f : Ast.field) -> f.Ast.fname) fs in
         if List.length (List.sort_uniq compare names) <> List.length names then
           fail loc "%s declares the same field twice" n;
         let fields = List.map field fs in
         (* Recorded before the refusal below rather than after it, because the
            refusal asks [region_only], which walks this very declaration: a
            recursive value's field is a [(Vec Value)] and answering for it
            means reading [Value]'s own cases back out of the table. A [fail]
            aborts the whole compilation, so an entry left behind by a
            declaration that is about to be refused is never read. *)
         Hashtbl.replace env.structs n { Tast.sname = n; fields };
         (* A struct field may own storage. Since the repeal a struct
            holding a [(Vec i32)] is an ordinary value: assignment copies the
            header bytes, the copies alias one buffer, and freeing through
            two copies is the program's bug — Odin's contract, kept whole.

            The region rule is separate and survives on its own ground: a
            field whose container holds *owning* elements can only have been
            built against a region allocator — the guard at its construction
            is what makes sure of it (see [vec-new]) — so that graph is
            released by one [free-all] and no teardown recurses anywhere. *)
       | Ast.Defdata (n, vs) ->
         (* A data type with no cases has no value, so nothing could ever be given
            one, and a parameter of that type would be a function nothing can
            call. It parses; it is refused here rather than surviving to a
            layout with a tag and no case for the tag to name. *)
         if vs = [] then
           fail loc
             "%s declares no cases, so no value of it can exist — a data type is \
              (defdata %s [(Case [field Type ...]) ...])" n n;
         let cnames = List.map (fun (v : Ast.variant) -> v.Ast.vname) vs in
         if List.length (List.sort_uniq compare cnames) <> List.length cnames
         then fail loc "%s declares the same case twice" n;
         let cases_with_loc =
           List.map
             (fun (v : Ast.variant) ->
                let fnames =
                  List.map (fun (f : Ast.field) -> f.Ast.fname) v.Ast.vfields
                in
                if List.length (List.sort_uniq compare fnames)
                   <> List.length fnames then
                  fail v.Ast.vloc "%s.%s declares the same field twice"
                    n v.Ast.vname;
                let vfields = List.map field v.Ast.vfields in
                v.Ast.vloc, { Tast.vname = v.Ast.vname; vfields })
             vs
         in
         let cases = List.map snd cases_with_loc in
         (* Registered before the field refusal below, not after, for the
            reason the struct's copy of this gives: [region_only] has to read
            this data type's own cases back out to answer for a [(Vec Value)]
            that names [Value]. The two declarations do this identically
            because a data type that could hold a container where a struct
            could not would be a hole in the same rule. *)
         Hashtbl.replace env.datas n { Tast.dname = n; cases };
         (* A case's fields are a struct and may own storage, on the struct's
            terms since the repeal: copies alias, and the free is the
            program's to write. The region rule still applies on its own
            ground — a [(Vec Value)] case field can only have been built
            against a region, so the recursive dynamic value parses into an
            arena and one [free-all] releases the graph, no teardown
            anywhere. *)
         List.iter
           (fun (c : Tast.variant) ->
              Hashtbl.replace env.cases (n ^ "." ^ c.Tast.vname) (n, c);
              Hashtbl.replace env.cases c.Tast.vname (n, c))
           cases
       (* Nothing records which member of a union is live, so nothing — the
          program included — can free the right one through the union itself.
          Since the repeal that is a fact about the value and not a refusal:
          a member may own storage, and freeing it is done through whatever
          tag the program keeps beside the union, as C does. *)       | Ast.Defunion (n, ms) ->
         if ms = [] then
           fail loc
             "%s declares no members, so it has no size and nothing could be \
              read out of it — a union is (defunion %s [member Type ...])" n n;
         let names = List.map (fun (f : Ast.field) -> f.Ast.fname) ms in
         if List.length (List.sort_uniq compare names) <> List.length names then
           fail loc "%s declares the same member twice" n;
         let fields = List.map field ms in
         Hashtbl.replace env.unions n { Tast.sname = n; fields }
       | Ast.Defn fn ->
         (* A signature that introduces a type variable is a *pattern*, not a
            signature: it goes in [gsigs] and the function goes nowhere near
            [fns], because nothing can be called at [t]. Every call site turns
            it into an ordinary entry. *)
         let vars = signature_tyvars fn in
         (* The [where] clause is checked against the signature here, once,
            rather than at every use of it: a predicate nobody has heard of,
            or one about a variable the signature never bound, is a mistake
            about this definition and is refused at this definition. *)
         List.iter
           (fun (p : Ast.pred) ->
              if not (List.mem p.Ast.pname predicate_names) then
                Loc.failk "check/unknown-predicate" p.Ast.ploc
                  "%s is not a type predicate. The ones there are: %s"
                  p.Ast.pname (String.concat ", " predicate_names);
              if not (List.mem p.Ast.pvar vars) then
                Loc.failk "check/unbound-predicate-variable" p.Ast.ploc
                  "$%s is not a type variable of %s — a where clause \
                   constrains the variables the signature binds%s"
                  p.Ast.pvar fn.Ast.name
                  (if vars = [] then ", and this signature binds none"
                   else
                     ", which here are "
                     ^ String.concat ", " (List.map (fun v -> "$" ^ v) vars)))
           fn.Ast.fwhere;
         env.tyvars <- vars;
         env.tvpreds <- fn.Ast.fwhere;
         let params =
           List.map (fun (p : Ast.field) -> resolve env p.Ast.fty) fn.Ast.params
         in
         let ret =
           match fn.Ast.ret with None -> Types.Unit | Some t -> resolve env t
         in
         env.tyvars <- [];
         env.tvpreds <- [];
         if vars = [] then Hashtbl.replace env.fns fn.Ast.name (params, ret)
         else begin
           Hashtbl.replace env.generics fn.Ast.name fn;
           Hashtbl.replace env.gsigs fn.Ast.name (vars, params, ret)
         end
       | Ast.Defvar (n, t, _) ->
         let ty = match t with
           | Some t -> resolve env t
           | None -> fail loc "defvar %s needs a type" n
         in
         Hashtbl.replace env.globals n (ty, false)
       | Ast.Defconst (n, Some t, _) ->
         Hashtbl.replace env.globals n (resolve env t, true)
       | Ast.Defconst (n, None, v) -> untyped := (n, v) :: !untyped)
    decls;
  (* Also to a fixpoint, and for the same reason: one untyped constant may be
     defined in terms of another declared after it. A constant that still does
     not check once no progress is left has a real error, so the last round is
     run without swallowing it. *)
  let infer (_, v) =
    (check { env; ret = Types.Unit; slots = 0; slot_tys = []; slot_names = []; scope = []; defers = [];
      outer = []; outer_what = None; in_frames = None; loops = []; tail = false; in_defer = false; defer_ok = false; defer_block = "a nested form"; owner = "<none>" } v).Tast.ty
  in
  let pending = ref (List.rev !untyped) in
  let rec settle () =
    let left =
      List.filter
        (fun ((n, _) as c) ->
           match infer c with
           | ty -> Hashtbl.replace env.globals n (ty, true); false
           | exception Loc.Error _ -> true)
        !pending
    in
    let progressed = List.length left < List.length !pending in
    pending := left;
    if progressed && left <> [] then settle ()
  in
  settle ();
  List.iter (fun c -> ignore (infer c)) !pending;
  (* The paired declarations, handed back so that pass two checks the bodies of
     the same functions whose signatures this pass registered. Pairing needs the
     type names, which only this pass has; every pass after it needs the result,
     and a [defn] still carrying an unpaired vector would check as a function of
     no parameters at all. *)
  decls

(* A type that contains itself by value has no finite size. [(Ptr T)] and a
   slice are indirections and break the cycle; a fixed array does not, because
   it is inline. Caught here rather than when a backend tries to lay the type
   out or a zero value is built for it — which would not fail, it would hang. *)
let check_finite env =
  let rec walk seen name =
    if List.mem name seen then
      fail (Option.value (Hashtbl.find_opt env.locs name) ~default:Loc.unknown)
        "%s contains itself by value, so it has no size — go through (Ptr %s)"
        name name;
    let seen = name :: seen in
    match Hashtbl.find_opt env.structs name with
    | Some s -> List.iter (fun (f : Tast.field) -> ty seen f.Tast.fty) s.Tast.fields
    | None ->
      match Hashtbl.find_opt env.datas name with
      | Some u ->
        List.iter
          (fun (c : Tast.variant) ->
             List.iter (fun (f : Tast.field) -> ty seen f.Tast.fty) c.Tast.vfields)
          u.Tast.cases
      | None ->
        (* A union whose member is itself is the same infinite type a struct's
           is — the size is the largest member and the largest member is the
           whole thing. Nothing about overlaying storage makes the recursion
           finite, so it is on the same walk rather than left to hang the
           layout calculator. *)
        match Hashtbl.find_opt env.unions name with
        | None -> ()
        | Some u ->
          List.iter (fun (f : Tast.field) -> ty seen f.Tast.fty) u.Tast.fields
  and ty seen = function
    | Types.Named n -> walk seen n
    | Types.Array (_, e) | Types.Option e -> ty seen e
    | _ -> ()
  in
  Hashtbl.iter (fun n _ -> walk [] n) env.structs;
  Hashtbl.iter (fun n _ -> walk [] n) env.datas;
  Hashtbl.iter (fun n _ -> walk [] n) env.unions

(* No [bool] and no data type anywhere inside a union, at any depth — see the [Defunion] arm in
   [collect] for why an [i1] read out of a union is the one punning hazard
   Flan refuses rather than defines. It runs here, after [collect], because it
   has to look through a member's *struct* to reach the fields inside it and
   the struct table is only complete once every declaration has been walked. A
   union that contains itself is impossible by [check_finite] above, so the
   recursion terminates without a seen set — except through a [Ptr], which
   this does not follow: a bool behind a pointer is a bool in someone else's
   storage and is loaded from an address, not reinterpreted out of a blob. *)
let check_union_members env =
  let rec walk uname where (t : Types.t) =
    match t with
    | Types.Bool ->
      fail (Option.value (Hashtbl.find_opt env.locs uname) ~default:Loc.unknown)
        "%s is a bool, and a union may not hold one at any depth: writing a \
         member that overlays it leaves a byte that is neither 0 nor 1, and \
         an i1 with that byte in it is a value the optimiser is entitled to \
         assume cannot exist. Hold a u8 in the union and compare it yourself"
        where
    (* An [Option] is deliberately not on this list, and the difference is
       worth stating because a reader will ask. Its [match] lowers to a test of
       the tag byte and a branch, so a scribbled tag reads as a [Some] with a
       garbage payload — a number nobody stored, which is exactly what this
       language says a union read is. A data type's lowers to a chain of
       comparisons with an [unreachable] after the last one. *)
    | Types.Array (_, e) | Types.Option e -> walk uname where e
    | Types.Named n when Hashtbl.mem env.datas n ->
      fail (Option.value (Hashtbl.find_opt env.locs uname) ~default:Loc.unknown)
        "%s is %s, a data type, and a union may not hold one at any depth: a \
         data type's tag steers every match over it, and overlaying another \
         member leaves that tag arbitrary — a tag no case names falls past \
         every comparison into a block the optimiser may treat as \
         unreachable. This is the same refusal uninit on a data type gets, \
         and it arrives here because a union is the other way to hand one \
         bytes nobody wrote. Hold the %s beside the union"
        where n n
    | Types.Named n ->
      (match Hashtbl.find_opt env.structs n with
       | Some st ->
         List.iter
           (fun (f : Tast.field) ->
              walk uname (where ^ "." ^ f.Tast.fname) f.Tast.fty)
           st.Tast.fields
       | None ->
         match Hashtbl.find_opt env.unions n with
         | None -> ()
         | Some u ->
           List.iter
             (fun (f : Tast.field) ->
                walk uname (where ^ "." ^ f.Tast.fname) f.Tast.fty)
             u.Tast.fields)
    | _ -> ()
  in
  Hashtbl.iter
    (fun n (u : Tast.structure) ->
       List.iter
         (fun (f : Tast.field) -> walk n (n ^ "'s member " ^ f.Tast.fname) f.Tast.fty)
         u.Tast.fields)
    env.unions

(* ── Declarations: pass 2, check bodies ────────────────────────────── *)

let rec check_fn env (fn : Ast.fn) : Tast.fn =
  let params, ret = Hashtbl.find env.fns fn.Ast.name in
  let ctx = { env; ret; slots = 0; slot_tys = []; slot_names = []; scope = []; defers = [];
                outer = []; outer_what = None; in_frames = None; loops = []; tail = false; in_defer = false; defer_ok = false; defer_block = "a nested form";
                owner = fn.Ast.name } in
  List.iter2
    (fun (p : Ast.field) ty ->
       if List.mem_assoc p.Ast.fname ctx.scope then begin
         let first =
           List.find_opt
             (fun (q : Ast.field) -> q.Ast.fname = p.Ast.fname)
             fn.Ast.params
         in
         let notes =
           match first with
           | Some q when q != p ->
             [ Loc.note q.Ast.floc ("the first " ^ p.Ast.fname ^ " is here") ]
           | _ -> []
         in
         Loc.failk "check/duplicate-parameter" p.Ast.floc ~notes
           "%s has two parameters named %s" fn.Ast.name p.Ast.fname
       end;
       ignore (bind ctx p.Ast.fname ty ~assignable:false))
    fn.Ast.params params;
  let body =
    match fn.Ast.fbody with
    | [] ->
      if Types.equal ret Types.Unit then []
      else fail fn.Ast.nloc "%s returns %s but has no body" fn.Ast.name
             (Types.to_string ret)
    | body ->
      (* The last form is the return value, unless the function returns Unit,
         in which case whatever it evaluates to is discarded. *)
      let want = if Types.equal ret Types.Unit then None else Some ret in
      (* Every form here is at the top level of the function body, so every one
         of them may carry a [defer] — and so may a form inside a [let] written
         here, which is what [ctx.defer_ok] carries down. [check] registers it
         and yields [unit]; the permission is granted again before each form
         because [check] withdraws it as it starts.

         A trailing [defer] is still a [defer] and not the return value, so the
         expectation is not put to it: it would only ever report [Unit] against
         the declared return type, which names the wrong problem. *)
      let is_defer (e : Ast.expr) =
        match e.Ast.e with Ast.Defer _ -> true | _ -> false
      in
      let rec go = function
        | [ last ] ->
          ctx.defer_ok <- true;
          [ (if is_defer last then check ctx last else check ctx ?want last) ]
        | x :: rest ->
          ctx.defer_ok <- true;
          let x = check ctx x in
          x :: go rest
        | [] -> assert false
      in
      go body
  in
  (* Function exit runs the defers, innermost first. An explicit [return] ran
     its own (see [check]); this is the fall-off-the-end path. A trap does not
     run them — it is [noreturn] and then [unreachable] — and that is the same
     rule the bounds checks already follow. *)
  let body =
    match ctx.defers with
    | [] -> body
    | ds when Types.equal ret Types.Unit -> body @ ds
    | ds ->
      (* The result is computed before the defers run and returned after, so it
         goes through a slot rather than staying the last form. *)
      let rec split = function
        | [ last ] -> ([], last)
        | x :: rest -> let (init, last) = split rest in (x :: init, last)
        | [] -> assert false
      in
      let init, last = split body in
      let s = fresh_slot ctx ret in
      let loc = last.Tast.loc in
      init @ [ mk loc ret
                 (Tast.Let ([ (s, last) ], ds @ [ mk loc ret (Tast.Local s) ])) ]
  in
  { Tast.name = fn.Ast.name; params;
    slots = Array.of_list (List.rev ctx.slot_tys);
    snames = Array.of_list (List.rev ctx.slot_names);
    (* The same defers again, for the transfer exit path §5 describes. The
       normal path has them spliced into [body] above. *)
    ret; body; fdefers = ctx.defers; fparent = None; floc = fn.Ast.nloc }

(* The generic body, checked once with its variables abstract. Nothing is kept
   — the [Tast.fn] it produces is thrown away, and so is anything it lifted —
   because a generic function has no code: only its instantiations do. What is
   kept is the *refusal*: an operator an unconstrained variable does not
   support fails here, at the definition, naming the variable, rather than at
   whichever call site happened to instantiate it at a type that worked.

   The holes in it are real and are the report's business: [println] is
   plan.org's one compiler-provided exception and this pass rejects it. *)
and check_generic env (fn : Ast.fn) =
  let vars, params, ret = Hashtbl.find env.gsigs fn.Ast.name in
  let saved_lifted = env.lifted and saved_vars = env.tyvars
  and saved_preds = env.tvpreds in
  env.tyvars <- vars;
  (* What the abstract pass may assume. Every operator the body reaches asks
     [env.tvpreds] whether the variable was declared to support it, and every
     instantiation asks the concrete type the same question again. *)
  env.tvpreds <- fn.Ast.fwhere;
  Hashtbl.replace env.fns fn.Ast.name (params, ret);
  let finish () =
    Hashtbl.remove env.fns fn.Ast.name;
    env.lifted <- saved_lifted;
    env.tyvars <- saved_vars;
    env.tvpreds <- saved_preds
  in
  (match check_fn env fn with
   | _ -> finish ()
   | exception e -> finish (); raise e)

(* The knot from [instantiate]: a call site makes a copy, and making one is
   checking a function. *)
let () = check_fn_ref := check_fn

(* A container's only compile-time *constant* is the zeroed one: a Vec's or a
   Map's real value exists at run time, behind an allocator. That fact has not
   changed. What changed is what follows from it.

   It used to follow that a container global could only ever start zeroed, and
   the argument was that there was nowhere for a computed initialiser to run:
   [Emit.const] said "there is no init-at-startup path, by design", and the
   backend that did run initialisers at startup ran them out of .init_array,
   which a reload module deliberately has none of. A rule that held on one
   backend and not the other would not be a rule, so the language refused the
   form on both.

   There is an init-at-startup path now, and it is the same one on both
   backends: a computed initialiser is lifted into a function of its own and
   the program calls it from [main], after the runtime is up and before any of
   the program's own code runs. So the premise is gone and the refusal goes
   with it. (defvar g (Vec u8) (slurp "level.edn")) is an ordinary program now,
   and it is the shape the author kept writing.

   What is still refused is [uninit] on one, and that is a different rule with
   a reason of its own: a Vec's garbage pointer is not a garbage number. Every
   operation on it dereferences a block address nobody wrote, where a zeroed
   Vec is a real empty Vec — null block, zero length, zero capacity — and is
   the value a program would have written anyway.

   What a runtime-loaded global is for has not changed either. The data is
   loaded once and it outlives main: a main that returns and is entered again
   finds the global exactly as it left it, because nothing between the two runs
   touches it — and that now includes a reload, which does not re-run
   initialisers. Assigning a second time overwrites the first block and leaks
   it — there is no [drop] and no cross-function flow analysis that could see
   the second assignment, so that is the manual-memory answer and the
   language's own: free is a thing you write. *)
let rec zero_only (t : Types.t) =
  match t with
  | Types.Vec _ | Types.Map _ -> true
  | Types.Option e | Types.Array (_, e) -> zero_only e
  | _ -> false

let container_global_init loc n (ty : Types.t) (init : Ast.init) =
  if zero_only ty then
    match init with
    | Ast.Uninit ->
      fail loc
        "the global %s is %s, and uninit on one is refused: its block pointer \
         steers every read of it, and garbage there is not a garbage number \
         the way it is for an f64. Write (defvar %s %s) with no initialiser — \
         a zeroed %s is an empty one, and that is a value, not a placeholder"
        n (Types.to_string ty) n (Types.to_string ty) (Types.to_string ty)
    | _ -> ()

(* A container global has to be a [defvar]. A [defconst] is not an assignable
   place — [check_place] refuses one by name — and a container's only constant
   is the zeroed one, so a constant Vec could only ever hold the empty value
   it was declared with: nothing could ever put the file's bytes in it.
   Refused here, where the fix is one keyword, rather than at the (set ...)
   that discovers it three forms later. *)
let no_container_defconst loc n (ty : Types.t) =
  if zero_only ty then
    fail loc
      "the global %s is %s, and a %s global is a defvar and not a defconst: \
       a constant is not an assignable place, so nothing could ever load \
       this one — it would stay the empty %s it was declared as. Write \
       (defvar %s %s) and fill it in a function"
      n (Types.to_string ty) (Types.to_string ty) (Types.to_string ty)
      n (Types.to_string ty)

(* A union member written into a *constant* would have to be encoded into the
   blob at link time, which is the byte-level encoder a data type case does not
   have either: a constant is what the linker writes, and a union value is a
   store. Refused here, where the message can name the way through, rather than
   at the emitter as "this one is computed", which is true and says nothing.

   A defvar is no longer any of this and no longer asks. Its computed
   initialiser is lifted into a function that runs at startup, so the member is
   written by exactly the store that writes one anywhere else — the encoder was
   only ever needed because there was nothing to run.

   A zeroed union needs none of this either and is the ordinary declaration. *)
let no_union_const env loc n (v : Tast.expr) =
  match v.Tast.ty, v.Tast.e with
  (* The all-bytes-zero value is a constant and needs none of this, so it is
     the one initialiser that goes through — which is what makes (U {}) and a
     declaration with no value the same thing here as everywhere else. *)
  | _, (Tast.Zero _ | Tast.Uninit _) -> ()
  | Types.Named un, _ when Hashtbl.mem env.unions un ->
    fail loc
      "the constant %s is the union %s, and a union member cannot be written \
       into a constant: a constant is what the linker writes into the image \
       and storing a member is a store. Leave it zeroed, or make it a defvar \
       and let its initialiser run at startup"
      n un
  | _ -> ()

(* A global's initialiser runs at startup: from [main], after the runtime is
   up, before a line of the program's own code. Nothing has established a
   handler or a restart by then, and nothing outside the initialiser can — the
   program has not started.

   That used to be the reason all four of the condition forms were refused
   inside one, and the refusal lived in [x86.ml] because that was the only
   backend with an init-at-startup path. Its argument was that a transfer out
   of an initialiser would return into the loader, which was true of a
   .init_array constructor and is not true of a call from [main]. So the rule
   is narrower now, and what is left of it is what is still true.

   A [handler-bind] or a [restart-case] *inside* an initialiser is ordinary
   code: it pushes its frames, runs, and pops them, all before the initialiser
   returns, and nothing it does is visible outside. Both backends run it
   exactly as they run it in any other function — which is what makes (defvar
   data (Vec u8) (slurp "level.edn")) an ordinary program, since [slurp] is a
   restart-case with its own signal inside it, and that is the shape the author
   kept reaching for.

   What is refused is a [signal] or an [invoke-restart] with no condition
   machinery around it at all. Everywhere else in the language those two are
   answered by a frame some *caller* established; in an initialiser there is no
   caller, so one with nothing around it is inert by construction — a signal
   nothing can hear, or an invoke-restart that can only fail at the invoke
   site. Either form counts as enclosure, including a restart-case around a
   signal: that pair is [slurp], and a restart-case says what the initialiser
   wants to happen when nobody answers, which is the thing an unenclosed one
   cannot say.

   A clause's body is not in this walk at all — a handler-bind clause is lifted
   into a function of its own — so the [invoke-restart] a handler writes is
   never the one refused here. *)
let no_transfer_in_init n (v : Tast.expr) =
  (* The nodes that are under a handler or a restart within this initialiser,
     by identity: [Tast.walk] visits nodes rather than paths, so the enclosure
     is recorded in one pass and asked in the next. *)
  let covered = ref [] in
  Tast.walk
    (fun (e : Tast.expr) ->
       let cover body = List.iter (Tast.walk (fun x -> covered := x :: !covered)) body in
       match e.Tast.e with
       | Tast.Handled (_, body) -> cover body
       | Tast.RestartCase (cs, body) ->
         cover [ body ];
         List.iter (fun (c : Tast.rclause) -> cover c.Tast.rbody) cs
       | _ -> ())
    v;
  Tast.walk
    (fun (e : Tast.expr) ->
       let bad what can =
         fail e.Tast.loc
           "%s in the initialiser of the global %s, with no handler-bind or \
            restart-case around it: an initialiser runs at startup, before the \
            program has a caller that could have established one, so this can \
            only %s. Write one inside the initialiser — they run there like \
            anywhere else — or move the whole thing into a function the \
            program calls"
           what n can
       in
       if List.memq e !covered then ()
       else
         match e.Tast.e with
         | Tast.Signal _ -> bad "signal" "go unheard"
         | Tast.InvokeRestart _ -> bad "invoke-restart" "fail at the invoke site"
         | _ -> ())
    v

(* A computed initialiser, lifted into a function of its own that returns the
   value. The global's initialiser becomes the call, which is the whole of what
   the backends had to learn: one of them already lowers an initialiser as
   ordinary code and now lowers a call, and the other emits the global zeroed
   and stores the call's result at startup.

   A function rather than the expression left in place, for a reason that is
   not tidiness: an initialiser can contain a [let], and a [let] needs a frame.
   The slots were allocated on a context this function discarded, so what the
   backend got was a slot index into a frame of size zero — [(defvar c i64 (let
   [x (i64 5)] (+ x 1)))] crashed the x86 backend with an out-of-bounds index,
   and there was no frame to give it without inventing one. This is that frame,
   and it is the one every other body already has.

   [fparent] is the global rather than a function, which is a small widening of
   what the field means: nobody wrote this name, so completing it or jumping to
   it is meaningless, and the one reader that asks — [Dev]'s [defs] — wants
   exactly that answer. The others are unaffected: a whole-program build emits
   a cell for every function it emits, and a redefinition module reaches this
   one through neither, because a reload does not run initialisers. *)
let lift_ginit ctx loc n ty (v : Tast.expr) =
  no_transfer_in_init n v;
  let fname = "global/" ^ n in
  ctx.env.lifted <-
    { Tast.name = fname; params = [];
      slots = Array.of_list (List.rev ctx.slot_tys);
      snames = Array.of_list (List.rev ctx.slot_names);
      ret = ty; body = [ v ]; fdefers = ctx.defers;
      fparent = Some n; floc = loc }
    :: ctx.env.lifted;
  { Tast.e = Tast.Call (fname, []); ty; loc }

let check_global env (d : Ast.decl) : Tast.global option =
  let ctx () = { env; ret = Types.Unit; slots = 0; slot_tys = []; slot_names = []; scope = []; defers = [];
      outer = []; outer_what = None; in_frames = None; loops = []; tail = false; in_defer = false; defer_ok = false; defer_block = "a nested form"; owner = "<none>" } in
  match d.Ast.d with
  | Ast.Defvar (n, _, init) ->
    let ty, _ = Hashtbl.find env.globals n in
    no_zeroed_fn d.Ast.dloc (Printf.sprintf "the global %s" n) ty;
    container_global_init d.Ast.dloc n ty init;
    let ginit =
      match init with
      | Ast.Zeroed -> { Tast.e = Tast.Zero ty; ty; loc = d.Ast.dloc }
      | Ast.Uninit ->
        (* Everywhere else [uninit] is an opt-out from ZII and the bytes are
           whatever they were: a garbage f64 is a garbage number. A data type is
           the one type where that is qualitatively worse — the tag steers
           control flow, a tag no case names falls past every comparison in a
           [match], and the block after them is [unreachable], which LLVM is
           entitled to assume cannot happen. So the one place where garbage
           becomes "the optimiser may do anything" is refused by name, and the
           zeroed form, which is the first declared case, is named beside it. *)
        (match ty with
         | Types.Named un when Hashtbl.mem env.datas un ->
           fail d.Ast.dloc
             "%s is a data type, and uninit on one is refused: its tag steers \
              every match, and a tag no case names has no arm to reach. Drop \
              the uninit — a zeroed %s is %s, which is a real case"
             (Types.to_string ty) un
             (match Hashtbl.find_opt env.datas un with
              | Some { Tast.cases = c :: _; _ } -> un ^ "." ^ c.Tast.vname
              | _ -> "its first case")
         | _ -> ());
        { Tast.e = Tast.Uninit ty; ty; loc = d.Ast.dloc }
      | Ast.Init v ->
        let c = ctx () in
        let v = check c ~want:ty v in
        if Tast.const_init v then v else lift_ginit c d.Ast.dloc n ty v
    in
    Some { Tast.gname = n; gty = ty; ginit; gconst = false; gfolded = false }
  | Ast.Defconst (n, _, v) ->
    let ty, _ = Hashtbl.find env.globals n in
    no_zeroed_fn d.Ast.dloc (Printf.sprintf "the global %s" n) ty;
    no_container_defconst d.Ast.dloc n ty;
    (* [collect] already folded the integer constants, because an array length
       has to be known before any type resolves. Use that value here rather
       than the expression it came from: a global's initialiser has to be a
       compile-time constant, and [(/ screen-height cell-size)] is one — the
       folding pass is the only thing that knows it. *)
    let ginit =
      match Hashtbl.find_opt env.consts n, ty with
      | Some k, Types.Int kind ->
        (* Still range-checked: this path skips [check], and [in_range] is the
           only thing that rejects 300 as a u8. *)
        { Tast.e = Tast.Int (in_range d.Ast.dloc kind k, kind); ty;
          loc = d.Ast.dloc }
      | _ -> check (ctx ()) ~want:ty v
    in
    no_union_const env d.Ast.dloc n ginit;
    (* [env.consts] holds exactly the constants the folding pass consumed, so
       membership is the question "is this value in the program's shape?" *)
    Some { Tast.gname = n; gty = ty; ginit; gconst = true;
           gfolded = Hashtbl.mem env.consts n }
  | _ -> None

(* The entry point, plan.org: (defn main [args [string]] i32), with both the
   parameter and the return type optional. *)
(* Where [main] was written. [env.locs] is the table of where each *type* was
   declared — [collect] fills it for structs, data types, unions and enums and
   for nothing else — so a function's own location is not in it and the
   [find_opt] idiom the rest of this file uses does not apply here. The
   declaration list does have it, and the caller is holding the list anyway.

   Without this both refusals below opened with <unknown>:0:0, which tells a
   reader that a rule exists and not where they broke it, and gives
   [next-error] nothing to jump to. A [main] that arrived some other way — a
   [declare], say — still has no [defn] to point at, so that case keeps the
   unknown span rather than inventing one. *)
let main_loc (decls : Ast.decl list) =
  let is_main (d : Ast.decl) =
    match d.Ast.d with Ast.Defn fn -> fn.Ast.name = "main" | _ -> false
  in
  match List.find_opt is_main decls with
  | Some { Ast.d = Ast.Defn fn; _ } -> fn.Ast.nloc
  | _ -> Loc.unknown

let check_main env decls =
  let at = main_loc decls in
  match Hashtbl.find_opt env.fns "main" with
  | None -> ()   (* a library, or a file being checked on its own *)
  | Some (params, ret) ->
    let ok_params =
      match params with
      | [] -> true
      | [ Types.Slice Types.String ] -> true
      | _ -> false
    in
    if not ok_params then
      fail at
        "main takes no parameters or one [string], not (%s)"
        (String.concat " " (List.map Types.to_string params));
    if not (Types.equal ret Types.Unit || Types.equal ret (Types.Int Types.I32))
    then
      fail at "main returns i32 or nothing, not %s"
        (Types.to_string ret)

(* The environment as well as the program. A session needs it to check an
   expression typed at a REPL against the program the process is running — and
   it has to be this one rather than anything rebuilt from declarations,
   because [program] prepends the prelude and no accumulated AST contains it. *)
(* Separate entry points below rather than a flag on the one the session calls,
   for the reason [Parse] gives at the same fork: [Loc.Errors] is a second
   exception that the session and the daemon do not catch, so the guarantee
   that they never see one should be structural and not a default argument. *)
(* ── The order the initialisers run in ─────────────────────────────── *)

(* Declaration order is the order a program's globals are started in, and it is
   the wrong one as soon as one of them is computed from another: [(defvar b
   i64 (+ a 10))] written above [(defvar a i64 (+ 1 2))] read a zero and
   answered 10 without saying anything. So the computed ones are sorted
   by what they need, which is what Odin does (src/checker.cpp,
   [calculate_global_init_order]) and for the same reason — the alternative is
   a rule about where in the file a global has to be written, which is a rule
   about text rather than about meaning.

   Only the computed globals are sorted, and only against each other. A
   constant initialiser cannot read a global at all — [Tast.const_init]'s
   accepted set has no [Global] in it — so a constant is already there before
   anything runs: it is in the object image on one backend and written from
   .init_array before main on the other. That makes the partition total and the
   sort small, and it is why a global initialised from a [defconst] needs no
   edge.

   The dependency is transitive through calls, not just through what the
   initialiser names: [(defvar a i64 (f))] where [f] reads [b] needs [b]
   started first, and an analysis that only looked at the initialiser's own
   text would order that pair by luck. Odin's graph is transitive for the same
   reason.

   A cycle is refused rather than broken. Some global in it would have to be
   started from another's zero, and which one that is cannot be read off the
   program — the two spellings of the same cycle would differ only in which
   line the compiler happened to reach first. *)
let init_order (globals : Tast.global list) (fns : Tast.fn list) =
  let computed =
    List.filter
      (fun (g : Tast.global) -> not (Tast.const_init g.Tast.ginit))
      globals
  in
  if computed = [] then globals
  else begin
    let is_computed = Hashtbl.create 8 in
    List.iter
      (fun (g : Tast.global) -> Hashtbl.replace is_computed g.Tast.gname ())
      computed;
    let ftbl = Hashtbl.create 64 in
    List.iter (fun (f : Tast.fn) -> Hashtbl.replace ftbl f.Tast.name f) fns;
    (* What each function reads, to a fixpoint over the call graph: its own
       references, plus everything its callees read. A round that changes
       nothing is the answer, which needs no special case for a recursive
       function and no visited set to get wrong. *)
    let reads = Hashtbl.create 64 in
    let calls = Hashtbl.create 64 in
    let add tbl k v =
      let cur = try Hashtbl.find tbl k with Not_found -> [] in
      if not (List.mem v cur) then Hashtbl.replace tbl k (v :: cur)
    in
    List.iter
      (fun (f : Tast.fn) ->
         let note n =
           if Hashtbl.mem is_computed n then add reads f.Tast.name n
           else if Hashtbl.mem ftbl n then add calls f.Tast.name n
         in
         List.iter (Reach.expr_refs note) f.Tast.body;
         List.iter (Reach.expr_refs note) f.Tast.fdefers)
      fns;
    let changed = ref true in
    while !changed do
      changed := false;
      Hashtbl.iter
        (fun caller callees ->
           List.iter
             (fun callee ->
                List.iter
                  (fun g ->
                     let cur = try Hashtbl.find reads caller with Not_found -> [] in
                     if not (List.mem g cur) then begin
                       Hashtbl.replace reads caller (g :: cur);
                       changed := true
                     end)
                  (try Hashtbl.find reads callee with Not_found -> []))
             callees)
        (Hashtbl.copy calls)
    done;
    (* And what each computed global needs, which is the same walk over its
       initialiser — whose one node is a call to the function the initialiser
       was lifted into, so the answer is that function's reads. *)
    let needs (g : Tast.global) =
      let acc = ref [] in
      let note n =
        let put r = if not (List.mem r !acc) then acc := r :: !acc in
        if Hashtbl.mem is_computed n then put n
        else List.iter put (try Hashtbl.find reads n with Not_found -> [])
      in
      Reach.expr_refs note g.Tast.ginit;
      if List.mem g.Tast.gname !acc then
        fail g.Tast.ginit.Tast.loc
          "the global %s is initialised from itself: its own value is what the \
           initialiser is producing, so there is nothing there to read but the \
           zero it starts as. Leave it zeroed and load it in a function"
          g.Tast.gname;
      !acc
    in
    let deps = List.map (fun (g : Tast.global) -> (g.Tast.gname, needs g)) computed in
    let deps_of n = try List.assoc n deps with Not_found -> [] in
    (* Kahn's, in declaration order: of the globals that are ready, the one
       written first goes first, so the emitted order is the source's wherever
       the source's order was possible at all. *)
    let done_ = Hashtbl.create 8 in
    let order = ref [] in
    let progress = ref true in
    while !progress do
      progress := false;
      List.iter
        (fun (g : Tast.global) ->
           if not (Hashtbl.mem done_ g.Tast.gname)
           && List.for_all (fun d -> Hashtbl.mem done_ d) (deps_of g.Tast.gname)
           then begin
             Hashtbl.replace done_ g.Tast.gname ();
             order := g :: !order;
             progress := true
           end)
        computed
    done;
    (match
       List.filter
         (fun (g : Tast.global) -> not (Hashtbl.mem done_ g.Tast.gname))
         computed
     with
     | [] -> ()
     | (g : Tast.global) :: _ ->
       (* The whole ring, not one name out of it. A cycle is a fact about a set
          of globals and a message naming one of them leaves the reader to find
          the rest; naming each edge says which read to break. *)
       let stuck n = not (Hashtbl.mem done_ n) && List.mem_assoc n deps in
       let rec ring path n =
         if List.mem n path then
           let rec cut = function
             | [] -> []
             | x :: r -> if String.equal x n then x :: r else cut r
           in
           cut path
         else
           match List.find_opt stuck (deps_of n) with
           | None -> path @ [ n ]
           | Some d -> ring (path @ [ n ]) d
       in
       let r = ring [] g.Tast.gname in
       let edges =
         List.mapi
           (fun i n ->
              Printf.sprintf "%s needs %s's value" n
                (List.nth r ((i + 1) mod List.length r)))
           r
       in
       fail g.Tast.ginit.Tast.loc
         "the globals %s initialise each other: %s. One of them has to start \
          without the other — leave it zeroed and load it in a function that \
          runs once, where the order is yours to write"
         (String.concat " and " r) (String.concat ", " edges));
    (* The sorted sequence, dropped back into the slots the computed globals
       already occupied. Everything else — a constant, a zeroed container —
       stays exactly where it was declared, so a diff of the emitted image
       shows the reordering and nothing else. *)
    let seq = ref (List.rev !order) in
    List.map
      (fun (g : Tast.global) ->
         if Hashtbl.mem is_computed g.Tast.gname then
           match !seq with
           | x :: rest -> seq := rest; x
           | [] -> g
         else g)
      globals
  end

let build_program ~keep_going (decls : Ast.decl list) : Tast.program * env =
  let env = new_env () in
  let decls = Parse.program (Prelude.forms ()) @ decls in
  (* Before anything is collected: every (declare-c ...) becomes an ordinary
     flattened [declare] with a Flan [defn] over it, and the C that does the
     flattening comes back to be compiled into the build. Nothing below this
     line knows the form exists. *)
  let decls, cshim = Shim.expand decls in
  (* Pass one, and it stops at the first thing it refuses. That is not
     laziness: every name, type and signature in the file comes from here, so a
     declaration this pass could not make sense of leaves a hole that pass two
     would report once per mention. A wrong signature is one error; the thirty
     "unknown name" lines under it are not errors, they are the same one.

     Pass two is where the volume is, and it is where collecting pays. By the
     time it runs every signature is sound, so a body that fails to check
     cannot make the next body fail — which is what makes a declaration a
     resync point that needs no resynchronising. *)
  let decls = collect env decls in
  check_finite env;
  check_union_members env;
  let s = Loc.sink ~on:keep_going in
  ignore (Loc.caught s (fun () -> check_main env decls));
  (* Every generic body, checked once with its variables left abstract, and
     the result thrown away. This is the pass plan.org's rule needs and Odin
     has no equivalent of: Odin checks a polymorphic body only per
     instantiation, so [a + b] over a [$T] compiles there and fails only if
     nobody ever calls it at a numeric type. plan.org says the opposite — an
     unconstrained variable supports only what every type supports, and [=],
     [<], [+] and [hash] over one are *rejected, not silently instantiated*.
     Rejecting them means type-checking the body with nothing substituted,
     which is this, and it is a second pass over the same source. *)
  List.iter
    (fun (d : Ast.decl) ->
       match d.Ast.d with
       | Ast.Defn fn when Hashtbl.mem env.gsigs fn.Ast.name ->
         ignore (Loc.caught s (fun () -> check_generic env fn))
       | _ -> ())
    decls;
  let globals =
    List.filter_map
      (fun d -> Option.join (Loc.caught s (fun () -> check_global env d)))
      decls
  in
  let fns =
    List.filter_map
      (fun (d : Ast.decl) ->
         match d.Ast.d with
         (* A generic [defn] does not reach the typed IR at all. Only its
            instantiations do, and they are collected below. *)
         | Ast.Defn fn when Hashtbl.mem env.gsigs fn.Ast.name -> None
         | Ast.Defn fn -> Loc.caught s (fun () -> check_fn env fn)
         | _ -> None)
      decls
  in
  Loc.finish s;
  (* The handler clauses lifted out along the way. They are ordinary functions
     from here down; nothing in the backend knows they were written inside
     something else. *)
  let fns = fns @ List.rev env.lifted in
  (* The copies generics turned into, in the order they were generated. Like a
     lifted clause they are ordinary functions from here down — but unlike one
     they are reached *by name* from arbitrary call sites, so they carry no
     [fparent] and a dev build gives each its own cell. *)
  let fns = fns @ List.rev env.instances in
  (* And the order the computed initialisers run in, which needs the whole
     function list: what a global reads is transitive through what it calls. *)
  let globals = init_order globals fns in
  (* Sorted, so the emitted IR is reproducible build to build: a Hashtbl's
     fold order is not. *)
  let values name tbl =
    Hashtbl.fold (fun _ v acc -> v :: acc) tbl []
    |> List.sort (fun a b -> String.compare (name a) (name b))
  in
  let externs =
    Hashtbl.fold
      (fun name esym acc ->
         let eparams, eret = Hashtbl.find env.fns name in
         { Tast.ename = name; esym; eparams; eret } :: acc)
      env.externs []
    |> List.sort (fun (a : Tast.extern) b -> String.compare a.Tast.esym b.Tast.esym)
  in
  ({ Tast.structs = values (fun (s : Tast.structure) -> s.Tast.sname) env.structs;
     datas = values (fun (u : Tast.data) -> u.Tast.dname) env.datas;
     unions = values (fun (u : Tast.structure) -> u.Tast.sname) env.unions;
     globals; externs; fns; cshim },
   env)

(** The program and the environment, stopping at the first refusal. What a
    session needs, and it raises [Loc.Error] and never [Loc.Errors]. *)
let program_with_env (decls : Ast.decl list) : Tast.program * env =
  build_program ~keep_going:false decls

let program (decls : Ast.decl list) : Tast.program =
  fst (build_program ~keep_going:false decls)

(** The same, reporting every declaration whose body it refuses rather than the
    first. Raises [Loc.Errors], so only a caller prepared for a list should be
    calling it. *)
let program_all (decls : Ast.decl list) : Tast.program =
  fst (build_program ~keep_going:true decls)

(* ── What a session needs to know about instantiations ──────────────────
   A generic [defn] never reaches [Tast.fns] — only its copies do — so the
   editor's [C-c C-c], which installs the bodies named by the form it was
   sent, would install nothing at all for a generic. These are what
   [Session.eval] expands the name with. They are here rather than there
   because [env]'s tables are the only record that a symbol was ever generic:
   past this module an instantiation is an ordinary function and nothing knows
   it was written once. *)

(* Is this name a generic definition rather than an ordinary one? *)
let is_generic env n = Hashtbl.mem env.gsigs n

(* Every copy of [gname] this check produced, by symbol. Transitivity needs no
   walk: a whole-program check has already generated every copy every call
   site asked for, including the ones a generic pulled in by calling another
   generic at its own variable. *)
let instantiations env gname =
  match Hashtbl.find_opt env.insts gname with
  | None -> []
  | Some l -> List.rev_map (fun (_, _, sym) -> sym) !l

(* The generic a symbol came from, and the types it was asked for — [None] for
   an ordinary function. What a refusal about [sort-i32] needs in order to
   say which line the programmer should look at, since [sort-i32] appears
   nowhere in the source. *)
let instantiation_origin env sym =
  Hashtbl.fold
    (fun gname l acc ->
       match acc with
       | Some _ -> acc
       | None ->
         (match List.find_opt (fun (_, _, s) -> String.equal s sym) !l with
          | Some (ps, _, _) -> Some (gname, ps)
          | None -> None))
    env.insts None

(* Checking one expression against a live session can *generate* a copy: the
   first [C-x C-e] of [(id 3)] instantiates [id] at [i32] and the copy is in
   [env.instances] and in no program anywhere. Without these two the module
   that gets built calls a symbol it never defined. A mark before and the
   difference after is the whole protocol. *)
let instance_mark env = List.length env.instances

let instances_since env mark =
  let fresh = List.length env.instances - mark in
  List.rev
    (List.filteri (fun i _ -> i < fresh) env.instances)

(* One expression, checked against a program that is already running. The
   frame is empty — a REPL expression has no parameters and no enclosing
   function — so the slots it needs are whatever its own [let]s allocate. *)
let expression env (e : Ast.expr) :
  Tast.expr * Types.t array * string option array =
  let ctx =
    { env; ret = Types.Unit; slots = 0; slot_tys = []; slot_names = []; scope = []; defers = [];
      outer = []; outer_what = None; in_frames = None; loops = []; tail = false; in_defer = false; defer_ok = false; defer_block = "a nested form"; owner = "<none>" }
  in
  let t = check ctx e in
  (t, Array.of_list (List.rev ctx.slot_tys),
   Array.of_list (List.rev ctx.slot_names))