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

(* A type in a message about the code at [loc], in that code's syntax. *)
let tyname (loc : Loc.t) t = Types.spell ~indented:(Source.indented_at loc) t

(* "A literal could not be built at the type this site asked for": 300 at a u8,
   1.5 at an i32, 3000000000 at the i32 an unconstrained integer defaults to.

   It is kinded rather than left generic because one caller has to tell this
   refusal apart from every other one. [binary] retries a refused operand
   against the other operand's type (TODO.org, "Implicit numeric widening is
   legal; narrowing stays a hard error"),
   and it must not retry *this* one: a literal takes its width from the other
   side and always could, so a literal that does not fit is the program's
   mistake and not a pair of types that failed to meet. Without the kind the
   retry turns (+ u8-thing 300) into i32 arithmetic, which is a different
   language from the one the author decided on. *)
let literal_at_want = "check/literal-at-want"

(* A refusal that is two types failing to meet, a literal's included: what
   an arm checked at another arm's type says when the two simply differ. *)
let is_mismatch (d : Loc.diag) =
  String.equal d.Loc.kind "check/type-mismatch"
  || String.equal d.Loc.kind literal_at_want

(* [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 *)
  (* Where the name came from, in words, when that is worth saying in a
     refusal about it. Set by the match-arm path and nowhere else: a case
     pattern binds the case's fields positionally, so [(Circle c)] over a
     one-field case binds [c] to an [f64] and the reach for [(.r c)] gets a
     type fact about [f64] instead of the one sentence that helps, which is
     that the field is already in hand. [None] everywhere else, and a refusal
     with [None] says exactly what it said before. *)
  bwhat : string option;
  (* The literal a [let] or [loop] bound this name to, when its type is read
     off the uses ([lit_session]). The initialiser's node, by identity, is the
     key: two expansions of one macro are two nodes. *)
  blit : Ast.expr option;
}

(* A class slot's type: what a value stored into it is checked against. A
   dyn value's tag is all a store can ask of it, so the scalar types a tag
   answers for, an instance of a class, and (Option T) of either, which
   admits nil as well. *)
type slot_ty =
  | Sany                     (* no type written: any dyn value *)
  | Sval of Types.t          (* bool, an integer type, f32, f64, string *)
  | Sclass of string         (* an instance of this class *)
  | Sopt of slot_ty          (* nil, or a value of the inner type *)

let rec slot_text = function
  | Sany -> "dyn"
  | Sval t -> Types.to_string t
  | Sclass c -> c
  | Sopt s -> "(Option " ^ slot_text s ^ ")"

(* Where [sep] first occurs in [m]. *)
let find_sub m sep =
  let n = String.length m and k = String.length sep in
  let rec go i =
    if i + k > n then None
    else if String.sub m i k = sep then Some i
    else go (i + 1)
  in
  go 0

(* ── Generic structs ─────────────────────────────────────────────────
   [(defstruct Small [items [$n $t] count i32])] is a template, not a type.
   Its parameters are the sigil names its fields introduce, in the order
   first written — [$n] then [$t] here, so the type is spelled
   [(Small 8 i32)] — and each is a length or a type by where it stands: in an
   array's length slot, or in a generic struct's length argument, it is a
   length; anywhere else a type.

   Each application at concrete arguments is a copy: an ordinary struct under
   a symbol-safe key, [Small-8-i32], so layout, both backends, the renderer
   and DWARF see a struct and nothing else — the same arrangement a generic
   function's copy has. [struct_apps] is how the checker still knows what a
   copy was applied to, which is what binding [(defn push [s (Ptr (Small $n
   $t))] ...)] against an argument needs. An application at variables is a
   copy too, under a key with the variables in it, whose array lengths are
   [abstract_len]; it exists for the abstract pass over a generic body and is
   left out of the program. *)
type gstruct = {
  gparams : (string * bool) list;   (* name, and whether it is a length *)
  gfields : Ast.field list;
  gloc    : Loc.t;
}

(* Key -> the generic struct and the arguments it was applied to; a length
   argument is [Types.Len], a variable one [Types.Var]. Global for the reason
   [Types.display] is: [bind_ty] and [subst_ty] are called from places with no
   env in hand. The key is made from exactly these, so an entry can only
   mislead where a later program in the same process declares a struct under
   a copy's key by hand, and [struct_copy] refuses that name the moment the
   program asks for the copy itself. *)
let struct_apps : (string, string * Types.t list) Hashtbl.t = Hashtbl.create 16

(* The undo journal a check that may be abandoned writes into: every table
   write a body's check makes goes through [jreplace]/[jremove]/[jset], which
   note how to take it back while a [snapshot_env] is open. So abandoning a
   check costs what it wrote, not the size of the tables it could have. *)
let journal : (unit -> unit) list ref = ref []
let journal_open = ref 0

let jot undo = if !journal_open > 0 then journal := undo :: !journal

let jreplace tbl k v =
  (if !journal_open > 0 then
     let old = Hashtbl.find_opt tbl k in
     jot (fun () ->
         match old with
         | Some o -> Hashtbl.replace tbl k o
         | None -> Hashtbl.remove tbl k));
  Hashtbl.replace tbl k v

let jremove tbl k =
  (if !journal_open > 0 then
     match Hashtbl.find_opt tbl k with
     | Some o -> jot (fun () -> Hashtbl.replace tbl k o)
     | None -> ());
  Hashtbl.remove tbl k

let jset r v =
  (if !journal_open > 0 then let old = !r in jot (fun () -> r := old));
  r := v

(* The length every length variable has inside a generic body's abstract
   pass. Large so that no constant index into such an array is refused as out
   of bounds there, and within i32 so that [(length a)] is an ordinary index.
   Every length is answered again, exactly, per copy. *)
let abstract_len = 2147483647L

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;
  (* A condition type -> the parent it names, [(defstruct T :parent P ...)].
     Handler matching walks this chain; see [condition_chain]. *)
  parents : (string, string) 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;
  (* Where each [declare] was written, by Flan name. A second table rather
     than a pair in [externs], because every other reader of that one wants
     the symbol and nothing else. *)
  extern_locs : (string, Loc.t) Hashtbl.t;
  fns     : (string, Types.t list * Types.t) Hashtbl.t;
  (* The parameter vector as it was *written*, by function name: the names and
     the locations [fns] threw away when it resolved the types. Nothing needs
     it to compile; it exists so that a refusal at a call argument can point
     at the parameter that wanted the other type, which is the second half of
     every message in Elm and was the one thing the reader could not see from
     the caret. Missing for a foreign [declare] and for a generic copy, and a
     missing entry degrades to the message alone rather than to a wrong
     pointer — [declared_note]'s rule. *)
  fparams : (string, Ast.field list) Hashtbl.t;
  (* And where the defn was written, for the same reason: a refusal about a
     function can show it. Kept apart from [fparams] because a foreign
     [declare] has a location and no parameter vector worth showing. *)
  fn_locs : (string, Loc.t) Hashtbl.t;
  (* A fn with several arities (decision 139): the name as written, to each
     arity and the name it was renamed to ([version_name]). A fn with one
     arity is not in here and keeps its own name, so its symbol does not
     change. *)
  versions : (string, (int * string) list) Hashtbl.t;
  (* Every [defn-], by name, with where it was written and how far it is
     visible. See [private_ref]. *)
  privates : (string, Loc.t * Ast.privacy) Hashtbl.t;
  globals : (string, Types.t * bool) Hashtbl.t;   (* type, is a constant *)
  (* Where each global was declared, so a refusal about one can show it. A
     second table rather than a third field, because every other reader of
     [globals] wants the type and the constness and nothing else. *)
  global_locs : (string, Loc.t) Hashtbl.t;
  (* 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;
  (* Generics whose abstract pass was refused and recorded, in a whole-file
     check that goes on after a refusal. A call site still gets a copy's
     signature, but its body is not checked again: every refusal the abstract
     pass made would come back from the copy, at the same line, once per type
     it was called at. *)
  refused_generics : (string, unit) Hashtbl.t;
  (* The generic structs, by name; see [gstruct]. *)
  gstructs : (string, gstruct) Hashtbl.t;
  (* The struct copies this env made, by key, and whether each is one at
     variables — those are left out of the program. *)
  copies : (string, bool) Hashtbl.t;
  (* Templates whose own check was refused while [deferred] was collecting:
     a use of one is a copy with no fields, so the refusal is said once, at
     the defstruct, and nothing downstream repeats it. *)
  broken : (string, unit) Hashtbl.t;
  (* While a whole-file check collects every error, the refusals [collect]
     can go on past — a generic struct's template, a where clause over a
     length — are kept here instead of ending the pass. [None] everywhere
     else, where they raise as before. *)
  mutable deferred : Loc.diag list option;
  (* A generic defn's length variables, by name: the ones of its [gsigs]
     variables that are lengths. *)
  glens : (string, string list) Hashtbl.t;
  (* Which of [tyvars] are lengths. A length variable is also a value inside
     the body — [n] reads as the integer it was bound to. *)
  mutable lenvars : string list;
  (* Set while a generic body is checked abstractly, and while a struct copy
     at variables is laid out: a length variable's array is then
     [abstract_len] long rather than the [Types.LArray] a signature pattern
     needs. *)
  mutable len_placeholder : bool;
  (* The struct copies being laid out, innermost last, so a template that
     asks for a copy of itself at a bigger type is refused rather than
     followed forever. *)
  mutable schain : (string * Types.t list) list;
  (* Set while a struct, data-case or union field's type is being resolved,
     and only then. It exists for one message: an unknown lowercase name in a
     type slot is told to introduce a type variable with [$name] in the
     parameter vector, and a field has no parameter vector — a defstruct's
     field introduces one where it stands. The flag is what lets
     [resolve_name] say the honest thing in each place. *)
  mutable in_field : bool;
  (* Every [defclass], by name: its slots in constructor order, each with the
     type a value stored in it must have — [Types.Dyn] for a slot written
     with no type. Filled by [pair_decls], which is where a slot vector is
     first readable. The type is a declaration about the values and not a
     layout: an instance is a dyn map whatever this says, and what reads it
     is [class_spec], which is what the runtime checks a store against. *)
  classes : (string, (string * slot_ty) list) Hashtbl.t;
  (* The bindings a dev build counts at every call: [Shim.resources], read off
     the declare-c forms before [Shim.expand] rewrites them. Keyed by the Flan
     name a program calls. *)
  tracks : (string, Shim.track) Hashtbl.t;
  (* Every [defn] whose return type was read off its body ([_]), with the
     form that decided it — what a stale-caller warning points at. *)
  inferred : (string, Loc.t) Hashtbl.t;
  (* The [_] bodies whose type could not be read because of an error of
     their own, while every error is being collected. Each stands in [fns]
     as Never, a call to one stands as a poison, and pass two reports the
     body's errors once. *)
  infer_failed : (string, Loc.diag option) Hashtbl.t;
  (* Recovery: checking goes on past a refused subexpression. See [check].
     [recovering] is on only while a whole-file or session check is collecting
     every error; [recovered] is what it found, newest first; [poison] counts
     failed subexpressions and reads of what they were bound to, which is how
     an error caused by an earlier one is told apart and left unsaid.
     [speculating] turns recovery off inside a trial, whose refusal is an
     answer the caller acts on; [guard_next] turns it off for the one next
     [check], whose own refusal a caller re-words. *)
  mutable recovering : bool;
  mutable recovered : Loc.diag list;
  mutable poison : int;
  mutable speculating : int;
  mutable guard_next : bool;
}

(* The struct table [box] describes a struct from when it was handed no
   [ctx]: the newest program's, set by [new_env]. Every caller that has a
   [ctx] passes it, so its own program's table is the one read. *)
let view_structs : (string, Tast.structure) Hashtbl.t ref = ref (Hashtbl.create 1)

(* The global whose initialiser is being checked, and its form. A view taken
   there of storage the initialiser itself built is gone the moment the
   initialiser returns, so it is refused rather than left to the dev check:
   nothing could ever read it. *)
let view_global_init : (string * Ast.reinit) option ref = ref None

let rec new_env () =
  let env = new_env_record () in
  view_structs := env.structs;
  env

and new_env_record () = {
  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;
  parents = Hashtbl.create 8;
  externs = Hashtbl.create 32;
  extern_locs = Hashtbl.create 32;
  fns     = Hashtbl.create 32;
  fparams = Hashtbl.create 32;
  fn_locs = Hashtbl.create 32;
  versions = Hashtbl.create 4;
  privates = Hashtbl.create 8;
  globals = Hashtbl.create 16;
  global_locs = Hashtbl.create 16;
  lifted = [];
  generics = Hashtbl.create 8;
  gsigs = Hashtbl.create 8;
  insts = Hashtbl.create 8;
  instances = [];
  tyvars = [];
  subst = [];
  tvpreds = [];
  chain = [];
  refused_generics = Hashtbl.create 4;
  gstructs = Hashtbl.create 4;
  copies = Hashtbl.create 8;
  broken = Hashtbl.create 2;
  deferred = None;
  glens = Hashtbl.create 8;
  lenvars = [];
  len_placeholder = false;
  schain = [];
  in_field = false;
  classes = Hashtbl.create 8;
  tracks = Hashtbl.create 16;
  inferred = Hashtbl.create 8;
  infer_failed = Hashtbl.create 4;
  recovering = false;
  recovered = [];
  poison = 0;
  speculating = 0;
  guard_next = false;
}

(* A check that may be abandoned — a trial, a probe, a return type read and
   thrown away, a tolerated body — opens one of these: [undo] puts back
   everything it wrote into [env], [keep] closes it and leaves the writes,
   which an enclosing one can still undo. Partial undo is the bug this
   exists for: rewinding [lifted] and not the generic cache left a copy made
   during a trial with the lambda it lifted gone, which is a link error. So
   the whole record is named, closed with warning 9: a new field stops this
   compiling until it is decided here.

   The tables a body's check writes go through the journal ([jreplace]);
   the lists and flags are held here, which costs nothing; the rest is
   written by the declaration passes alone, before any body is checked. *)
let snapshot_env env : (unit -> unit) * (unit -> unit) =
  let[@warning "+9"] { lifted; instances; tyvars; subst; tvpreds; chain;
                       deferred; lenvars; len_placeholder; schain; in_field;
                       recovering; recovered; poison; speculating;
                       guard_next;
                       (* Journaled at their writes. *)
                       structs = _; locs = _; copies = _; insts = _; fns = _;
                       (* Declaration passes only. *)
                       datas = _; unions = _; cases = _; aliases = _;
                       consts = _; enums = _; parents = _; externs = _;
                       extern_locs = _; fparams = _; fn_locs = _;
                       versions = _; privates = _; globals = _; global_locs = _;
                       generics = _; gsigs = _; refused_generics = _;
                       gstructs = _; broken = _; glens = _; classes = _;
                       tracks = _; inferred = _; infer_failed = _ } = env in
  incr journal_open;
  let mark = !journal in
  let close () =
    decr journal_open;
    if !journal_open = 0 then journal := []
  in
  let undo () =
    let rec back l =
      if l != mark then
        match l with
        | u :: rest -> u (); back rest
        | [] -> ()
    in
    back !journal;
    journal := mark;
    close ();
    env.lifted <- lifted; env.instances <- instances; env.tyvars <- tyvars;
    env.subst <- subst; env.tvpreds <- tvpreds; env.chain <- chain;
    env.deferred <- deferred; env.lenvars <- lenvars;
    env.len_placeholder <- len_placeholder; env.schain <- schain;
    env.in_field <- in_field; env.recovering <- recovering;
    env.recovered <- recovered; env.poison <- poison;
    env.speculating <- speculating; env.guard_next <- guard_next
  in
  (undo, close)

(* A refusal [collect] can go on past: kept while a whole-file check is
   collecting, in the order found, and raised otherwise. *)
let defer_or_raise env (d : Loc.diag) =
  match env.deferred with
  | Some l -> env.deferred <- Some (d :: l)
  | None -> Loc.raise_diag d

(* 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 =
  (* A generic struct's copy is declared where its template is, and is
     spoken of by the template's name there. *)
  let shown =
    match Hashtbl.find_opt struct_apps name with
    | Some (g, _) when Hashtbl.mem env.copies name -> g
    | _ -> name
  in
  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 shown ^ " is declared here"
      else shown ^ " is declared here, with " ^ String.concat ", " names
    in
    [ Loc.note at what ]

(* One edit apart: 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. Hoisted out of [near_miss] so that the did-you-mean over *values* —
   function names, globals, locals — matches on exactly the same rule the one
   over types has always matched on, rather than on a second one that would
   drift. *)
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

(* The same question asked of a candidate list the caller assembles, which for
   a value position is the function table, the globals and whatever is in
   scope — and nothing from the type tables, because a name written where a
   value goes was not a mistyped struct. *)
let nearest cands n = List.find_opt (fun c -> c <> n && one_edit n c) cands

(* What the last language called it. [long] is two edits from [i64] and so is
   outside [one_edit]'s net, which is right — two edits is a guess — but the
   name is not a guess at all: it is what C, Java, Go and Python spell an
   integer, and somebody writing it here has not mistyped anything, they have
   not yet learned that this language sizes its integers in the name. Without
   this list [long] falls through to the lowercase arm of [resolve_name] and
   is reported as generic code over a type variable, which is a sentence about
   a feature the reader was not reaching for.

   Two names that belong on this list by that reasoning are *not* on it:
   [int] and [float]. They are builtin aliases as of 2026-09-20 — [int] is
   [i32] and [float] is [f32], spelled in [Types.ikind_of_name] and
   [Types.fkind_of_name] — so they resolve rather than teach, and a row for
   either here would be dead code the next reader would trust. The exception
   stops at those two, on the author's decision: the default integer and the
   default float are the two spellings a program reaches for constantly, and
   [integer], [long], [double], [str] and the rest keep teaching. So [integer]
   still answers [i32] here even though [int] no longer does — the sibling
   spelling is still a name this language does not have.

   Short on purpose, and only names with one honest answer. [char] is not
   here: it is this language's own code point type. Nor [void]: it is a return type and the
   answer there is the shape [()], which is [parse]'s message to give and not
   this one's. Nor [usize] and [size_t]: the honest answer is "as wide as a
   pointer on this target", which is [u64] on x86-64 and [u32] on wasm32, and
   a message that named one of them would be wrong half the time on a tree
   that builds both. A name goes on this list when the answer does not depend
   on anything. *)
let foreign_spelling = function
  | "integer" -> Some "i32"
  | "uint" | "unsigned" -> Some "u32"
  | "long" -> Some "i64"
  | "ulong" -> Some "u64"
  | "short" -> Some "i16"
  | "ushort" -> Some "u16"
  | "byte" -> Some "u8"
  | "double" -> Some "f64"
  | "boolean" -> Some "bool"
  | "string" -> Some "str"
  | _ -> None

(* The builtin names, for the did-you-mean at a call — [prinltn] is a typo for
   [println], and [println] is not in any table the checker keeps, it is an arm
   of the call dispatch. The full [builtins] table is a long way below this
   point and carries a signature and a sentence per entry for eldoc; a forward
   reference to its names is cheaper than moving it or writing the list twice
   and letting the two drift. Filled once, immediately after that table. *)
let builtin_names : string list ref = ref []

(* The same names as a set, and the two are not one because they are asked
   two different questions. The list above is read once, at a refusal, and
   its order is the order the did-you-mean walks. This is asked at *every*
   named call — [shadows_builtin] is the first arm of the dispatch — and a
   linear walk of eighty-odd strings per call is a cost a whole-program check
   pays in full: measured at about a third of check time on a program of
   twenty thousand calls. Filled beside the list. *)
let builtin_set : (string, unit) Hashtbl.t = Hashtbl.create 128

(* Set while [bool_operands] asks an operand its type; see there. *)
let probing = ref false

(* ── builtin/, the reserved qualifier ──────────────────────────────────
   [builtin/length] is the builtin [length], whatever else the program has
   decided [length] means. It is the way out of the dead end shadowing used to leave: a
   [(defn length ...)] takes the bare name over for its whole file, and before
   this there was no remaining spelling for the thing it was wrapping, so the
   wrapper was unbounded recursion instead.

   The spelling is the package qualifier's, deliberately. A reader who knows
   that [rl/draw-fps] is [draw-fps] from the package imported as [rl] already
   knows what [builtin/length] is, and needs no second syntax to learn. What
   makes it work is that [builtin] is reserved rather than resolved: [Load]'s
   qualifier comes from the alias in an [import] form and from nowhere else,
   so refusing that one alias ([Load.reserved_alias]) is the whole of keeping
   this prefix unambiguous.

   It is legal when nothing is shadowed, too. A spelling that only compiles
   while some other declaration exists is a spelling nobody can write down in
   advance, and the point of an escape hatch is that it is always there. *)
let builtin_prefix = "builtin/"

let qualified_builtin n =
  let p = String.length builtin_prefix in
  if String.length n >= p && String.sub n 0 p = builtin_prefix then
    Some (String.sub n p (String.length n - p))
  else None

(* [builtin/] reached with something that is not a builtin's name. The
   did-you-mean is over the builtins alone and not over the program's own
   names: the reader wrote the qualifier, so they were reaching for a
   compiler name, and offering them a defn called [lem] would be answering a
   question they did not ask. Every other did-you-mean in this file keeps the
   candidates it already had. *)
let not_a_builtin loc bare =
  if bare = "" then
    Loc.failk "check/unknown-builtin" loc
      "%s needs a name after it — the qualifier reaches a builtin, as \
       (%slength v)" builtin_prefix builtin_prefix
  else
    match nearest !builtin_names bare with
    | Some m ->
      Loc.failk "check/unknown-builtin" loc
        "%s is not a builtin, so %s%s reaches nothing — did you mean %s%s?"
        bare builtin_prefix bare builtin_prefix m
    | None ->
      Loc.failk "check/unknown-builtin" loc
        "%s is not a builtin, so %s%s reaches nothing. The %s qualifier \
         reaches the compiler's own names and nothing else; an ordinary \
         function is called by the name it was defined under"
        bare builtin_prefix bare builtin_prefix

(* One argument of a call, written back out as source. A name is its name and
   an integer is its digits; anything with structure inside it — a call, a
   field, an index — becomes the stand-in the caller supplies, because a
   suggestion with a hole in it is worse than one that names its blank. Shared
   by the refusals that answer a name nothing defines by writing the call the
   reader should have written.

   This spells one argument and says nothing about how many there are. Whether
   the result compiles is the caller's to arrange: a call site that writes out
   every argument it was given is only honest where the name it is suggesting
   takes that many, so the caller either knows the arity matches or falls back
   to a shape of its own. *)
let spell_arg stand_for (a : Ast.expr) =
  match a.Ast.e with
  | Ast.Var v -> v
  | Ast.Int n -> Int64.to_string n
  | Ast.UInt (_, s) -> s
  | _ -> stand_for

(* Operators other languages spell differently, each mapped to the Flan
   builtin that computes the same thing. Only exact equivalents: [mod] is left
   out because Clojure's is floored and [%] is not. [&&] and [||] are not
   here: they are the bit operators, and a bool reaching one is told which
   logical operator it wanted there. *)
let operator_aliases =
  [ ("not=", ("!=", "Not-equal")); ("=/=", ("!=", "Not-equal"));
    ("/=", ("!=", "Not-equal")); ("<>", ("!=", "Not-equal"));
    ("==", ("=", "Equality")); ("===", ("=", "Equality"));
    ("!", ("not", "Logical not")) ]

(* The fix, as the sentence that ends the refusal. The reader's call is
   written back out under the Flan name only when every argument can be
   spelled and the count is one the builtin takes, so a suggestion printed as
   code compiles once pasted. An argument that cannot be spelled leaves the
   call as it was, with only the name to change; a count the builtin does not
   take gets the builtin's shape. *)
let alias_fix flan (args : Ast.expr list) =
  let spelled = List.map (spell_arg "") args in
  let n = List.length args in
  let arity_ok =
    match flan with
    | "not" -> n = 1
    | "and" | "or" -> true
    | _ -> n >= 2
  in
  if not arity_ok then
    Printf.sprintf "It is called as %s"
      (if flan = "not" then "(not x)" else "(" ^ flan ^ " x y)")
  else if List.mem "" spelled then Printf.sprintf "Write %s in its place" flan
  else Printf.sprintf "Write (%s)" (String.concat " " (flan :: spelled))

(* 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

(* Local inference for a number or character literal bound by a [let] or a
   [loop]: [(let [t 0.0] ... (set t (+ t x)))] makes [t] x's type. The form
   is checked with every literal local at its current guess while each use
   records what it says about the local. When the uses agree with the
   guesses that check is the answer; otherwise it is undone, the guesses are
   solved and it is checked again. Locals that feed one another are merged
   into one group (union-find), so a chain of any length settles in one more
   round. One session per function context, opened by its outermost such
   [let], so a lambda or a generic's copy is inferred on its own and a
   literal's type never depends on another function.

   What a use says about the local:
   - [Up t]: the local flows into a [t] — a parameter, a return, a field, an
     index. The local has to widen into [t].
   - [Down t]: a [t] is [set] into it, or passed to [recur] for it. [t] has to
     widen into the local.
   - [Hint t]: an operator's other operand, which meets it at either; or a
     dyn it meets, as the dyn width ([Types.Dyn] here, i64 or f64 in [solve]).
   A [set] of arithmetic over such locals and literals into another merges
   them, as does an operator between two of them. *)
type lit_con = Up | Down | Hint

(* Initialiser nodes by identity: two expansions of one macro are two nodes
   and may print alike. *)
module Phys = Hashtbl.Make (struct
  type t = Ast.expr
  let equal = ( == )
  let hash = Hashtbl.hash
end)

type lit_session = {
  (* The type each literal local is checked at. Kept across rounds. *)
  decided : Types.t Phys.t;
  (* On while a round checks; off for a final check after one that failed. *)
  mutable recording : bool;
  (* This round's locals, numbered as they are bound, and their names. *)
  ids : int Phys.t;
  mutable keys : (Ast.expr * string) list;
  mutable count : int;
  (* Union-find over the numbers, and each one's uses. *)
  parent : (int, int) Hashtbl.t;
  cons : (int, lit_con * Types.t * Loc.t) Hashtbl.t;
  (* A use its guess could not serve was read at the type it asked for, so
     this round's check is not a program and is thrown away. *)
  mutable dirty : bool;
}

(* Nonzero while any recording check runs: the refusal memos ([arm_failed],
   [if_failed], [truthy_failed]) are not written then, since a refusal made
   at a guessed type must not be replayed at the decided one. *)
let lit_recording = ref 0

(* The operands of the operators being checked that are literal locals, by
   location: a want reaching one is the other operand's type, a [Hint] and not
   an [Up], and a refusal there is the operator's to handle. *)
let lit_operand_locs : Loc.t list ref = ref []

(* Set while arithmetic over literal locals is checked at the type of the
   local it is stored into ([lit_down]): the locals in it are merged with that
   one, so the guess it is checked at says nothing about them. *)
let lit_quiet = ref false

(* Text and bracket literals keep their typed reading while this is set (the
   [dyn] switch only): a [defconst]'s value, and a let-bound one some typed
   use wants. *)
let typed_literals = ref false
let with_typed_literals f =
  let was = !typed_literals in
  typed_literals := true;
  Fun.protect ~finally:(fun () -> typed_literals := was) f

(* 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;
  (* The literal-inference session of this function, while one is open. *)
  mutable lits  : lit_session option;
  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;
  (* The slots an [as] bound in this function: [Tast.fn.as_slots]. *)
  mutable as_slots : int 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;
  (* The slot that counts how many of them have registered, minted on the
     first [defer] this function writes and [None] until then.

     The normal exit paths need no such thing: falling off the end is below
     every defer in the text, and a [return] splices the ones registered
     above it, both of which are decided while checking. The *transfer* exit
     is the one path that is not, because a transfer can start anywhere,
     including in the initialiser of the very [let] whose body the defer is
     written in — and that defer has not registered yet. Running it there is
     not a leak the other way round; it is cleanup over a binding nothing has
     written, which is [(free v)] on whatever the stack held.

     So the count is kept at run time and the transfer path's copy of each
     defer is guarded on it. The cost is not all on the unwinding path, and
     the half that is not is the half worth naming: every function with a
     defer pays one i64 of frame, one store of zero at entry, and one store
     of an ordinal where each defer is written — on the ordinary path,
     whether anything ever transfers or not. What the unwind adds on top is
     one compare per defer. A store of a constant into a frame slot nothing
     else reads is about as little as a fact can cost, but it is not nothing
     and it is not only on the cold path. *)
  mutable defer_slot : int option;
  (* 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;
  (* What this body has captured out of [outer], in the order it first named
     each one: the source name, the *outer* binding the copy is taken from,
     and the slot in this body's own frame the copy is read into. Empty
     everywhere [outer] is, which is everywhere but a lifted body.

     The order is the environment's field order, so it is the order the copy
     is made in and the order the body reads it back in. First-reference order
     rather than declaration order because it is the only one this pass has:
     the outer scope is a list and the names on it were not all written for
     this body's sake. *)
  mutable caught : (string * (binding * int)) list;
  (* Whether the form being checked is the target of a place — indexed,
     sliced, a field read, its address taken — rather than a value. Granted by
     [check_target] to the one form it checks and withdrawn at the top of
     [check]. See [refuse_owned_copy]. *)
  mutable place_ok : bool;
  (* The context this body was lifted out of, so that capture can be
     transitive: an [fn] inside an [fn] naming a local of the function both
     were written in is captured by the middle one and then by the inner one
     out of the middle one's copy. Without it the inner body would see only
     what the middle body happened to have named already, which is a rule
     about the text and not about the scope.

     It is safe to reach into while it is on the stack, and only then: a
     lifted body is checked at the point it is written, so the parent is
     paused exactly there and its scope is the snapshot [outer] holds. *)
  parent : ctx option;
  (* The slot the environment pointer arrives in, minted the first time
     something is captured and [None] until then. Nameless, so the break loop
     hides it the way it hides every other slot the compiler made: what a
     reader wants to see is the copies, and those are under the names the
     source gave them. *)
  mutable envslot : int 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 where this form's value is kept: a [let] binding's value, and what
     a block's last form, an [if]'s arms and a [match]'s arms inherit from
     the form they stand in. Read and withdrawn at the top of [check] as
     [tail] is. Only a one-armed [if] ([when]) asks: used, it answers an
     Option; not, it is a statement. [want] alone cannot say, since a
     statement and an unannotated [let] value both arrive with none. *)
  mutable used : bool;
  (* The arguments of the call being checked: each is kept, whatever the
     callee wants of it, so a [when] written as an operand answers its Option
     there rather than a Unit the other operands are then blamed against. *)
  mutable kept : Ast.expr list;
  (* 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

(* The structural printer's context over this checker's tables, with the
   pieces aimed wherever [emit] sends them. [print] and [watch] differ in the
   emitter and in nothing else, and a second copy of this would be a second
   answer to which types the walk knows. *)
let render_ctx ctx (emit : Render.emitter) : Render.ctx =
  { 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;
    (* Neither [println] nor [watch] 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) }

(* 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 ?what ?lit 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; bwhat = what; blit = lit }) :: ctx.scope;
  slot

(* The last answer for each name, with the scope it was read from. A body is
   checked under one scope for long stretches and names the same local
   several times per form, so compared by identity this answers most
   lookups without walking a scope that, in a long [let], holds thousands of
   names. *)
let lookup_cache : (string, (string * binding) list * binding option) Hashtbl.t =
  Hashtbl.create 64

let lookup ctx name =
  match Hashtbl.find_opt lookup_cache name with
  | Some (sc, r) when sc == ctx.scope -> r
  | _ ->
    let r = List.assoc_opt name ctx.scope in
    Hashtbl.replace lookup_cache name (ctx.scope, r);
    r

(* Capture, spec-memory.md's case 2: a body lifted into a function of its own —
   an [fn] literal or a handler clause — naming a local of the function it was
   written in.

   The copy is taken where the value is made and not where it is read, so the
   name in the body means what the local held at that instant and nothing
   later can change it. What makes that safe is the extent: the copies live in
   a slot of the *enclosing* frame, and a value holding their address may not
   outlive it. [escapes] is the whole of what enforces that, and it is where
   the escaping half — an environment the collector allocates — is named.

   Answers the binding the body should use, minting one on first reference:
   a named slot of this body's own frame, which the prologue fills from the
   environment. Not assignable, and that is not an omission — see [captured_set].

   A dyn is refused, and for the reason a struct field of dyn already is (see
   the [defstruct] arm): the collector's roots are frames, a captured copy
   lives inside a struct the checker synthesised, and nothing pushes the
   fields of one. A dyn in there would be a live value reachable only through
   memory the marker never walks. Milestone 2's per-type descriptors lift it,
   alongside the condition payload's and the struct field's. *)
let rec capture ctx loc name =
  match List.assoc_opt name ctx.caught with
  (* Already captured, and named again from a scope that no longer lists it —
     a [let] inside the body restores what it displaced, and the copy's
     binding goes with it. One field, not two: the environment is keyed by the
     source name. *)
  | Some (outer, slot) -> Some { slot; bty = outer.bty; assignable = false; bwhat = None; blit = None }
  | None ->
    let from_parent () =
      (* Not a local of the body directly around this one, so ask whether that
         body can capture it in turn. The middle one takes a copy and this one
         takes a copy of that — which is the same value, because every copy on
         the way was taken at the moment its own value was made, and those
         moments are nested. *)
      match ctx.parent with
      | Some p -> capture p loc name
      | None -> None
    in
    let outer =
      match List.assoc_opt name ctx.outer with
      | Some b -> Some b
      | None -> if ctx.outer_what = None then None else from_parent ()
    in
    match ctx.outer_what, outer with
    | Some _, Some (outer : binding) ->
      let slot = bind ctx name outer.bty ~assignable:false in
      ctx.caught <- ctx.caught @ [ (name, (outer, slot)) ];
      Some { slot; bty = outer.bty; assignable = false; bwhat = None; blit = None }
    | _ -> None

(* The one thing [capture] does not answer for. A captured name is a copy, so
   a store into it would change this body's copy and leave the local it came
   from as it was — which is a silent disagreement and not a feature. The
   ordinary "not assignable" message would name the wrong reason, so this one
   names the right one.

   [and] rather than a second [let] only so the two read together; neither
   calls the other. *)
(* What [capture] would find, without capturing it. A guard that has to know
   the *type* of an enclosing local before deciding what a form means — a
   name in head position is a call through a value only if the value is a
   function — must not take a copy on the way to answering. The binding it
   answers with is only good for its type unless it came out of [caught]. *)
and peek_outer ctx name =
  if ctx.outer_what = None then None
  else
    match List.assoc_opt name ctx.caught with
    | Some ((b : binding), slot) -> Some { slot; bty = b.bty; assignable = false; bwhat = None; blit = None }
    | None ->
      match List.assoc_opt name ctx.outer with
      | Some b -> Some b
      | None ->
        match ctx.parent with Some p -> peek_outer p name | None -> None

and outer_local ctx name =
  ctx.outer_what <> None
  && (List.mem_assoc name ctx.caught
      || List.mem_assoc name ctx.outer
      || (match ctx.parent with
          | Some p -> outer_local p name
          | None -> false))

and captured_set ctx loc name =
  if outer_local ctx name then
    match ctx.outer_what with
    | Some what ->
      Loc.failk "check/capture-set" loc
        "%s cannot assign to %s: it is a copy of the enclosing function's \
         local, taken where the value was made, so a store here would change \
         the copy and leave %s as it was. %s"
        what name name
        (if String.equal what "a handler" then
           "Accumulate into a global, or put the value on the condition — \
            capture is by value, which is what lets the copy be read at all"
         else
           "Return the new value, or keep it in a local of this fn")
    | None -> ()

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 =
  (* No repo filename in a message, and no milestone number either: neither
     means anything to somebody who has this compiler and nothing else. What
     they need is that the thing is not there yet. *)
  ignore milestone;
  fail loc "%s is not implemented yet" what

(* Four names the randomness functions do not have, each with the name that
   does and a call that compiles. A reader who has never seen this language
   arrives at one of these by copying a line from somewhere, and what they need
   is the spelling that works — so these say what the surface *is*, not what it
   once was. The suggestions are checked by the suite, which compiles each one.

   [rand-int] answers a u64 whose every bit is a fresh draw, so a narrower
   draw is that value narrowed — which is why the [rand-u32] line suggests a
   cast rather than another function, and takes the high half, the half a
   reader should be taught to take. *)
let no_such_rand name =
  match name with
  | "rand-u32" ->
    Some "there is no rand-u32 — a random integer is (rand-int), which answers \
          a u64 with every bit drawn. For 32 bits of one, write \
          (u32 (>> (rand-int) 32))"
  | "rand-f32" ->
    Some "there is no rand-f32 — a random float in [0, 1) is (rand), which \
          answers an f64. For an f32, write (f32 (rand))"
  | "rand-i32-range" ->
    Some "there is no rand-i32-range — a random integer in [lo, hi) is \
          (rand-int-range lo hi), which answers an i64: (rand-int-range 0 10) \
          is one of 0 to 9, and (i32 (rand-int-range 0 10)) is that as an i32"
  | "rand-f32-range" ->
    Some "there is no rand-f32-range — a random float in [lo, hi) is \
          (rand-float-range lo hi), which answers an f64, as in \
          (rand-float-range 0.0 1.0)"
  | _ -> None

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

   [is-integer] is the narrowest numeric bound and exists because [is-numeric] was
   one type too wide for a family of bodies: an integer body under [is-numeric]
   is instantiated at f32 and f64 too, and (if (< x 0) (- 0 x) x) at -0.0 is
   the wrong abs while %, the bitwise operators and the shifts have no float
   meaning at all. A function that can be generalized should not need a
   variant per numeric type, and [is-integer] is what lets the integer-only
   ones say exactly what they need.

   [is-enum] admits exactly the enums. It entails [is-ordered] and [is-equal] and
   not [is-numeric]: an enum compares, and it converts to a number, but it is
   not one — no arithmetic, no literal. It is what licenses the generic
   enum-to-number conversion, beside [is-numeric]. *)
let predicate_names =
  [ "is-ordered"; "is-equal"; "is-hashable"; "is-numeric"; "is-integer"; "is-enum" ]

(* ── 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. *)
(* One edit apart — 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. Shared by the unknown-type near miss and the enum
   member one. *)
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

(* Whether [got] could be [want] once [want]'s type variables are bound:
   the same shape, a variable matching anything. Binding them consistently is
   the generic call's business; this only says a literal may take the shape. *)
let rec fits_shape (want : Types.t) (got : Types.t) =
  match want, got with
  | Types.Var _, _ -> true
  | Types.Fn (ps, r), Types.Fn (qs, s) | Types.CFn (ps, r), Types.CFn (qs, s) ->
    List.length ps = List.length qs && List.for_all2 fits_shape ps qs && fits_shape r s
  | Types.Slice (a, x), Types.Slice (b, y) | Types.Ptr (a, x), Types.Ptr (b, y) ->
    a = b && fits_shape x y
  | Types.Vec x, Types.Vec y | Types.Option x, Types.Option y -> fits_shape x y
  | Types.Array (n, x), Types.Array (m, y) -> n = m && fits_shape x y
  | Types.Map (k, v), Types.Map (k', v') -> fits_shape k k' && fits_shape v v'
  | _ -> Types.equal want got

(* [Dir.north] as the enum and the member's value, when [Dir] is an enum
   with a member [north]. *)
let enum_member env name =
  match String.rindex_opt name '.' with
  | Some i when i > 0 && i < String.length name - 1 ->
    let e = String.sub name 0 i and m = String.sub name (i + 1) (String.length name - i - 1) in
    (match Hashtbl.find_opt env.enums e with
     | Some members -> Option.map (fun v -> (e, v)) (List.assoc_opt m members)
     | None -> None)
  | _ -> None

(* The enum members' own near miss. One edit away is the usual typo; the
   second rule is for a package whose members carry a disambiguating prefix —
   raylib's Key spells them [key-r], [key-space] — where the natural mistake
   is writing the bare name. [:r] against [key-r] is four edits and one
   thought, so the rule is the thought: a member whose last segment is exactly
   the name written. *)
let member_near_miss members k =
  List.find_opt
    (fun (m, _) ->
       one_edit k m
       || (let lm = String.length m and lk = String.length k in
           lm > lk + 1
           && m.[lm - lk - 1] = '-'
           && String.sub m (lm - lk) lk = k))
    members

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 value of this type hold a dyn anywhere — through a field, a case, an
   element or a view? Asked where the program is still being checked, so it
   reads the environment's tables rather than a finished program. *)
let rec holds_dyn env ?(seen = []) (t : Types.t) =
  match t with
  | Types.Dyn -> true
  | Types.Array (_, e) | Types.Vec e | Types.Option e | Types.Slice (_, e)
  | Types.Ptr (_, e) -> holds_dyn env ~seen e
  | Types.Map (k, v) -> holds_dyn env ~seen k || holds_dyn env ~seen v
  | Types.Named n when not (List.mem n seen) ->
    let seen = n :: seen in
    let fields (fs : Tast.field list) =
      List.exists (fun (f : Tast.field) -> holds_dyn env ~seen f.Tast.fty) fs
    in
    (match Hashtbl.find_opt env.structs n with
     | Some s -> fields s.Tast.fields
     | None ->
       match Hashtbl.find_opt env.unions n with
       | Some u -> fields u.Tast.fields
       | None ->
         match Hashtbl.find_opt env.datas n with
         | Some d ->
           List.exists (fun (c : Tast.variant) -> fields c.Tast.vfields)
             d.Tast.cases
         | None -> false)
  | _ -> 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
  | "is-ordered"  -> Types.is_comparable t
  | "is-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 [is-hashable] and instantiated at a struct whose
     fields are not keyable is refused where every other program is, by
     [key_pair]. *)
  | "is-hashable" -> Types.keyable t
  | "is-numeric"  -> Types.is_numeric t
  | "is-integer"  -> Types.is_integer t
  | "is-enum"     -> (match t with Types.Enum _ -> true | _ -> false)
  | _           -> 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 (is-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
     | "is-ordered",  ("is-numeric" | "is-integer" | "is-enum") -> true
     | "is-equal",    ("is-numeric" | "is-ordered" | "is-integer" | "is-enum") -> true
     (* Every integer type is a number, so [is-integer] gives a body everything
        [is-numeric] does — the arithmetic, the written 0, the untyped integer
        literal — on top of the operations only it admits. The reverse is
        never true: [is-numeric] admits floats, which is exactly what a body
        under [is-integer] is promising it never meets. *)
     | "is-numeric",  "is-integer" -> 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 () — write (Map %s bool) and ignore the value"
      (tyname loc 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 "is-hashable"
          | k -> Types.keyable k) then
    fail loc
      "%s is not a map key. A key is an integer, an enum, a bool, a string, a \
       fixed array of those, or a struct of those"
      (tyname loc 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.

   The zero is the whole reason: a capturing value's environment belongs to
   the collector and may be kept anywhere, and [(Option (Fn ...))] is how a
   field or a global holds one.

   ZII is the language's rule — an omitted struct field, a fixed array's
   elements, a [defonce] 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. *)
(* The two function types as one question, for every place that wants the
   signature and does not care which of them carries an environment: a call
   site, a shadowing guard, a walk over the parameters. Where the difference
   matters it is matched on directly, and there are few such places — the
   representation is [Emit]'s business and the coercion is [expect]'s. *)
let fn_sig (t : Types.t) =
  match t with
  | Types.Fn (ps, r) | Types.CFn (ps, r) -> Some (ps, r)
  | _ -> None

let callable_ty t = fn_sig t <> None

(* A (CFn ...) is not on the list: it is one code address, and every call
   through one tests for null and signals NullCall (see [Emit.null_check]), so
   a zeroed one is an empty slot rather than a crash. That is what lets a table
   of function pointers be a struct or a fixed array. An (Fn ...) stays
   refused: a call through one is not tested, and (Option (Fn ...)) is the
   field that holds one. *)
let rec no_zeroed_fn loc what (t : Types.t) =
  match t with
  | Types.Fn (ps, r) ->
    fail loc
      "%s cannot be %s — it would be zeroed, and a zeroed function value is a \
       null pointer. Pass it as a parameter, hold it in a let, or store a \
       %s if it captures nothing"
      what (tyname loc t) (tyname loc (Types.CFn (ps, r)))
  | Types.Array (_, e) -> no_zeroed_fn loc what e
  | _ -> ()

(* ── What may be overwritten with raw bytes ────────────────────────────

   [(filled b)] and [(sentinel-filled)] are the only two things in the
   language that write a byte pattern over storage the type system has an
   opinion about, so the question they raise is which types survive having
   arbitrary bytes put in them. The answer here is the narrow one: numbers,
   and aggregates built out of numbers. Everything else is refused by name.

   What is being kept out, and why each one is not a matter of taste:

   - [dyn]. A struct that holds a dyn is rooted on the collector's root stack
     with a descriptor naming the byte offsets of its dyn words (see the
     per-type descriptor note at the bottom of this file). Filling one leaves
     a word that is not a dyn at an offset the collector is told to walk, and
     the next collection follows it. The refusal is what keeps that from
     being reachable at all.
   - [Vec], [(Map K V)], [Allocator]. An owning header: a pointer, a length, a
     capacity and an allocator the runtime frees through. A filled one is a
     free of a wild pointer the first time it is touched.
   - [string] and a slice. Two words, the second of which is a length every
     bounds check believes. A filled length is a bounds check that passes and
     an access that does not.
   - [bool]. The one refusal that is about the backends rather than the
     runtime: a bool is a byte here and an [i1] to LLVM, which reads the low
     bit, where x86 compares the whole byte against zero. 0xDE is false on
     one and true on the other, and byte-identical behaviour across the two
     backends is the property this feature is pinned on.
   - an enum, a data type, an [(Option T)], a function value. Each
     carries a tag or a case index that something later reads as a small
     number with a meaning, and a filled one names a case that does not
     exist.

   Floats are in: every bit pattern is a float, NaNs included, and both
   backends move one as bytes. So is a [Ptr], which the collector does not
   walk and whose poisoned value is the useful case, and an untagged union
   whose members are all admitted, filled over its whole size. *)
let rec unfillable env seen (t : Types.t) : Types.t option =
  match t with
  | Types.Int _ | Types.Float _ | Types.Ptr _ -> None
  | Types.Array (_, e) -> unfillable env seen e
  | Types.Named n when not (List.mem n seen) ->
    (match
       match Hashtbl.find_opt env.structs n with
       | Some s -> Some s
       | None -> Hashtbl.find_opt env.unions n
     with
     | Some s ->
       List.fold_left
         (fun acc (fl : Tast.field) ->
            match acc with
            | Some _ -> acc
            | None -> unfillable env (n :: seen) fl.Tast.fty)
         None s.Tast.fields
     (* A data type, the one [Named] thing in neither table: its tag names a
        case, so the type itself is what the refusal names. *)
     | None -> Some t)
  | _ -> Some 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 (Types.Mut, e) -> "slice-" ^ mangle_ty e
  | Types.Slice (Types.Const, e) -> "cslice-" ^ 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 (Types.Mut, e) -> "ptr-" ^ mangle_ty e
  | Types.Ptr (Types.Const, e) -> "cptr-" ^ 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)
  | Types.CFn (ps, r) ->
    Printf.sprintf "cfn-%s-to-%s"
      (String.concat "-" (List.map mangle_ty ps)) (mangle_ty r)
  (* Bare, because [Types.to_string] spells a variable with its [$] for the
     reader and a symbol has no room for one. *)
  | Types.Var n -> n
  (* The key, not [Types.to_string]'s [(Small 8 i32)], which is a reader's
     spelling and not a symbol. *)
  | Types.Named n -> n
  | t -> Types.to_string t

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) | Types.CFn (ps, r) ->
    List.exists (occurs_in ~needle) ps || occurs_in ~needle r
  | Types.LArray (_, e) -> occurs_in ~needle e
  (* Through a struct copy's arguments, or [(Node (Node $t))] would not be
     seen to contain [(Node $t)]. *)
  | Types.Named k ->
    (match Hashtbl.find_opt struct_apps k with
     | Some (_, args) -> List.exists (occurs_in ~needle) args
     | None -> false)
  | _ -> 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)

(* A generic struct's copy at [args], by key: [Small-8-i32], or
   [Small-$n-$t] at variables. Recorded in [struct_apps] and [Types.display]
   as the key is made; the copy's fields are [struct_copy]'s business. *)
let struct_app g args =
  let key =
    g ^ "-"
    ^ String.concat "-"
        (List.map
           (function
             | Types.Var v -> "$" ^ v
             | Types.Len n -> Int64.to_string n
             | t -> mangle_ty t)
           args)
  in
  if not (Hashtbl.mem struct_apps key) then begin
    jreplace struct_apps key (g, args);
    Hashtbl.replace Types.display key
      (Printf.sprintf "(%s %s)" g
         (String.concat " " (List.map Types.to_string args)));
    Hashtbl.replace Types.display_app key (g, args)
  end;
  key

(* Does [name] contain itself by value? [check_finite] asks it of every
   declared type once they are all collected, and a generic struct's copy asks
   it of itself when it is made, which is after that. *)
let finite_from env name0 =
  let rec walk seen name =
    if List.mem name seen then
      (let l = Option.value (Hashtbl.find_opt env.locs name) ~default:Loc.unknown in
       fail l "%s contains itself by value, so it has no size — go through %s"
         (tyname l (Types.Named name))
         (tyname l (Types.Ptr (Types.Mut, Types.Named 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
  walk [] name0

(* The name under the sigil. [$t] is how a defn signature introduces a type
   variable and [t] is how the body spells the same one, so the tables that
   record which variables are in scope — [env.tyvars] and [env.subst] — are
   keyed on the bare name and every membership test has to strip first. A name
   with no sigil is its own bare name. *)
let tyvar_bare n =
  if n <> "" && n.[0] = '$' then String.sub n 1 (String.length n - 1) else n

(* Is this name, as written, a type variable that is in scope here? Both
   spellings answer yes, because both denote the same variable: the sigil is
   the binding site's and is redundant rather than wrong in the body. Every
   test against [tyvars] or [subst] goes through this, so a caller cannot ask
   the question of the raw name and miss the spelling with the sigil — which is
   what made [(vec-new $t)] report a missing element type for a body that had
   written one. *)
let tyvar_in_scope env n =
  let bare = tyvar_bare n in
  List.mem bare env.tyvars || List.mem_assoc bare env.subst

let rec resolve env ?(seen = []) (t : Ast.texpr) : Types.t =
  let loc = t.Ast.tloc in
  match t.Ast.t with
  (* The one slot that takes [_] never reaches here: [collect] reads it off
     the body first. So every [_] that does is in a slot with no body behind
     it. *)
  | Ast.Tinfer ->
    Loc.failk "check/infer-misplaced" loc
      "_ here asks for a type to be read off a function body, and only a \
       defn's return slot has a body to read. Write the type out"
  | Ast.Tname "const" ->
    fail loc
      "const is not a type on its own — it marks one that can only be read, \
       as in [const u8] or (Ptr const u8)"
  | Ast.Tname n -> resolve_name env ~seen loc n
  | Ast.Tslice (c, e) ->
    Types.Slice ((if c then Types.Const else Types.Mut), 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;
    (match l with
     | Ast.Lname n
       when (not env.len_placeholder)
            && List.mem (tyvar_bare n) env.lenvars
            && not (List.mem_assoc (tyvar_bare n) env.subst) ->
       Types.LArray (tyvar_bare n, e)
     | _ -> Types.Array (array_len env loc l, e))
  | Ast.Tlen n ->
    fail loc
      "%Ld is not a type. An integer stands only where a generic struct takes \
       a length, as in (Small 8 i32)" n
  (* {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) is a code address and the environment it is called with:
     two words. A value made out of a name carries a null there; one made out
     of an [fn] that captures carries the address of its copies: a slot of
     the frame it was written in, or an environment the collector allocated
     when the value outlives that frame (see [place_closures]).

     (CFn [T ...] R) is the address alone, one word, and nothing that can
     capture — see [Types] for why the C is information rather than
     decoration, and for why it is not yet a capability. Nobody needs it:
     [Fn] accepts everything, and the commonest reason to reach for the
     narrow one is that a *named* function handed to an [Fn] pays a hop
     through the widening thunk where a [CFn] is a direct call.

     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,
     for both. *)
  | Ast.Tfn (env', ps, r) ->
    let ps = List.map (resolve env ~seen) ps and r = resolve env ~seen r in
    if env' then Types.Fn (ps, r) else Types.CFn (ps, r)
  | Ast.Tapp (name, args) ->
    (match name, args with
     | "Ptr", [ a ] -> Types.Ptr (Types.Mut, resolve env ~seen a)
     (* The pointer beside [[const T]]: nothing is written through it, and a
        (Ptr T) converts to one. [const] cannot name a type, so this reading
        is the only one the two arguments have. *)
     | "Ptr", [ { Ast.t = Ast.Tname "const"; _ }; a ] ->
       Types.Ptr (Types.Const, resolve env ~seen a)
     | "Option", [ a ] -> Types.Option (resolve env ~seen a)
     | "Ptr", _ -> fail loc "a pointer type is (Ptr T), or (Ptr const T) for one \
                            nothing is written through"
     | "Option", _ -> fail loc "(Option T) takes exactly one type"
     | "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
     | _ when Hashtbl.mem env.gstructs name -> apply_struct env ~seen loc name args
     | _ ->
       (* No type of this name takes arguments: a generic struct is caught
          by the arm above, and [Ptr], [Option], [Vec] and [Map] further up. *)
       (* A head that is not a type at all but one edit from one is the typo
          [(Vect i32)], and the generics sentence would answer a question
          nobody asked. *)
       let constructors = [ "Ptr"; "Option"; "Vec"; "Map" ] in
       (match
          if Hashtbl.mem env.aliases name || Hashtbl.mem env.structs name
             || Hashtbl.mem env.datas name || Hashtbl.mem env.unions name
             || Hashtbl.mem env.enums name
          then None
          else near_miss env ~also:constructors name
        with
        | Some m when List.mem m constructors ->
          Loc.failk "check/unknown-type" loc
            "unknown type %s — did you mean %s?" name m
        | _ -> ());
       fail loc
         "%s takes no type arguments. A generic struct is one whose fields \
          introduce $t, as in (defstruct %s [x $t]), and a generic function \
          one whose parameter vector does"
         name name)

(* [(Small 8 i32)]: each argument read as the parameter it stands for — a
   length or a type — and the copy made, or found. *)
and apply_struct env ~seen loc name args =
  let g = Hashtbl.find env.gstructs name in
  let spelled =
    Printf.sprintf "(%s %s)" name
      (String.concat " " (List.map (fun (p, _) -> "$" ^ p) g.gparams))
  in
  let n = List.length g.gparams in
  if List.length args <> n then
    Loc.failk "check/generic-struct-arity" loc
      ~notes:[ Loc.note g.gloc (name ^ " is declared here") ]
      "%s takes %d argument%s, %s, and this gives %d"
      name n (if n = 1 then "" else "s") spelled (List.length args);
  let targs =
    List.map2
      (fun (p, is_len) (a : Ast.texpr) ->
         if is_len then struct_len_arg env name p a
         else
           match a.Ast.t with
           | Ast.Tlen k ->
             fail a.Ast.tloc
               "%s's $%s is a type, and %Ld is a length — %s" name p k spelled
           | _ -> resolve env ~seen a)
      g.gparams args
  in
  Types.Named (struct_copy env loc name targs)

and struct_len_arg env name p (a : Ast.texpr) =
  let not_one what =
    fail a.Ast.tloc
      "%s's $%s is a length: an integer, a constant's name or a length \
       variable, and %s is %s" name p (Cimport.ty_source a) what
  in
  match a.Ast.t with
  | Ast.Tlen k when Int64.compare k 0L < 0 ->
    fail a.Ast.tloc "%s's $%s is a length, and %Ld is negative" name p k
  | Ast.Tlen k -> Types.Len k
  | Ast.Tname n ->
    let bare = tyvar_bare n in
    (match List.assoc_opt bare env.subst with
     | Some (Types.Len _ as l) -> l
     | Some (Types.Var v) -> Types.Var v
     | Some t -> not_one ("the type " ^ tyname a.Ast.tloc t)
     | None ->
       if List.mem bare env.lenvars then Types.Var bare
       else if List.mem bare env.tyvars then not_one "a type variable"
       else
         match Hashtbl.find_opt env.consts n with
         | Some k -> Types.Len k
         | None -> not_one "none of them")
  | _ -> not_one "a type"

(* The copy of generic struct [name] at [targs], made on first use and
   registered as an ordinary struct under its key. *)
and struct_copy ?(at_definition = false) env loc name targs =
  let key = struct_app name targs in
  if Hashtbl.mem env.copies key then key
  else if Hashtbl.mem env.broken name then begin
    jreplace env.copies key (List.exists generic_arg targs);
    jreplace env.structs key { Tast.sname = key; fields = [] };
    key
  end
  else begin
    if Hashtbl.mem env.structs key || Hashtbl.mem env.datas key
       || Hashtbl.mem env.unions key then
      fail loc
        "%s at these arguments is called %s, and %s is already defined — \
         rename one" name key key;
    let g = Hashtbl.find env.gstructs name in
    (* A copy that asks for a copy of its own template at a type built around
       its own arguments — [(defstruct Grow [next (Ptr (Grow [$t]))])] — asks
       forever, and pointers do not stop it: each copy is made the moment it
       is named. *)
    let chain_text () =
      String.concat "\n  "
        (List.map
           (fun (h, a) ->
              Printf.sprintf "(%s %s)" h
                (String.concat " " (List.map (tyname loc) a)))
           (env.schain @ [ (name, targs) ]))
    in
    if List.exists
        (fun (h, a) -> String.equal h name && grows ~from_:a ~to_:targs)
        env.schain
    || List.length env.schain >= 64 then
      Loc.failk "check/runaway-instantiation" loc
        ~notes:[ Loc.note g.gloc (name ^ " is declared here") ]
        "%s names a copy of itself at a type built around its own \
         arguments, and that copy names another, without end:\n  %s\n\
         Name the same arguments, or smaller ones" name (chain_text ());
    let generic = List.exists generic_arg targs in
    (* In before its fields, so a field that names the same copy through a
       pointer — [(defstruct Node [next (Ptr (Node $t))])] — finds it. *)
    jreplace env.copies key generic;
    jreplace env.structs key { Tast.sname = key; fields = [] };
    jreplace env.locs key g.gloc;
    let saved =
      (env.subst, env.tyvars, env.lenvars, env.tvpreds, env.len_placeholder,
       env.in_field, env.schain)
    in
    let restore () =
      let s, t, l, p, lp, f, c = saved in
      env.subst <- s; env.tyvars <- t; env.lenvars <- l; env.tvpreds <- p;
      env.len_placeholder <- lp; env.in_field <- f; env.schain <- c
    in
    env.subst <- List.map2 (fun (p, _) a -> (p, a)) g.gparams targs;
    env.tyvars <- [];
    env.lenvars <- [];
    env.tvpreds <- [];
    env.len_placeholder <- generic;
    env.in_field <- true;
    env.schain <- env.schain @ [ (name, targs) ];
    match
      List.map
        (fun (f : Ast.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 })
        g.gfields
    with
    | fields ->
      restore ();
      jreplace env.structs key { Tast.sname = key; fields };
      finite_from env key;
      key
    | exception e ->
      restore ();
      jremove env.copies key;
      jremove env.structs key;
      (* A field refused inside the template says nothing about which use
         asked for this copy; the note names it, one per level of copies. *)
      (match e with
       | Loc.Error d when d.Loc.dloc <> loc && not at_definition ->
         Loc.raise_diag
           { d with
             Loc.notes =
               d.Loc.notes
               @ [ Loc.note loc
                     (tyname loc (Types.Named key) ^ " is made here") ] }
       | e -> raise e)
  end

(* Does a struct argument still mention a variable? *)
and generic_arg (t : Types.t) =
  match t with
  | Types.Var _ | Types.LArray _ -> true
  | Types.Slice (_, e) | Types.Array (_, e) | Types.Ptr (_, e) | Types.Vec e
  | Types.Option e -> generic_arg e
  | Types.Map (k, v) -> generic_arg k || generic_arg v
  | Types.Fn (ps, r) | Types.CFn (ps, r) ->
    List.exists generic_arg ps || generic_arg r
  | Types.Named k ->
    (match Hashtbl.find_opt struct_apps k with
     | Some (_, a) -> List.exists generic_arg a
     | None -> false)
  | _ -> false

(* 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 ?(also = []) n =
  (* [also] widens the candidate list past the types, and exactly one caller
     passes it: the defonce whose third element has to be a type *or* a value,
     whose suggestion is worth nothing if it can only ever name a type. *)
  let candidates =
    also
    @ 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 = tyvar_bare n in
  let a_length () =
    fail loc
      "%s is a length, not a type — it stands where an array's length does, \
       as in [%s T], or as a generic struct's length argument" n n
  in
  match List.assoc_opt bare env.subst with
  | Some (Types.Len _) -> a_length ()
  (* 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.lenvars then a_length ()
  else if List.mem bare env.tyvars then Types.Var bare
  else if n <> bare then
    (* A sigil on a name nothing binds. Two different mistakes wear the same
       spelling, and which one it is turns on whether any variable is in scope
       at all. Where none is — a struct field, a global, a [let] annotation —
       there is nowhere for a variable to bind and the fix is a concrete type.
       Where some are, the name is almost always a variable that was
       introduced once and spelled differently the second time, and the fix is
       one of the names that *is* bound. Naming them is the difference between
       a rule and an answer.

       Which names those are is read from [tyvars] during the abstract pass and
       from [subst] inside an instantiation, because the instantiation clears
       the first and fills the second — and a body is checked under both, so
       reading only one of them would answer the same mistake two ways in a
       single run. *)
    (match (match env.tyvars with [] -> List.map fst env.subst | vs -> vs) with
     | [] ->
       Loc.failk "check/unbound-type-variable" loc
         "%s introduces a type variable, and only a defn signature or a \
          defstruct's fields can — write the concrete type here" n
     | [ v ] ->
       Loc.failk "check/unbound-type-variable" loc
         "nothing binds the type variable %s — this signature introduces %s, \
          so write %s here, or a concrete type" n ("$" ^ v) ("$" ^ v)
     | vars ->
       Loc.failk "check/unbound-type-variable" loc
         "nothing binds the type variable %s — this signature introduces %s, \
          so write one of those here, or a concrete type"
         n (String.concat " and " (List.map (fun v -> "$" ^ v) vars)))
  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
      | "char" -> Types.Char
      | "str" -> 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 TODO.org, "The escape was real: a value the compiler builds
         trips no function-value refusal". *)
      | "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.gstructs n ->
        let g = Hashtbl.find env.gstructs n in
        Loc.failk "check/generic-struct-arity" loc
          ~notes:[ Loc.note g.gloc (n ^ " is declared here") ]
          "%s is generic, and a type only once it is given its arguments: \
           write (%s %s)" n n
          (* Variables are only an answer where a signature binds them; in
             ordinary code the example is concrete. *)
          (String.concat " "
             (List.map
                (fun (p, is_len) ->
                   if env.tyvars <> [] then "$" ^ p
                   else if is_len then "8"
                   else "i32")
                g.gparams))
      | _ 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 foreign_spelling n <> None ->
        Loc.failk "check/unknown-type" loc "unknown type %s — Flan spells it %s"
          n (Option.get (foreign_spelling n))
      | _ 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))
      (* An unknown lowercase name, and the sentence it gets used to be that
         generics were milestone 5 work. They are not: [$t] binds a type
         variable and bare [t] uses one, and [resolve_name] has already
         consulted [env.tyvars] and [env.subst] before anything reaches here.
         So a lowercase name arriving at this arm is one of exactly two
         things, and the message names both rather than sending somebody to a
         schedule.

         Either it is a typo too far from any type to be guessed at — the
         near-miss arm above catches the one-edit ones — or it is a type
         variable that was never introduced, which is the sigil's whole
         purpose to notice: without the binding site a mistyped type name
         silently became a type parameter and made the signature more
         permissive than it was written to be. *)
      | _ when n <> "" && n.[0] = Char.lowercase_ascii n.[0] ->
        (* The parameter-vector suggestion is only followable where a
           parameter vector exists. A field has none: a defstruct's field
           introduces the variable where it stands, so at a field the message
           says that instead. *)
        if env.in_field then
          Loc.failk "check/unknown-type" loc
            "unknown type %s. A lowercase name is a type variable only where \
             it is introduced with $%s, and in a defstruct's fields that makes \
             the struct generic over it. Write $%s, a concrete type, or dyn to \
             hold any value"
            n n n
        else
          Loc.failk "check/unknown-type" loc
            "unknown type %s. A lowercase name is a type variable only where a \
             defn signature introduced it — write $%s in the parameter vector \
             to introduce one, and %s reads it from there"
            n n n
      | _ -> Loc.failk "check/unknown-type" loc "unknown type %s" n

and array_len env loc = function
  | Ast.Lint n -> n
  | Ast.Lname n ->
    let bare = tyvar_bare n in
    (match List.assoc_opt bare env.subst with
     | Some (Types.Len k) -> k
     | Some (Types.Var _) -> abstract_len
     | Some t ->
       fail loc "%s is the type %s here, and an array length is an integer, a \
                 constant or a length variable" n (tyname loc t)
     | None when List.mem bare env.lenvars -> abstract_len
     | None when List.mem bare env.tyvars ->
       fail loc "%s is a type variable, and an array length is an integer, a \
                 constant or a length variable" n
     | None ->
    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 pairs only when a type follows it: [[str str]]
   has one reading. [(defn f [i64 x] ...)] has two — a dyn parameter called
   [i64], or a pair written backwards — so it is refused rather than handed
   back as a signature nobody wrote. *)
let is_type_name env n =
  Types.ikind_of_name n <> None
  || Types.fkind_of_name n <> None
  || List.mem n [ "bool"; "char"; "str"; "dyn"; "Unit"; "Never"; "Allocator" ]
  || Hashtbl.mem env.aliases n
  || Hashtbl.mem env.structs n
  || Hashtbl.mem env.gstructs 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] = '$')

(* A defn written without its return type puts the body's first form in the
   slot, and [(dotimes [i n] ...)] parses as a type application. Every type
   application's head is a constructor, and a constructor is capitalised, so a
   lowercase head there — or the name of a function — is a body form and not a
   malformed type. A capitalised head that is neither stays with [resolve],
   whose unknown-type and no-type-arguments sentences are the right ones for
   [(Vect i32)] and [(Pair i32)]. *)
let missing_return_type env (fn : Ast.fn) =
  match fn.Ast.ret with
  | Some { Ast.t = Ast.Tapp (head, args); tloc } ->
    let lowercase =
      head <> "" && not (head.[0] >= 'A' && head.[0] <= 'Z')
    in
    let constructor =
      List.mem head [ "Ptr"; "Option"; "Vec"; "Map"; "Result" ]
    in
    (* [(vec i32)] is the constructor with the wrong case, not a body form —
       but only while every argument is a type, since [(map inc xs)] is a
       body form whose head is a function. *)
    let args_are_types =
      List.for_all
        (fun (a : Ast.texpr) ->
           match a.Ast.t with Ast.Tname n -> is_type_name env n | _ -> true)
        args
    in
    (match
       List.find_opt
         (fun c -> String.lowercase_ascii c = String.lowercase_ascii head
                   && c <> head)
         [ "Ptr"; "Option"; "Vec"; "Map" ]
     with
     | Some c when args_are_types && not (is_type_name env head) ->
       Loc.failk "check/unknown-type" tloc
         "unknown type %s — did you mean %s?" head c
     | _ -> ());
    if (not constructor) && (not (is_type_name env head))
       && (lowercase || Hashtbl.mem env.fns head
           || List.mem head !builtin_names)
    then
      Loc.failk "check/return-type-missing" tloc
        "%s has no return type: (%s ...) stands where the return type goes, \
         and %s is not a type. The return type is written between the \
         parameter vector and the body, and a function that returns nothing \
         writes () there, or _ to read it off the body"
        fn.Ast.name head head
  | _ -> ()

(* 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 =
  (* [(defn idx [v i] dyn ...)] is two dyn parameters, and [i] is one edit
     from [i8], so the did-you-mean used to accuse a perfectly ordinary
     parameter name of being a mistyped type. What separates the two is the
     digits: this language sizes its machine types in the name, so a typo in
     one keeps them — [f65] for [f64], [i33] for [i32] — while [i], [v], [n]
     and [x] carry none and are what parameters are actually called. A name
     with no digit, one edit from a type that has one, is a parameter; the
     suggestion is dropped and the dyn reading stands, which is the reading
     the writer meant. *)
  let has_digit s = String.exists (fun c -> c >= '0' && c <= '9') s in
  let suggestion =
    match near_miss env n with
    | Some m when has_digit m && not (has_digit n) -> None
    | m -> m
  in
  (* In a .fln file the type sits after [name:], so it cannot be read as a
     second parameter and needs no word about parameter vectors. *)
  let fln = Source.indented_at loc in
  (* [string] is what most languages call the text type, so [[s string]] is
     far likelier one parameter of a misspelled type than two dyn ones. The
     other foreign spellings ([long], [byte], [double]) are ordinary parameter
     names and keep the dyn reading. *)
  if n = "string" then
    Loc.failk "check/unknown-type" loc
      "unknown type string — Flan spells it str%s"
      (if fln then ""
       else ". Otherwise string reads as a second parameter, because a \
             parameter with no type is dyn, and wants another name");
  match suggestion with
  | Some m when fln ->
    Loc.failk "check/unknown-type" loc "unknown type %s — did you mean %s?" n m
  | Some m ->
    Loc.failk "check/unknown-type" loc
      "unknown type %s — did you mean %s? Otherwise %s reads as a second \
       parameter, because a parameter with no type is dyn"
      n m n
  | None ->
    if n <> "" && n.[0] = Char.uppercase_ascii n.[0]
       && n.[0] <> Char.lowercase_ascii n.[0]
    then
      if fln then Loc.failk "check/unknown-type" loc "unknown type %s" n
      else
      Loc.failk "check/unknown-type" loc
        "unknown type %s. A capitalised name in a parameter vector is a type; \
         parameters are lowercase"
        n

(* The pairings a parameter vector owes to a type the program declares under
   a name that is also a legal parameter name — a lowercase one, since a
   capitalised name is refused as a parameter. [(defn f [p point] ...)] is one
   parameter while [point] is a type and two dyn ones the moment it is not,
   so adding or removing the type re-pairs the signature with no edit to it.
   The type still wins; this is the warning at the parameter, filled by
   [pair_decls] and printed by [build_program] with the other warnings. *)
let pairing_warnings : Loc.diag list ref = ref []

let pair_params ?(also = fun _ -> false) ?(declared = fun _ -> None)
    ?(hide = fun _ -> false) env (items : Ast.pitem list) : Ast.field list =
  let is_type_name env n = (is_type_name env n && not (hide n)) || also n in
  let warn_pairing n t tloc =
    let bare =
      match String.rindex_opt t '/' with
      | Some i -> String.sub t (i + 1) (String.length t - i - 1)
      | None -> t
    in
    match declared t with
    | Some (what, (at : Loc.t))
      when bare <> "" && bare.[0] >= 'a' && bare.[0] <= 'z' ->
      pairing_warnings :=
        Loc.diag ~kind:"check/parameter-reads-a-type" tloc
          (Printf.sprintf
             "[%s %s] is one parameter %s of type %s, the %s declared at %s, \
              and not two dyn parameters. If two were meant, give the second \
              a name no type has"
             n t n t what (Loc.to_string at))
        :: !pairing_warnings
    | _ -> ()
  in
  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 ...]"
    (* A parameter may share a type's name — [str] is a common name for text —
       when a type follows it: [[str str]] and [str: str] can only be a name
       then a type. Without a type after it, [[i64 x]] is a pair written
       backwards as likely as a dyn parameter called [i64], so that one is
       refused with both fixes. *)
    | Ast.Pname (n, loc) :: Ast.Ptype t :: rest when is_type_name env n ->
      { Ast.fname = n; fty = t; floc = loc } :: go rest
    | Ast.Pname (n, loc) :: Ast.Pname (t, tloc) :: rest
      when is_type_name env n && is_type_name env t ->
      { Ast.fname = n; fty = { Ast.t = Ast.Tname t; tloc }; floc = loc } :: go rest
    | Ast.Pname (n, loc) :: _ when is_type_name env n ->
      Loc.failk "check/parameter-named-type" loc
        "%s names a type, and no type follows this parameter called %s. Give \
         it one, as [%s %s], or if the pair is backwards write [name %s]" n n n n n
    (* [_] reads a type off a body, and a parameter has none to read. *)
    | Ast.Pname (n, _) :: Ast.Pname ("_", tloc) :: _ ->
      Loc.failk "check/infer-misplaced" tloc
        "_ here asks for %s's type to be read off a body, and a parameter's \
         type is never read off anything. Write its type, or leave it out \
         and %s is dyn"
        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 ->
      warn_pairing n t tloc;
      { 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

(* A class slot's type, held to the set a stored dyn value can be checked
   against. A class's name is a type here, and only here: it is not a type
   anywhere else in the language, since an instance is a dyn value. Every
   other type a slot could name — a struct, a Vec, a pointer — does not cross
   into dyn at all, so a slot of one could never be written. *)
(* A class named in [cls]'s slot vector: [n] as written, or [n] in [cls]'s own
   package, since [Load] leaves a bare name in a slot vector unqualified. *)
let class_named ~classes cls n =
  (* The class's own package first: an importer may declare a class of the
     same bare name, and a slot the package wrote means the package's. *)
  let own =
    match String.rindex_opt cls '/' with
    | Some i ->
      let q = String.sub cls 0 (i + 1) ^ n in
      if List.mem q classes then Some q else None
    | None -> None
  in
  match own with
  | Some _ -> own
  | None -> if List.mem n classes then Some n else None

let rec slot_of env ~classes cls fname (t : Ast.texpr) : slot_ty =
  let refuse what =
    Loc.failk "check/slot-type" t.Ast.tloc
      "the slot %s of %s is declared %s, and a class slot holds a dyn value, \
       which can be checked as bool, an integer type, f32, f64, string, a \
       class, or (Option T) of one of those. Write one of those, or leave the \
       type out and the slot holds any dyn value: [%s]"
      fname cls what fname
  in
  match t.Ast.t with
  | Ast.Tname n when class_named ~classes cls n <> None ->
    Sclass (Option.get (class_named ~classes cls n))
  | Ast.Tapp ("Option", [ inner ]) ->
    (match slot_of env ~classes cls fname inner with
     | (Sval _ | Sclass _) as s -> Sopt s
     | Sany -> refuse "(Option dyn)"
     | Sopt _ as s -> refuse ("(Option " ^ slot_text s ^ ")"))
  | _ ->
    (match resolve env t with
     | Types.Dyn -> Sany
     | (Types.Bool | Types.Int _ | Types.Float _ | Types.String) as t -> Sval t
     | other -> refuse (tyname t.Ast.tloc other))

(* The type's word in the string the runtime reads: the scalar type's name,
   [#name] for a class, [?] in front for an Option. See [slot_type_of] in
   runtime/flan_dyn.c, which is the reader. *)
let rec slot_word = function
  | Sany -> ""
  | Sval t -> Types.to_string t
  | Sclass c -> "#" ^ c
  | Sopt s -> "?" ^ slot_word s

(* What the runtime is told a class is: one line per slot, in constructor
   order, the slot's name and then its type's word after a space — no type
   for a dyn slot. The same string goes to [flan_dyn_map_new_class] from the
   constructor and to [flan_dyn_class_def] from a reload, so the two cannot
   describe one class differently. *)
let class_spec_of (slots : (string * slot_ty) list) =
  String.concat "\n"
    (List.map
       (fun (n, t) -> match t with Sany -> n | t -> n ^ " " ^ slot_word t)
       slots)

let class_slots env n = Hashtbl.find_opt env.classes n

(* A class's slot vector, paired by [pair_params]'s rule with the program's
   class names counted as types — so [[owner point]] is one slot holding a
   point.

   A lowercase name after a name that is neither a type nor a class is a
   second untyped slot, which is the rule for a [defn]'s parameters and is
   not changed here. In a vector that types none of its slots that is the
   plain reading — [[x y]] is two slots and says nothing more. In one that
   types some of them, two untyped names side by side are as likely a type
   nobody has declared, so that is said, at the second name, and the slot
   stays what the rule makes it. *)
let pair_slots env ~classes cls (items : Ast.pitem list) : Ast.field list =
  let fields =
    pair_params ~also:(fun n -> class_named ~classes cls n <> None) env items
  in
  let untyped (f : Ast.field) =
    match f.Ast.fty.Ast.t with Ast.Tname "dyn" -> true | _ -> false
  in
  let written_dyn =
    List.exists (function Ast.Pname ("dyn", _) -> true | _ -> false) items
  in
  if List.exists (fun f -> not (untyped f)) fields && not written_dyn then begin
    let rec scan = function
      | (a : Ast.field) :: ((b : Ast.field) :: _ as rest) ->
        if untyped a && untyped b then
          prerr_endline
            (Loc.entry ~mark:'~' ~label:"warning: " b.Ast.floc
               (Printf.sprintf
                  "%s reads as a slot of %s with no type, because no type or \
                   class is named %s. If it was meant as the type of %s, \
                   declare it; if it is a slot, write its type or write \
                   [%s dyn] to say it holds any value"
                  b.Ast.fname cls b.Ast.fname a.Ast.fname b.Ast.fname));
        scan rest
      | _ -> ()
    in
    scan fields
  end;
  fields

(* 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 classes =
    List.filter_map
      (fun (d : Ast.decl) ->
         match d.Ast.d with Ast.Defclass (n, _) -> Some n | _ -> None)
      decls
  in
  (* The types the program declares, with what kind and where, for
     [pair_params]'s warning. The prelude's are left out: its names are the
     language's, not a declaration the reader made. *)
  let types = Hashtbl.create 16 in
  List.iter
    (fun (d : Ast.decl) ->
       let add n what =
         if d.Ast.dloc.Loc.file <> Prelude.file
            && not (List.mem n Types.primitive_names) then
           Hashtbl.replace types n (what, d.Ast.dloc)
       in
       match d.Ast.d with
       | Ast.Defstruct (n, _, _) -> add n "struct"
       | Ast.Defenum (n, _) -> add n "enum"
       | Ast.Defalias (n, _) -> add n "alias"
       | Ast.Defdata (n, _) -> add n "data type"
       | Ast.Defunion (n, _) -> add n "union"
       | _ -> ())
    decls;
  pairing_warnings := [];
  (* A prelude signature is paired against the prelude's types alone: a
     program's type named [t] must not turn the prelude's parameter [t] into
     a type. *)
  let fn ~prelude (f : Ast.fn) =
    match f.Ast.praw with
    | None -> f
    | Some items ->
      let hide n = prelude && Hashtbl.mem types n in
      { f with
        Ast.params =
          pair_params ~hide ~declared:(Hashtbl.find_opt types) env items;
        praw = None }
  in
  List.map
    (fun (d : Ast.decl) ->
       let prelude = String.equal d.Ast.dloc.Loc.file Prelude.file in
       match d.Ast.d with
       (* A class's slot vector is paired here and nowhere earlier, for the
          reason a [defn]'s is, and its constructor is written from the
          pairs — [Classes.expand] left the declaration as it was for exactly
          this. *)
       | Ast.Defclass (n, items) ->
         let slots = pair_slots env ~classes n items in
         Hashtbl.replace env.classes n
           (List.map
              (fun (f : Ast.field) ->
                 (f.Ast.fname, slot_of env ~classes n f.Ast.fname f.Ast.fty))
              slots);
         Classes.constructor n slots d.Ast.dloc
       | Ast.Defn f -> { d with Ast.d = Ast.Defn (fn ~prelude f) }
       | Ast.Declare (f, c) -> { d with Ast.d = Ast.Declare (fn ~prelude f, c) }
       | Ast.DeclareC (f, c) -> { d with Ast.d = Ast.DeclareC (fn ~prelude f, c) }
       | _ -> d)
    decls

(* ── The third element of a defonce, decided ────────────────────────────

   The author's rule, 2026-09-20: "if it's 3 atoms then it's dyn", and
   "dispatch the if it's a type do the right thing". [(defonce current-color
   i32)] is the zeroed static it has always been, and [(defonce score 0)] is a
   dyn global holding 0 — the same thing [(defonce score dyn 0)] spells out,
   lowered by the same path and not by a second one.

   [Parse] settled every shape a shape can settle and handed the rest over
   carrying both readings ([Ast.Ambiguous], beside the type reading in the
   same [Defvar]). What is left is the two forms only a name can settle, and
   this is the first point where every type name is in hand: the same point
   [pair_params] reads, for the same reason — a defonce may name a struct
   declared fifty lines below it.

   The type reading wins wherever there is one. That is what keeps today's
   programs meaning today's thing: [(defonce p Point)] is a zeroed [Point],
   [(defonce v (Vec i32))] is a zeroed [Vec], and a wrong type argument inside
   one stays a type error rather than becoming an unknown function. It is also
   why a built-in constructor is checked by name rather than by whether
   [resolve] happens to accept it — [(Vec i32 i32)] is a malformed [Vec] and
   not a call to something called [Vec].

   A type and a value cannot share a name: [collect]'s [claimed] table is over
   every declaration kind there is, so one name is one declaration and the two
   readings can never both be live. *)
let defvar_reads_as_type env (t : Ast.texpr) =
  match t.Ast.t with
  | Ast.Tname n -> is_type_name env n
  | Ast.Tapp (head, _) ->
    List.mem head [ "Ptr"; "Option"; "Vec"; "Map"; "Result" ]
    || Hashtbl.mem env.gstructs head
  (* A slice, a fixed array, a map type or an (Fn ...): [Parse] only carries
     one of these over when it read as a type and had no value reading, so
     there is nothing here to decide. *)
  | _ -> true

(* The bare symbol that is neither. Before the rule there was one reading and
   the message was "unknown type"; now the position takes either kind of name,
   so a message naming only one of them would send a reader looking for the
   wrong mistake. Both readings, both spellings, and the near miss over the
   value names as well as the type names. *)
(* Both readings, and the paragraph that explains them — but only when both
   readings really are open. Three things get in ahead of it, because each one
   knows which of the two the writer meant and the paragraph would bury that
   under a lecture about a fork they are not standing at:

   a case name, which is a third thing entirely and has its own spelling; a
   name another language spells for a type this one has under a different
   name; and a plain type typo, where a confident one-edit suggestion turns a
   one-line answer into four lines of unrelated reading. The paragraph is for
   the name that genuinely could have been either and is neither. *)
let defvar_neither env loc ~form gname n ~values ~cases =
  (match List.assoc_opt n cases with
   | Some dname ->
     Loc.failk "check/defvar-case-not-type" loc
       "%s is a case of the data type %s, and a case is not a type of its \
        own — the global's type is the data type: (%s %s %s). Assign the \
        case you want, as (set %s (%s.%s {.field value ...}))"
       n dname form gname dname gname dname n
   | None -> ());
  (match foreign_spelling n with
   | Some m ->
     Loc.failk "check/unknown-type" loc "unknown type %s — Flan spells it %s" n m
   | None -> ());
  (match near_miss env n with
   | Some m ->
     Loc.failk "check/unknown-type" loc "unknown type %s — did you mean %s?" n m
   | None -> ());
  let hint =
    match near_miss env ~also:values n with
    | Some m -> Printf.sprintf " — did you mean %s?" m
    | None -> ""
  in
  Loc.failk "check/defvar-neither-type-nor-value" loc
    "%s is neither a type nor a value, and the third element of a %s has \
     to be one or the other: a type there declares a zeroed global of that \
     type — (%s %s i64) — and a value there declares a dyn global holding \
     it — (%s %s 0). Nothing named %s is declared as either%s"
    n form form gname form gname n hint

(* Every name a value could be written under, which is every declaration that
   is not a type plus whatever a session already has. The list is only ever
   asked "is this name declared at all", so a global that is itself a defonce
   still undecided belongs on it: what it resolves to is the next pass's
   question, not this one's. *)
(* The infinities and NaNs, which the reader has no literal for and the
   integer-only constant folder cannot compute, so the compiler supplies them
   beside the prelude's f64-max and the rest. Negative infinity is
   [(- f64-inf)]. *)
let special_float = function
  | "f64-inf" -> Some (Float.infinity, Types.F64)
  | "f64-nan" -> Some (Float.nan, Types.F64)
  | "f32-inf" -> Some (Float.infinity, Types.F32)
  | "f32-nan" -> Some (Float.nan, Types.F32)
  | _ -> None

(* Case name -> the data type it belongs to, read off the declarations rather
   than out of [env.cases]: this runs inside [collect], which has registered
   the data type *names* by here but not resolved their cases, so the table
   would be empty. Last writer wins, exactly as [env.cases] does, and for the
   same reason — this is only ever asked "what is this a case of", and two
   data types may share a case name. *)
let case_owners (decls : Ast.decl list) =
  List.concat_map
    (fun (d : Ast.decl) ->
       match d.Ast.d with
       | Ast.Defdata (dn, vs) ->
         List.map (fun (v : Ast.variant) -> (v.Ast.vname, dn)) vs
       | _ -> [])
    decls

let value_names env (decls : Ast.decl list) =
  let declared =
    List.filter_map
      (fun (d : Ast.decl) ->
         match d.Ast.d with
         | Ast.Defvar (n, _, _, _) | Ast.Defconst (n, _, _) -> Some n
         | Ast.Defn fn | Ast.Declare (fn, _) | Ast.DeclareC (fn, _) ->
           Some fn.Ast.name
         | _ -> None)
      decls
  in
  declared
  @ Hashtbl.fold (fun k _ acc -> k :: acc) env.globals []
  @ Hashtbl.fold (fun k _ acc -> k :: acc) env.fns []

(* The decision, applied: an undecided defonce leaves this pass as one of the
   two forms that already existed, so no pass after it — the signature loop
   below, [check_global], either backend — has a third case to know about. The
   dyn reading is rewritten into exactly [(defonce x dyn <expr>)], which is the
   whole of "it lowers to the same thing": the startup lifting, the re-run
   guard and the collector root are the ones that form already had. *)
(* A bracket form whose element names a value. [(defonce g [a b])] parses as a
   type and stays one — type wins wherever there is a type reading, which is
   the rule — so the element had to name an element type, and [b] names a
   defonce. Left alone this reaches [resolve_name], where a lowercase name that
   is no type is a type variable, and the answer is a paragraph about generic
   code the writer was not asking for.

   Both readings, and both spellings, at the element that decided it. The dyn
   spelling is the one that actually works: [(defonce g dyn [a b])] is a dyn
   global holding a vector, which is what the brackets meant to whoever wrote
   them. *)
let rec bracket_value_element env values (t : Ast.texpr) =
  let elem (e : Ast.texpr) =
    match e.Ast.t with
    | Ast.Tname n when (not (is_type_name env n)) && List.mem n values ->
      Some (n, e.Ast.tloc)
    | _ -> bracket_value_element env values e
  in
  match t.Ast.t with
  | Ast.Tslice (_, e) -> elem e
  | Ast.Tarray (_, e) -> elem e
  | _ -> None

let settle_defvars env (decls : Ast.decl list) : Ast.decl list =
  let values = lazy (value_names env decls) in
  let cases = lazy (case_owners decls) in
  (* A bracket form never reaches the fork below: [Parse.defvar3] gives it
     [Zeroed] outright, because a bracket that parses as a type has no second
     reading to carry. So the element check runs on both, and it is the only
     thing the [Zeroed] arm does. *)
  let brackets ~form gname (t : Ast.texpr) =
    match bracket_value_element env (Lazy.force values) t with
    | Some (v, vloc) ->
      Loc.failk "check/defvar-bracket-element-is-a-value" vloc
        "%s names a value, not a type, and the brackets around it were read \
         as a type — a %s's third element is a type wherever there is a \
         type reading, so %s had to be the element type. Write a type there \
         for a zeroed global, or put dyn in front of the same brackets — \
         (%s %s dyn ...) — for a dyn global holding the vector you wrote"
        v form v form gname
    | None -> ()
  in
  let word = function Ast.Once -> "defonce" | Ast.Every -> "def" in
  List.map
    (fun (d : Ast.decl) ->
       match d.Ast.d with
       | Ast.Defvar (n, Some t, Ast.Zeroed, k) -> brackets ~form:(word k) n t; d
       | Ast.Defvar (n, Some t, Ast.Ambiguous e, k) ->
         let form = word k in
         if defvar_reads_as_type env t then begin
           brackets ~form n t;
           { d with Ast.d = Ast.Defvar (n, Some t, Ast.Zeroed, k) }
         end
         else begin
           (match t.Ast.t with
            | Ast.Tname s
              when not (List.mem s (Lazy.force values))
                   && special_float s = None ->
              defvar_neither env t.Ast.tloc ~form n s
                ~values:(Lazy.force values) ~cases:(Lazy.force cases)
            | _ -> ());
           let dyn = { Ast.t = Ast.Tname "dyn"; tloc = t.Ast.tloc } in
           { d with Ast.d = Ast.Defvar (n, Some dyn, Ast.Init e, k) }
         end
       | _ -> 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 sigil_vars ~kinds_of (ts : Ast.texpr list) =
  let acc = ref [] in
  let add loc n is_len =
    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;
      match List.assoc_opt bare !acc with
      | None -> acc := (bare, is_len) :: !acc
      | Some k when k = is_len -> ()
      | Some _ ->
        fail loc
          "$%s stands for a length in one place here and a type in another — \
           a length goes in an array's length slot, [$%s T], and a type \
           everywhere else. Give the two different names" bare bare
    end
  in
  let rec ty (t : Ast.texpr) =
    match t.Ast.t with
    | Ast.Tname n -> add t.Ast.tloc n false
    | Ast.Tslice (_, e) -> ty e
    | Ast.Tarray (Ast.Lname n, e) -> add t.Ast.tloc n true; 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],
       a generic struct — and a variable cannot stand there: this is generic
       over types, not over type constructors. A [$t] inside the arguments is
       ordinary, and a generic struct's length argument is a length. *)
    | Ast.Tapp (h, args) ->
      (match kinds_of h with
       | Some ks when List.length ks = List.length args ->
         List.iter2
           (fun is_len (a : Ast.texpr) ->
              match a.Ast.t with
              | Ast.Tname n when is_len -> add a.Ast.tloc n true
              | _ -> ty a)
           ks args
       | _ -> List.iter ty args)
    | Ast.Tfn (_, ps, r) -> List.iter ty ps; ty r
    | Ast.Tinfer -> ()
    | Ast.Tlen _ -> ()
  in
  List.iter ty ts;
  let vs = List.rev !acc in
  (List.map fst vs, List.filter_map (fun (v, l) -> if l then Some v else None) vs,
   vs)

let struct_kinds env h =
  Option.map (fun g -> List.map snd g.gparams) (Hashtbl.find_opt env.gstructs h)

(* The variables a signature introduces: every [$t] written in it, in the
   order written, once each, and which of them are lengths. Only a [defn]
   signature and a [defstruct]'s fields are scanned, which is what makes the
   binding site a *place* and not merely a spelling. *)
let signature_tyvars env (fn : Ast.fn) =
  let vars, lens, _ =
    sigil_vars ~kinds_of:(struct_kinds env)
      (List.map (fun (p : Ast.field) -> p.Ast.fty) fn.Ast.params
       @ Option.to_list fn.Ast.ret)
  in
  vars, lens

(* 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. *)
(* [ro] is whether a [[T]] argument may meet a [[const $t]] pattern here: at
   the top of an argument's type, and under a const slice, which is exactly
   where [Types.const_widens] lets [expect] convert the value afterwards. *)
let rec bind_ty ?(widen = false) ?(ro = true) subst (pat : Types.t)
    (arg : Types.t) =
  let inner = bind_ty ~ro:false subst in
  match pat, arg with
  | Types.Var v, a ->
    (match List.assoc_opt v !subst with
     | None -> subst := (v, a) :: !subst; true
     | Some b when Types.equal a b -> true
     (* Two arguments that differ only in const bind the variable to the
        read-only one, whichever came first — the same meeting an [if]'s two
        branches have. [expect] converts the writable argument afterwards. *)
     | Some b when ro ->
       (match Types.const_join a b with
        | Some j ->
          subst := (v, j) :: List.remove_assoc v !subst; true
        | None -> false)
     | Some _ -> false)
  | Types.Slice (m, p), Types.Slice (m', a)
    when m = m' || (ro && m = Types.Const) ->
    bind_ty ~ro:(m = Types.Const) subst p a
  | Types.Ptr (m, p), Types.Ptr (m', a)
    when m = m' || (ro && m = Types.Const) ->
    bind_ty ~ro:(m = Types.Const) subst p a
  | Types.Vec p, Types.Vec a
  | Types.Option p, Types.Option a -> inner p a
  (* A plain value at a [$t?] parameter binds [$t] to its own type, and
     [expect] wraps it (decision 138). At the top of an argument only, as the
     widening below: an element of a Vec is never wrapped, so [(Vec $t?)]
     meets a [(Vec i32)] as a mismatch. *)
  | Types.Option p, a
    when widen && (match a with Types.Dyn | Types.Never -> false | _ -> true) ->
    bind_ty ~widen subst p a
  | Types.Array (n, p), Types.Array (m, a) -> Int64.equal n m && inner p a
  | Types.Map (k, v), Types.Map (k', v') -> inner k k' && inner v v'
  (* Each function type against its own. *)
  | Types.Fn (ps, r), Types.Fn (ps', r')
  | Types.CFn (ps, r), Types.CFn (ps', r') ->
    List.length ps = List.length ps'
    && List.for_all2 inner ps ps' && inner r r'
  (* And the widening between them, which is admitted at the top of an
     argument's type and nowhere inside it.
     [(Fn [$t] $t)] against a [(CFn [i32] i32)] is the shape every caller of
     a generic higher-order function has, because a [defn]'s name carries
     [CFn]: [(apply2 bump 1)]. It has to bind here, where the variables are
     decided, and not only in [expect] — [generic_call] binds first and would
     have reported the mismatch before [expect] was ever reached.

     The prelude hides that: its higher-order functions bind [$t] from an
     earlier argument, so [subst_ty] has already made the parameter concrete
     by the time this sees it and [(map-in-place s double)] never took this
     path.

     [widen] is why it goes no deeper. The widening is a *value* the caller
     builds — a thunk, minted at the call — and there is exactly one place to
     build it, around the whole argument. A [(Fn [(Fn [$t] $t)] i32)]
     parameter handed a [(CFn [(CFn [i32] i32)] i32)] would need one built
     inside the argument's own parameter list, where no caller stands, so the
     two types do not meet there and the pattern does not match. What reaches
     the fallthrough below is an ordinary mismatch and is refused as one, the
     same answer a call with no type variables in it gets.

     One way, as everywhere else: a [CFn] pattern does not admit an [Fn]
     argument. *)
  | Types.Fn (ps, r), Types.CFn (ps', r') when widen ->
    List.length ps = List.length ps'
    && List.for_all2 inner ps ps' && inner r r'
  (* A length variable's array against a concrete one: the length is bound
     the way a type variable is, to a [Types.Len]. *)
  | Types.LArray (v, p), Types.Array (n, a) ->
    bind_ty ~ro:false subst (Types.Var v) (Types.Len n) && inner p a
  (* A struct copy at variables against a copy of the same template: each
     argument against its own. *)
  | Types.Named p, Types.Named a ->
    (match Hashtbl.find_opt struct_apps p, Hashtbl.find_opt struct_apps a with
     | Some (g, ps), Some (h, as_) when String.equal g h ->
       List.length ps = List.length as_ && List.for_all2 inner ps as_
     | _ -> Types.fits ~expected:pat ~actual:arg)
  (* 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 (m, e) -> Types.Slice (m, 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 (m, e) -> Types.Ptr (m, 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)
  | Types.CFn (ps, r) ->
    Types.CFn (List.map (subst_ty subst) ps, subst_ty subst r)
  | Types.LArray (v, e) ->
    (match List.assoc_opt v subst with
     | Some (Types.Len n) -> Types.Array (n, subst_ty subst e)
     | Some (Types.Var w) -> Types.LArray (w, subst_ty subst e)
     | _ -> Types.LArray (v, subst_ty subst e))
  (* A struct copy at variables becomes the copy at what they are bound to.
     Only its key is made here — there is no env to lay it out in — and
     [realise] makes the copy itself before anything reads its fields. *)
  | Types.Named k ->
    (match Hashtbl.find_opt struct_apps k with
     | Some (g, args) when List.exists open_ty args ->
       let args = List.map (subst_ty subst) args in
       Types.Named (struct_app g args)
     | _ -> t)
  | t -> t

(* Does this resolved type still mention a variable? Not through a struct
   copy's arguments: an operator over a [(Pair $t)] is refused as one over a
   struct, not as one over a type variable. [open_ty] is the question that
   does look through, for binding and substituting. *)
and generic_ty (t : Types.t) =
  match t with
  | Types.Var _ | Types.LArray _ -> 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) | Types.CFn (ps, r) ->
    List.exists generic_ty ps || generic_ty r
  | _ -> false

and open_ty (t : Types.t) =
  match t with
  | Types.Var _ | Types.LArray _ -> true
  | Types.Slice (_, e) | Types.Array (_, e) | Types.Ptr (_, e) | Types.Vec e
  | Types.Option e -> open_ty e
  | Types.Map (k, v) -> open_ty k || open_ty v
  | Types.Fn (ps, r) | Types.CFn (ps, r) -> List.exists open_ty ps || open_ty r
  | Types.Named k ->
    (match Hashtbl.find_opt struct_apps k with
     | Some (_, args) -> List.exists open_ty args
     | None -> false)
  | _ -> false

(* Make every struct copy [t] names that [subst_ty] only named. A copy has
   to exist in [env.structs] before a field of it is read, and [subst_ty] has
   no env to make one in. *)
let rec realise env loc (t : Types.t) =
  match t with
  | Types.Slice (_, e) | Types.Array (_, e) | Types.Ptr (_, e) | Types.Vec e
  | Types.Option e | Types.LArray (_, e) -> realise env loc e
  | Types.Map (k, v) -> realise env loc k; realise env loc v
  | Types.Fn (ps, r) | Types.CFn (ps, r) ->
    List.iter (realise env loc) ps; realise env loc r
  | Types.Named k when not (Hashtbl.mem env.structs k) ->
    (match Hashtbl.find_opt struct_apps k with
     | Some (g, args) when Hashtbl.mem env.gstructs g ->
       List.iter (realise env loc) args;
       ignore (struct_copy env loc g args)
     | _ -> ())
  | _ -> ()

(* Does a type a call site bound a variable to reach a [dyn] anywhere? See the
   refusal in [generic_call]: [dyn] is a concrete type and substitutes like any
   other, so nothing stopped a copy being made at it, and the copies walked
   straight into holes the rest of the language has no [dyn] answer for yet. *)
let rec reaches_dyn (t : Types.t) =
  match t with
  | Types.Dyn -> true
  | Types.Slice (_, e) | Types.Array (_, e) | Types.Ptr (_, e) | Types.Vec e
  | Types.Option e -> reaches_dyn e
  | Types.Map (k, v) -> reaches_dyn k || reaches_dyn v
  | Types.Fn (ps, r) | Types.CFn (ps, r) ->
    List.exists reaches_dyn ps || reaches_dyn 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. *)
(* A predicate as a word in a sentence, [ordered (is-ordered)], and a where
   clause as the file at [loc] spells one. [v] is the variable with its [$]. *)
let pred_word p =
  let w =
    if String.length p > 3 && String.sub p 0 3 = "is-" then String.sub p 3 (String.length p - 3)
    else p
  in
  if w = p then p else Printf.sprintf "%s (%s)" w p

let where_text loc p v =
  if Source.indented_at loc then Printf.sprintf "where %s(%s)" p v
  else Printf.sprintf "{:where (%s %s)}" p v

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: nothing declares %s %s. Write \
         %s at the head of the body, or take the operation as \
         a parameter, a (Fn [%s %s] ...), and call it here"
        op (tyname loc t) (tyname loc t) (pred_word needs)
        (where_text loc needs (tyname loc t))
        (tyname loc t) (tyname loc 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 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 (tyname loc) 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:\n  %s\nRecur at the same type, or \
        at a smaller one"
       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 ────────────────────────────────────── *)

(* The untyped defconsts whose value is a char literal, by name, with the
   code point. A use where typed code wants a number is that literal at the
   number's type, as the literal written there would be, so a byte constant
   such as (defconst sep \,) still compares with a u8 (decision 127). Filled
   by the declaration pass of the program being checked. *)
let char_consts : (string, int) Hashtbl.t = Hashtbl.create 8

(* A [+] or [-] pair found to be char arithmetic after the ordinary join
   refused it, with both operands checked on their own terms. *)
exception Char_pair of Tast.expr * Tast.expr

(* 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.UInt _ | 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 }

(* A local narrowed by [if x?]: the same slot, read as its payload. *)
let narrowed_tag = "~narrowed"

(* The locals of the function being checked that [if x?] must not narrow:
   one whose address is taken, which a pointer could clear behind the
   block's back, and one a fn assigns (decision 133, Kotlin's rule). *)
let unnarrowable : string list ref = ref []

let unnarrowable_in (body : Ast.expr list) =
  let out = ref [] in
  let rec walk ~in_fn (e : Ast.expr) =
    (match e.Ast.e with
     | Ast.Call ({ Ast.e = Ast.Var ("addr" | "addr-of"); _ }, [ { Ast.e = Ast.Var x; _ } ]) ->
       out := x :: !out
     | Ast.Set (Ast.Pvar x, _) when in_fn -> out := x :: !out
     | _ -> ());
    let in_fn = in_fn || (match e.Ast.e with Ast.Fn _ -> true | _ -> false) in
    ignore (Ast.map_children (fun x -> walk ~in_fn x; x) e)
  in
  List.iter (walk ~in_fn:false) body;
  !out

(* The [bwhat] of a name an [as] bound (decision 136), for the refusal to
   assign it. *)
let as_tag = "~as"

let local_of loc (b : binding) =
  if b.bwhat = Some narrowed_tag then
    mk loc b.bty (Tast.Field (mk loc (Types.Option b.bty) (Tast.Local b.slot), 1))
  else mk loc b.bty (Tast.Local b.slot)

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

(* The compiler temp an [and] leaves in its else arm; see [check_if]. *)
let and_sentinel (x : Ast.expr) =
  match x.Ast.e with
  | Ast.Var n -> String.length n > 4 && String.sub n 0 4 = "and~"
  | _ -> false

(* Integer arithmetic over literals alone, folded. Unlike [const_int] no name
   is read: a defconst has a type of its own, and only an untyped constant may
   stand at a type variable. *)
let rec literal_arith (e : Ast.expr) : int64 option =
  match e.Ast.e with
  | Ast.Int n -> Some n
  | Ast.Call ({ Ast.e = Ast.Var "-"; _ }, [ x ]) ->
    Option.map Int64.neg (literal_arith x)
  | 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, literal_arith e with
         | Some a, Some b -> step a b
         | _ -> None)
      (literal_arith x) (y :: rest)
  | _ -> None

(* A value with no type until one is asked of it: a literal, or arithmetic
   over literals alone. *)
let lone_literal (e : Ast.expr) = is_literal e || literal_arith e <> None

(* Set for one [check_value] entry: the literal is checked at the Option
   itself, not wrapped, so a refusal names the Option (decision 138). *)
let skip_wrap = ref false

(* [None] as written, which has no type until an Option is asked of it. *)
let is_none_lit (e : Ast.expr) =
  match e.Ast.e with Ast.Var "None" -> true | _ -> false

(* A value whose type comes only from defaults — a literal, [nil], [(Some 3)],
   arithmetic over literals, a [do] ending in one — so it takes the type of whatever
   meets it. An arm of this kind is checked after the others, at their type,
   and never decides a join. *)
let rec adapts (e : Ast.expr) =
  lone_literal e
  || (match e.Ast.e with
      | Ast.Var "nil" -> true
      | Ast.Call ({ Ast.e = Ast.Var "Some"; _ }, [ x ]) -> adapts x
      | Ast.Call ({ Ast.e = Ast.Var ("+" | "-" | "*" | "/" | "%"); _ },
                  (_ :: _ as xs)) ->
        List.for_all adapts xs
      | Ast.Do (_ :: _ as xs) | Ast.Let (_, (_ :: _ as xs)) ->
        adapts (List.hd (List.rev xs))
      | Ast.If (_, a, Some b) -> adapts a && adapts b
      | _ -> false)


(* The environment for a lifted body, built once its own body has been checked
   and [caught] is therefore final. spec-memory.md's case 2, and the whole of
   its machinery.

   It is a struct the checker synthesises — one field per captured name, in
   first-reference order — and it is registered in the same table a
   [defstruct] goes in, so both backends lay it out with the calculator they
   already have and neither learns a new shape. Its name is the lifted
   function's, which is unique and stable for the reason that name is: a
   redefinition module emits the lifted functions belonging to the bodies it
   replaces, and it emits their environments with them.

   Two ends, and the copy is at the near one:

   - in the *enclosing* frame, a slot holding the struct, filled with a [Make]
     of the outer locals. That store is the copy, and it happens where the
     value is made. A literal written inside a loop stores into the same slot
     each time round, so each value is made from the locals as they were on
     its own iteration.
   - in the *lifted* frame, a slot holding the pointer, and a [Let] around the
     whole body reading each field back into the named slot the body has been
     checked against. Once, at entry, for the same reason a handler clause
     binds its condition once: what the body names is the copy and not an
     address, so nothing downstream has to know an environment exists.

   Both new slots are nameless, which is how the break loop is told to hide
   them: a reader wants the captured copies, and those are the named slots the
   body reads them into. Answers the prefixed body, the slot the pointer
   arrives in, the enclosing frame's binding, and the address to put in the
   value. *)
let close_over ~fname (octx : ctx) (fctx : ctx) loc =
  match fctx.caught with
  | [] -> (fun body -> body), None, None, None
  | caught ->
    let ename = "env/" ^ fname in
    let fields =
      List.map
        (fun (n, ((b : binding), _)) -> { Tast.fname = n; fty = b.bty })
        caught
    in
    jreplace fctx.env.structs ename { Tast.sname = ename; fields };
    let ety = Types.Named ename in
    let eslot = fresh_slot fctx (Types.Ptr (Types.Mut, ety)) in
    let binds =
      List.mapi
        (fun i (_, ((b : binding), slot)) ->
           let p = mk loc (Types.Ptr (Types.Mut, ety)) (Tast.Local eslot) in
           (slot, mk loc b.bty (Tast.Field (mk loc ety (Tast.Deref p), i))))
        caught
    in
    let prefix body = [ mk loc fctx.ret (Tast.Let (binds, body)) ] in
    let make =
      mk loc ety
        (Tast.Make (ename,
                    List.map
                      (fun (_, ((b : binding), _)) -> local_of loc b)
                      caught))
    in
    let mslot = fresh_slot octx ety in
    prefix, Some eslot, Some (mslot, make),
    Some (mk loc (Types.Ptr (Types.Mut, ety)) (Tast.Addr (Tast.Plocal mslot)))

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

(* Names for the value an [if let] over a plain name holds; [~] keeps them
   out of any reader's reach. *)
let held_n = ref 0

(* The read-only slice a value's storage is reached through, if there is one:
   an element of a [[const T]], a field of such an element, or an element of
   an array that is. The last slice stepped through decides, because the
   const is shallow — an element of a [[const [u8]]] is itself a writable
   [[u8]], and what it views is not the outer slice's to protect. *)
let rec const_reached (e : Tast.expr) =
  match e.Tast.e with
  | Tast.Prim (Tast.At, target :: idx) ->
    const_steps (const_reached target) target.Tast.ty (List.length idx)
  | Tast.Field (target, _) -> const_reached target
  | Tast.Deref p ->
    (match p.Tast.ty with Types.Ptr (Types.Const, _) -> Some p.Tast.ty | _ -> None)
  | _ -> None

(* [ro] after stepping [n] dimensions into [ty], the way [indexed] steps. *)
and const_steps ro (ty : Types.t) n =
  if n = 0 then ro
  else
    match ty with
    | Types.Slice (Types.Const, t) -> const_steps (Some ty) t (n - 1)
    | Types.Slice (Types.Mut, t) -> const_steps None t (n - 1)
    | Types.Array (_, t) -> const_steps ro t (n - 1)
    | _ -> ro

(* A copy of a read-only slice's elements that can be written, spelled so it
   compiles: [clone], for exactly the element types clone copies. It refuses
   elements that own storage — a copy would share their blocks — and
   elements that hold a dyn, which its allocator storage cannot root. *)
let const_copy env (e : Types.t) =
  if owning env e || holds_dyn env e then None else Some "(clone v)"

(* Whether (clone x) accepts a value of this type — the same arms the clone
   builtin takes: a Vec or a Map whose elements own nothing, or a slice whose
   elements neither own storage nor hold a dyn. *)
let clone_accepts env (t : Types.t) =
  match t with
  | Types.Vec _ | Types.Map _ -> not (region_only env t)
  | Types.Slice (_, e) -> not (owning env e || holds_dyn env e)
  | _ -> false

(* The end of clone's refusal for a container of owning elements. Pushing
   the elements themselves into a second container would copy their headers
   and share their blocks, so the advice is a copy of each element where
   clone takes one, and otherwise that there is no copy to make. *)
let insert_copies ?(loc = Loc.unknown) env (t : Types.t) =
  let elem =
    match t with
    | Types.Vec e | Types.Slice (_, e) | Types.Map (_, e) -> Some e
    | _ -> None
  in
  match elem with
  | Some e when clone_accepts env e ->
    "Build a second container and push a (clone x) of each element into it"
  | Some e ->
    Printf.sprintf
      "Nothing copies what a %s owns either, so read the elements where they \
       are"
      (tyname loc e)
  | None -> "Build a second container and insert into it"

(* A call written back out as source, for a fix that has to repeat what the
   reader wrote: names, integers and calls of those. Anything else is [None]
   and the caller says the fix in words. *)
let rec spell_form (a : Ast.expr) =
  match a.Ast.e with
  | Ast.Var v -> Some v
  | Ast.Int n -> Some (Int64.to_string n)
  | Ast.UInt (_, s) -> Some s
  | Ast.Call (f, args) ->
    let parts = List.map spell_form (f :: args) in
    if List.mem None parts then None
    else Some ("(" ^ String.concat " " (List.filter_map Fun.id parts) ^ ")")
  | _ -> None

(* A store through a read-only view: a [[const T]] or a (Ptr const T). *)
let refuse_const_place env loc (view : Types.t) =
  match view with
  | Types.Ptr (_, ((Types.Vec _ | Types.Map _) as t)) ->
    Loc.failk "check/store-through-const" loc
      "this changes the %s behind a %s, which can only be read through. A \
       container that has to change is handed over as a (Ptr %s)"
      (tyname loc t) (tyname loc view) (tyname loc t)
  | Types.Ptr (_, t) ->
    Loc.failk "check/store-through-const" loc
      "this writes through a %s, which can only be read, so what it points at \
       is a value and not a place. (deref p) copies the %s out, and the copy \
       can be written"
      (tyname loc view) (tyname loc t)
  | _ ->
    let elem = match view with Types.Slice (_, t) -> t | t -> t in
    Loc.failk "check/store-through-const" loc
      "this writes through a %s, which can only be read, so the element is a \
       value and not a place. %s"
      (tyname loc view)
      (match const_copy env elem with
       | Some c ->
         Printf.sprintf
           "Write into a slice that can be written: %s copies v's elements \
            into one" c
       | None ->
         Printf.sprintf "Where it has to be written, take it as a [%s] instead"
           (tyname loc elem))

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

   TODO.org, "The allocation registry".

   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 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 — use embed-dir for one of those"
        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 (Types.Mut, e.Tast.ty)) (Tast.Prim (Tast.AddrOf, [ e ]))

(* ── A frame slot for a rendered number ────────────────────────────────

   The printer and the prelude's number appends render a number into a
   buffer that is the caller's, one frame slot per call site, and write or
   copy it out before the next; i64->bytes and f64->bytes elsewhere answer
   text in the temp allocator instead. The slot 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.Mut, (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)) ])) ]))

(* ── An Allocator value, made and used ─────────────────────────────────
   A value is two words, flan_rt.c's [flan_alloc_value]: the runtime's
   allocator record and the incarnation of it the value was made for, which
   arena-destroy bumps. Every runtime operation takes the bare record, typed
   [raw_alloc] here; [seal_alloc] makes a value from one and [use_alloc] opens
   one, trapping if the incarnation has moved. So a value kept past its arena's
   destroy traps at its next use, including after arena-new has taken the
   record back for another arena — which a one-word value could not tell from
   the new arena's own. Both cross through the value's address, since nothing
   the runtime answers or takes is a struct by value. *)
let raw_alloc = Types.Ptr (Types.Mut, Types.Unit)

let seal_alloc ctx loc (record : Tast.expr) =
  let s = fresh_slot ctx Types.Alloc in
  mk loc Types.Alloc
    (Tast.Let
       ([ (s, mk loc Types.Alloc (Tast.Zero Types.Alloc)) ],
        [ rt loc Types.Unit "flan_alloc_seal"
            [ record; addr_of loc (mk loc Types.Alloc (Tast.Local s)) ];
          mk loc Types.Alloc (Tast.Local s) ]))

let use_alloc ctx loc (v : Tast.expr) =
  let s = fresh_slot ctx Types.Alloc in
  mk loc raw_alloc
    (Tast.Let
       ([ (s, v) ],
        [ rt loc raw_alloc "flan_alloc_use"
            [ addr_of loc (mk loc Types.Alloc (Tast.Local s)); here loc ] ]))

(* A string literal handed to a [declare-c] function goes to C without the copy
   the wrapper makes of any other string. Both backends write a NUL after a
   literal's bytes, and here — the one place that knows the argument is a
   literal — it is passed with its length encoded as -(n+1) by
   [flan_c_literal]. No other Flan string has a negative length, so the
   wrapper can tell ([Shim.cstr_helpers]); a string that merely ends in a NUL
   is still copied and refused.

   The callee is a declare-c when it binds the shim's symbol for its own name —
   directly, or through the flattened [-c] declaration the shim puts under a
   Flan wrapper. The encoded value passes through that wrapper untouched,
   because its body only forwards it. *)
let c_literals ctx name (params : Types.t list) (args : Tast.expr list) =
  let sym = Shim.shim_symbol name in
  let bound n = Hashtbl.find_opt ctx.env.externs n = Some sym in
  if not (bound name || bound (Shim.raw_name name)) then args
  else
    List.map2
      (fun (p : Types.t) (a : Tast.expr) ->
         match p, a.Tast.e with
         | Types.String, Tast.Str _ ->
           let loc = a.Tast.loc in
           let s = fresh_slot ctx Types.String in
           mk loc Types.String
             (Tast.Let
                ([ (s, mk loc Types.String (Tast.Zero Types.String)) ],
                 [ rt loc Types.Unit "flan_c_literal"
                     [ a; addr_of loc (mk loc Types.String (Tast.Local s)) ];
                   mk loc Types.String (Tast.Local s) ]))
         | _ -> a)
      params args

(* ── 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 [(defonce 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

(* A condition type and every type it names as a parent, own first. The chain
   is static: a signal site knows its condition's type, so the whole walk a
   handler match makes is written into the site's descriptor, and the runtime
   only compares numbers. [collect] has refused a cycle, but the walk stops at
   one anyway rather than trusting that it ran. *)
let condition_chain env name =
  let rec go seen n =
    if List.mem n seen then List.rev seen
    else
      match Hashtbl.find_opt env.parents n with
      | Some p -> go (n :: seen) p
      | None -> List.rev (n :: seen)
  in
  go [] name

(* 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) ^ ")"

(* ── The dyn boundary ───────────────────────────────────────────────────

   Typed to dyn is implicit and dyn to typed is not. That asymmetry is the
   whole of the design and it is worth saying why it is not arbitrary.

   Boxing loses nothing: the value goes in and the runtime records what it was.
   It can happen anywhere a dyn is wanted without a reader being surprised,
   because nothing about the program's meaning turns on it. Unboxing can fail,
   at run time, on a value the compiler cannot inspect -- so it happens only
   where somebody *wrote a type*: a typed parameter, a typed binding, a typed
   field. Those are the places a reader already understands as a claim about
   what a value is, and a claim that can be wrong is exactly what a trap is
   for. Nowhere else does the compiler decide a dyn is an i64 on its own.

   Both directions go through [expect], because [expect] is already the one
   place a wanted type meets a produced one. Every site that annotates -- and
   only those sites -- calls it with [~want].

   Milestone 1 boxes the scalars and refuses everything else by name. A typed
   container crossing into dyn is the interesting refusal: [(Vec i64)] has a
   representation the dyn runtime does not know how to walk, and heterogeneity
   at milestone 1 is served by the runtime's own vector behind
   [flan_dyn_vec_new] instead. That is a "not yet" and says so. *)

let dyn_i64 = Types.Int Types.I64
let dyn_f64 = Types.Float Types.F64

(* The switch the unfinished half of TODO.org's "Dyn unless annotated" is
   measured with: [dyn] makes an unwanted text or bracket literal dyn (a
   let-bound one stays typed when a use wants it, [lit_session]), and [log]
   prints each literal local inference moved off its default. Deleted when
   that half lands. *)
let lit_mode = try Sys.getenv "FLAN_LIT" with Not_found -> ""
let lit_has m = List.mem m (String.split_on_char ',' lit_mode)
(* An unconstrained float literal is an f64 (decision 121); it is an f32 only
   where typed code wants one. *)
let float_default () = Types.F64

(* ── Literal locals ([lit_session]) ────────────────────────────────── *)

(* The literal a [let] or [loop] initialiser is, when its type is to be read
   off the uses: a number or a character, negated or not. A bool has one type
   and a wide literal one (u64), so neither has anything to infer. *)
let lit_kind (e : Ast.expr) =
  match e.Ast.e with
  | Ast.Int _ -> Some `Int
  | Ast.Byte _ -> Some `Char
  | Ast.Float _ -> Some `Float
  | Ast.Call ({ Ast.e = Ast.Var "-"; _ }, [ { Ast.e = Ast.Int _; _ } ]) -> Some `Int
  | Ast.Call ({ Ast.e = Ast.Var "-"; _ }, [ { Ast.e = Ast.Float _; _ } ]) -> Some `Float
  | Ast.Str _ | Ast.Arr (_ :: _) when lit_has "dyn" -> Some `Box
  | _ -> None

(* What the literal is with no use to say otherwise. *)
(* A text or bracket literal ([`Box]) is dyn, or with a typed use its typed
   reading; [Types.Unit] stands for "typed" in [decided], since the typed
   reading is the literal's own and not one a use names. *)
let lit_default (_ : Ast.expr) = function
  | `Int -> Types.Int Types.I32
  | `Char -> Types.Char
  | `Float -> Types.Float (float_default ())
  | `Box -> Types.Dyn

(* The types a use can give it: any number for an integer or a character,
   since an untyped integer constant is usable where a float is wanted, and
   only a float for a float. A character may also be a char, its own type. A type variable is admitted and left to
   [int_literal] to judge against its bound. Anything else — dyn, a struct —
   says nothing about the literal's type; the local keeps its guess and the
   use is checked as it always was. *)
let lit_admits kind (t : Types.t) =
  match kind, t with
  | (`Int | `Char), (Types.Int _ | Types.Float _ | Types.Var _) -> true
  | `Char, Types.Char -> true
  | `Float, (Types.Float _ | Types.Var _) -> true
  | `Box, t -> not (Types.equal t Types.Dyn)
  | _ -> false

(* What a use at [t] says about a literal local: an (Option T) wanted of it
   says T, since the local is built at T and then wrapped (decision 138), so
   [let w: i64? = x] makes [x] the i64 [let w: i64 = x] does. *)
let rec lit_payload (t : Types.t) =
  match t with Types.Option p -> lit_payload p | t -> t

(* The rounds a session may take before its last guesses are checked as
   they stand. Merging makes two the usual count; the bound only stops a
   pathological program from looping. *)
let lit_rounds = 8

let lit_id (s : lit_session) (key : Ast.expr) = Phys.find_opt s.ids key

let rec lit_root (s : lit_session) i =
  match Hashtbl.find_opt s.parent i with
  | Some p when p <> i ->
    let r = lit_root s p in
    Hashtbl.replace s.parent i r;
    r
  | _ -> i

let lit_add (s : lit_session) key c =
  match lit_id s key with Some i -> Hashtbl.add s.cons i c | None -> ()

let lit_union (s : lit_session) a b =
  match lit_id s a, lit_id s b with
  | Some i, Some j ->
    let ri = lit_root s i and rj = lit_root s j in
    if ri <> rj then Hashtbl.replace s.parent (max ri rj) (min ri rj)
  | _ -> ()

(* What earlier sessions decided, while an outermost one is open. An outer
   session that checks its form again checks every lambda inside it again,
   and each of those opens a session of its own; starting that one from its
   last answer makes it settle in one round, where starting from the default
   made nested lambdas cost a factor per level. Keyed by the node and the
   type variables' bindings, since a generic's body is one node checked at
   several types. Only ever a first guess: a wrong one costs a round. *)
let lit_depth = ref 0
let lit_memo : ((string * Types.t) list * Types.t) list Phys.t = Phys.create 64

let lit_guess ~subst (s : lit_session) key kind =
  match Phys.find_opt s.decided key with
  | Some t -> t
  | None ->
    let same (sb, _) =
      List.equal (fun (a, t) (b, u) -> String.equal a b && Types.equal t u) sb subst
    in
    match Option.bind (Phys.find_opt lit_memo key) (List.find_opt same) with
    | Some (_, t) -> t
    | None -> lit_default key kind

(* Each literal local this round bound, with the type its group's uses decide
   or the first pair of uses no one type satisfies. Linear in locals and
   uses. *)
let lit_solve (s : lit_session) =
  let keys = Array.of_list (List.rev s.keys) in
  let n = Array.length keys in
  let root = Array.init n (lit_root s) in
  let members = Array.make n [] in
  for i = n - 1 downto 0 do members.(root.(i)) <- i :: members.(root.(i)) done;
  let widens a b = Types.equal a b || Types.widens_to ~from:a ~into:b in
  let result = Array.make n (Ok Types.Unit) in
  Array.iteri
    (fun r ms ->
       if ms <> [] then begin
         let kinds = List.map (fun m -> Option.value (lit_kind (fst keys.(m))) ~default:`Int) ms in
         let kind =
           if List.mem `Box kinds then `Box
           else if List.mem `Float kinds then `Float
           else if List.mem `Int kinds then `Int
           else `Char
         in
         let dyn_width =
           match kind with `Float -> Types.Float Types.F64 | _ -> Types.Int Types.I64
         in
         let cons =
           List.concat_map (fun m -> List.rev (Hashtbl.find_all s.cons m)) ms
           |> List.filter_map (fun (c, t, l) ->
               (* A character meeting dyn stays a char, which crosses as
                  a dyn char; a number takes the dyn width. *)
               if kind = `Char && Types.equal t Types.Dyn then None
               else if kind <> `Box && Types.equal t Types.Dyn then Some (Hint, dyn_width, l)
               else if lit_admits kind t then Some (c, t, l)
               else None)
         in
         let pick c = List.filter_map (fun (c', t, l) -> if c' = c then Some (t, l) else None) cons in
         let res =
           if kind = `Box then Ok (if cons = [] then Types.Dyn else Types.Unit)
           else
             let ups = pick Up and downs = pick Down and hints = pick Hint in
             match ups with
             | (u0, l0) :: _ ->
               (match List.find_opt (fun (u, _) -> List.for_all (fun (u', _) -> widens u u') ups) ups with
                | None ->
                  let (u1, l1) = List.find (fun (u, _) -> not (widens u u0 || widens u0 u)) ups in
                  Error ((u0, l0), (u1, l1))
                | Some (c, lc) ->
                  (match List.find_opt (fun (d, _) -> not (widens d c)) downs with
                   | None -> Ok c
                   | Some (d, ld) -> Error ((c, lc), (d, ld))))
             | [] ->
               (match downs @ hints with
                | [] ->
                  (* No use names a type: the widest of the members' own. *)
                  Ok (List.fold_left
                        (fun acc m ->
                           let t = lit_default (fst keys.(m)) kind in
                           match Types.join acc t with Some j -> j | None -> acc)
                        (lit_default (fst keys.(r)) kind) ms)
                | (t0, l0) :: rest ->
                  let rec fold (t, l) = function
                    | [] -> Ok t
                    | (t', l') :: rest ->
                      (match Types.join t t' with
                       | Some j -> fold ((j, if Types.equal j t then l else l')) rest
                       | None -> Error ((t, l), (t', l')))
                  in
                  fold (t0, l0) rest)
         in
         List.iter (fun m -> result.(m) <- res) ms
       end)
    members;
  Array.to_list (Array.mapi (fun i (k, name) -> (k, name, result.(i))) keys)

(* Converting to whatever width the other side of the boundary wants, with a
   [Cast] and not a silent reinterpretation. The name is for the direction it
   was written for: runtime/flan_dyn.h boxes integers as [i64] and floats as
   [f64] and offers no other width, so *into* a box this only ever widens, and
   a widening cast loses nothing.

   Coming back *out* it is used in both directions, and that is deliberate:
   [cast_dyn] below unboxes to [i64]/[f64] and then hands the value to this to
   reach the cast's target, which may be narrower ([(i32 d)]) or a different
   kind ([(f32 d)]). Nothing is lost quietly there either — the [Cast] emitted
   is the same node [(i32 x)] on a typed value emits, so the narrowing rule,
   the fptosi range check and NaN are the emitter's, identical to the typed
   spelling. This helper picks the node; it does not promise the conversion is
   free. *)
let widen loc (want : Types.t) (e : Tast.expr) =
  if Types.equal want e.Tast.ty then e
  else mk loc want (Tast.Prim (Tast.Cast want, [ e ]))

(* The sentence a refusal at this boundary gives. It names the type and says
   which direction failed, because "expected dyn, found (Vec i64)" would read
   as a type error the programmer could fix by writing something else, and
   there is nothing else to write -- the feature is not there yet. *)
let no_dyn_yet loc ~into t extra =
  Loc.failk "check/dyn-not-yet" loc
    "%s does not cross into %s yet%s"
    (tyname loc t) (if into then "dyn" else "a written type") extra


(* A typed container crossing into dyn is a view, and the runtime needs to
   know what one element is: its descriptor, a prefix code runtime/flan_dyn.c
   documents beside [desc_lay] and reads offsets out of by C's layout rule.
   Every number, bool, char, str, struct of those, and fixed array, slice or
   Vec of those can be described. [Error t] names the first type inside that cannot:
   a dyn, a pointer, a function, an Option, a map, an enum or a data type.
   None of those is refused for want of a descriptor letter — each is one a
   dyn value cannot be read out of or written into without a meaning
   nobody has decided. A str is read as a copy and never written, since a
   dyn text is a collector pointer and typed storage is never scanned; a
   [const] slice is refused because a dyn view can be written through. One
   is described only [~into] a written type ([into_typed]), as [c]. *)
let rec view_desc ?(into = false) structs (t : Types.t)
  : (string, Types.t) result =
  let view_desc = view_desc ~into in
  let ( let* ) = Result.bind in
  match t with
  | Types.Int k ->
    Ok (match k with
        | Types.I8 -> "b" | Types.U8 -> "B" | Types.I16 -> "h" | Types.U16 -> "H"
        | Types.I32 -> "i" | Types.U32 -> "I" | Types.I64 -> "l" | Types.U64 -> "L")
  | Types.Float Types.F32 -> Ok "f"
  | Types.Float Types.F64 -> Ok "d"
  | Types.Bool -> Ok "?"
  | Types.Char -> Ok "C"
  | Types.String -> Ok "t"
  | Types.Array (n, e) ->
    let* d = view_desc structs e in
    Ok (Printf.sprintf "a%Ld;%s" n d)
  | Types.Slice (Types.Mut, e) -> let* d = view_desc structs e in Ok ("s" ^ d)
  | Types.Slice (Types.Const, e) when into ->
    let* d = view_desc structs e in Ok ("c" ^ d)
  | Types.Vec e -> let* d = view_desc structs e in Ok ("v" ^ d)
  | Types.Named n ->
    (match Hashtbl.find_opt structs n with
     | None -> Error t
     | Some st ->
       let* fs =
         List.fold_left
           (fun acc (fl : Tast.field) ->
              let* acc = acc in
              let* d = view_desc structs fl.Tast.fty in
              Ok ((fl.Tast.fname ^ ";" ^ d) :: acc))
           (Ok []) st.Tast.fields
       in
       Ok ("{" ^ n ^ ";" ^ String.concat "" (List.rev fs) ^ "}"))
  | _ -> Error t

(* A fix is spelled in the syntax of the file the mistake is in: the checker
   sees one AST for both, so the location's file is the only thing left that
   says which one the reader is looking at. *)
let fln_source (loc : Loc.t) = Source.indented_at loc

(* A version's own name: see [split_versions]. *)
let version_name base arity = base ^ "~" ^ string_of_int arity

(* The name as written and the arity, for a name [version_name] made. *)
let version_of n =
  match String.rindex_opt n '~' with
  | Some i when i > 0 && i < String.length n - 1 ->
    let tail = String.sub n (i + 1) (String.length n - i - 1) in
    if String.for_all (fun c -> c >= '0' && c <= '9') tail then
      Some (String.sub n 0 i, int_of_string tail)
    else None
  | _ -> None

(* A name as its reader wrote it: a version's is the name it is a version of,
   which is what every message about it says. *)
let written_name n =
  match version_of n with
  | Some (b, _) -> b
  | None ->
    (* A generic version's copy, [pick~3-f64], is the copy [pick-f64]. *)
    match String.rindex_opt n '~' with
    | Some i when i > 0 ->
      let j = ref (i + 1) in
      while !j < String.length n && n.[!j] >= '0' && n.[!j] <= '9' do incr j done;
      if !j > i + 1 && !j < String.length n && n.[!j] = '-' then
        String.sub n 0 i ^ String.sub n !j (String.length n - !j)
      else n
    | _ -> n

(* Which form defined each mutable global, [defonce] or [def], so a fix that
   rewrites the definition keeps the form the programmer chose. Filled where
   globals are collected; a name missing from it (a defconst) is given
   [defonce]. *)
let global_forms : (string, Ast.reinit) Hashtbl.t = Hashtbl.create 16

(* The function being checked and its parameters, by slot. A stack because
   a generic's copy is checked from inside the body that called it. *)
let grow_params : (ctx * (int * Ast.field) list) list ref = ref []

(* The two refusals below share their subject and their fix. The subject is
   the name as written when the refused value is a bare name, so the message
   can say [a is a [4 i64]]; anything longer is "this". The fix is the one
   spelling that works for every container either refusal reaches, whatever
   its element type or wherever it lives: make it a dyn value where it is
   built, and there is no view to refuse. *)
let view_subject (e : Tast.expr) =
  match Loc.snippet e.Tast.loc with
  | Some s
    when s <> ""
         && String.for_all
              (fun c -> not (List.mem c [ ' '; '('; ')'; '['; ']'; '{'; '}'; '"'; '.'; ',' ]))
              s ->
    Some s
  | _ -> None

let view_refusal kind loc (e : Tast.expr) reason =
  let ty = tyname loc e.Tast.ty in
  let fln = fln_source loc in
  (* A parameter is made by the caller, so its fix is its declaration. The
     name is compared as well as the slot: a closure numbers its slots from
     zero too, and is checked while its enclosing function is on the stack. *)
  let param =
    match e.Tast.e, view_subject e, !grow_params with
    | Tast.Local s, Some n, (ctx, ps) :: _ ->
      (match List.assoc_opt s ps with
       | Some (p : Ast.field) when p.Ast.fname = n -> Some (ctx.owner, n)
       | _ -> None)
    | _ -> None
  in
  let subject, fix =
    match param, view_subject e with
    | Some (f, n), _ ->
      ( Printf.sprintf "%s is a %s parameter" n ty,
        Printf.sprintf "Declare %s as dyn in %s's parameters: %s%s" n f n
          (if fln then ": dyn" else " dyn") )
    | None, Some n when (match e.Tast.e with Tast.Global _ -> true | _ -> false) ->
      let every =
        match e.Tast.e with
        | Tast.Global g -> Hashtbl.find_opt global_forms g = Some Ast.Every
        | _ -> false
      in
      ( Printf.sprintf "%s is a %s" n ty,
        Printf.sprintf "Define %s as a dyn value, as in %s" n
          (if fln then
             Printf.sprintf "%s %s: dyn = [...]" (if every then "def" else "once") n
           else
             Printf.sprintf "(%s %s dyn [...])" (if every then "def" else "defonce") n) )
    | None, Some n ->
      ( Printf.sprintf "%s is a %s" n ty,
        Printf.sprintf "Build %s as a dyn value where it is made, as in %s" n
          (if fln then Printf.sprintf "let %s: dyn = [...]" n
           else Printf.sprintf "(let [%s (the dyn [...])] ...)" n) )
    | None, None ->
      ( Printf.sprintf "This is a %s" ty,
        Printf.sprintf "Build it as a dyn value where it is made, as in %s"
          (if fln then "the(dyn, [...])" else "(the dyn [...])") )
  in
  Loc.failk kind loc "%s, and a dyn value is wanted here. %s. %s" subject
    reason fix

let view_not_yet loc (e : Tast.expr) (inner : Types.t) =
  view_refusal "check/dyn-not-yet" loc e
    (Printf.sprintf
       "A dyn value sees into numbers, bools, str and structs, and arrays, \
        slices and Vecs of those; a %s is none of these"
       (tyname loc inner))

(* Whether a view's storage is the current function's own frame, which is
   what the runtime's dev check needs to be told: it then records this
   activation and traps if the view is used after the call returns. A local,
   a parameter (copied into the frame, an array parameter too), a field or
   an array element of one, a slice cut directly from a local array, and a
   temporary [box] has bound to a slot of its own are all the frame's. For
   anything else — a slice's data, a [Ptr]'s target, a global — the dev
   runtime finds the frame that owns a stack address by the address itself,
   or else the registry block that holds it. *)
let rec frame_root (e : Tast.expr) : bool =
  let rec all_array ty = function
    | [] -> true
    | _ :: rest ->
      (match ty with Types.Array (_, elem) -> all_array elem rest | _ -> false)
  in
  match e.Tast.e with
  | Tast.Local _ -> (match e.Tast.ty with Types.Slice _ -> false | _ -> true)
  | Tast.Field (target, _) ->
    (match target.Tast.ty with Types.Named _ -> frame_root target | _ -> false)
  | Tast.Prim (Tast.At, target :: idx) ->
    all_array target.Tast.ty idx && frame_root target
  | Tast.Prim (Tast.Slice, [ target; _; _ ]) ->
    (match target.Tast.ty with Types.Array _ -> frame_root target | _ -> false)
  | _ -> false

(* Whether [e] names storage that already has an address, so a view can
   point at it; anything else is a temporary [box] binds to a slot first. *)
let rec view_place (e : Tast.expr) : bool =
  match e.Tast.e with
  | Tast.Local _ | Tast.Global _ | Tast.Deref _ -> true
  | Tast.Field (target, _) ->
    (match target.Tast.ty with Types.Named _ -> view_place target | _ -> true)
  | Tast.Prim (Tast.At, _ :: _ :: _) -> true
  | _ -> false

(* A value handed out of [f] that points into [f]'s own frame: returned (the
   last form's tails, or a [return]), or stored into a global or a field or
   array element of one. Both read a dead frame the moment [f] returns, so
   both are refused.

   Deliberately narrow — the exact spellings that can only be wrong, so
   nothing that could be valid is ever refused:
   - [(addr p)] where [p] is a local, a field of one, or an element of a
     local *array* (an array's elements are the frame's bytes; a Vec's or a
     slice's are not);
   - [(slice a …)] where [a] is such a place of array type;
   - a local bound by [let] to one of those and never assigned or addressed
     afterwards, which is also how a [return] under a [defer] arrives here.
   A parameter is a local: its value is copied into the frame (an array
   parameter too), so its address dies with the frame as well. Anything
   reached through a [Ptr] is not the frame's, and a struct literal holding
   such an address is not looked into.

   The store is let through in [main], whose frame outlives everything the
   program runs.

   A lifted [fn] literal or handler clause is checked as a function of its
   own: its parameters, its locals and its copies of what it captured are its
   frame. What this does not see is the enclosing function's frame escaping
   *through* one — a closure over a pointer to a local, handed out — because
   that is a value holding an address, not one of the spellings above. *)
let refuse_frame_escapes (f : Tast.fn) =
  (* Keyed by slot alone: [fresh_slot] never reuses one, so a slot has at
     most one binding [Let] in the function. *)
  let binds = Hashtbl.create 16 in
  let unstable = Hashtbl.create 16 in
  (* A place a global owns, and so one that outlives every frame: the global,
     a field or array element of it, or an element of a Vec it holds — the
     Vec's block is the global's for as long as the global keeps it. A slice
     is not stepped through: its storage may be anyone's. *)
  let rec place_global = function
    | Tast.Pglobal g -> Some g
    | Tast.Pfield (t, _) -> expr_global t
    | Tast.Pindex (t, idx) when owned_levels t.Tast.ty idx -> expr_global t
    (* [(set (at v i) x)] on a Vec is a store through the checked element
       address [vec_at] builds. Any other pointer's target is not known to
       be the global's. *)
    | Tast.Pderef { Tast.e = Tast.Prim (Tast.Rt "flan_vec_at", t :: _); _ } ->
      expr_global t
    | _ -> None
  and expr_global (e : Tast.expr) =
    match e.Tast.e with
    | Tast.Global g -> Some g
    | Tast.Field (t, _) -> expr_global t
    | Tast.Prim (Tast.At, t :: idx) when owned_levels t.Tast.ty idx ->
      expr_global t
    | _ -> None
  and owned_levels ty = function
    | [] -> true
    | _ :: rest ->
      (match ty with
       | Types.Array (_, el) | Types.Vec el -> owned_levels el rest
       | _ -> false)
  (* [(at a i j)] is one node carrying every index; each level stepped must
     be an array for the element to be inside [a]'s own bytes. *)
  and all_array ty = function
    | [] -> true
    | _ :: rest ->
      (match ty with Types.Array (_, el) -> all_array el rest | _ -> false)
  in
  List.iter
    (Tast.walk (fun (e : Tast.expr) ->
         match e.Tast.e with
         | Tast.Let (bs, _) -> List.iter (fun (s, v) -> Hashtbl.replace binds s v) bs
         | Tast.Set (Tast.Plocal s, _) | Tast.Addr (Tast.Plocal s) ->
           Hashtbl.replace unstable s ()
         | _ -> ()))
    f.Tast.body;
  (* The local at the root of a place inside this frame, if it is one. *)
  let rec root_expr (e : Tast.expr) =
    match e.Tast.e with
    | Tast.Local s -> Some s
    | Tast.Field (t, _) -> root_expr t
    | Tast.Prim (Tast.At, t :: idx) when all_array t.Tast.ty idx -> root_expr t
    | _ -> None
  in
  let root_place = function
    | Tast.Plocal s -> Some s
    | Tast.Pfield (t, _) -> root_expr t
    | Tast.Pindex (t, idx) when all_array t.Tast.ty idx -> root_expr t
    | _ -> None
  in
  (* What escapes: the root local, whether it is a slice (else an address),
     and whether the place is the bare local rather than a path into it —
     only then can the fix be spelled with its name alone. *)
  let rec escapes depth (e : Tast.expr) =
    match e.Tast.e with
    | Tast.Addr p ->
      Option.map
        (fun s ->
           (e, (s, `Addr, (match p with Tast.Plocal _ -> true | _ -> false))))
        (root_place p)
    | Tast.Prim (Tast.Slice, [ t; _; _ ]) ->
      (match t.Tast.ty with
       | Types.Array _ ->
         Option.map
           (fun s ->
              ( e,
                (s, `Slice,
                 (match t.Tast.e with Tast.Local _ -> true | _ -> false)) ))
           (root_expr t)
       | _ -> None)
    | Tast.Local s when depth < 32 && not (Hashtbl.mem unstable s) ->
      Option.bind (Hashtbl.find_opt binds s) (escapes (depth + 1))
    | _ -> None
  in
  (* A slot with no name is a value the function made for itself, such as
     the array a literal like [(slice [7 8 9])] is stored in. *)
  (* What a lifted body is called in a message: its symbol is the compiler's. *)
  let who =
    let starts p =
      String.length f.Tast.name >= String.length p
      && String.sub f.Tast.name 0 (String.length p) = p
    in
    if starts "fn/" then "this fn"
    else if starts "handler/" then "this handler"
    else f.Tast.name
  in
  let what (s, kind, exact) =
    match f.Tast.snames.(s), kind, exact with
    | Some n, `Slice, true -> "a slice of " ^ n
    | Some n, `Slice, false -> "a slice of an array inside " ^ n
    | Some n, `Addr, true -> "the address of " ^ n
    | Some n, `Addr, false -> "an address inside " ^ n
    | None, `Slice, _ -> "a slice of a temporary array"
    | None, `Addr, _ -> "the address of a temporary"
  in
  (* Reported at the addr or slice itself: a [return] under a [defer], or a
     local bound to one, reaches here as a read of a slot, and the caret
     belongs on the form that took the address. *)
  let fail ~verb ~target ~fix_slice ~fix_addr
      ((e : Tast.expr), ((s, kind, exact) as hit)) =
    let fix =
      (* The slice as written, bounds and all, when the source can be read
         back; its root's name otherwise. *)
      let rec bound (b : Tast.expr) =
        match b.Tast.e with
        | Tast.Int (v, _) -> Some (Int64.to_string v)
        | Tast.Local i -> f.Tast.snames.(i)
        | Tast.Prim (Tast.Cast _, [ x ]) -> bound x
        | _ -> None
      in
      let rebuilt =
        match e.Tast.e, f.Tast.snames.(s), exact with
        | Tast.Prim (Tast.Slice, [ t; lo; hi ]), Some n, true ->
          (match t.Tast.ty, bound lo, bound hi with
           | Types.Array (len, _), Some "0", Some h
             when h = Int64.to_string len ->
             Some ("(slice " ^ n ^ ")")
           | _, Some l, Some h -> Some ("(slice " ^ n ^ " " ^ l ^ " " ^ h ^ ")")
           | _ -> None)
        | _ -> None
      in
      let written =
        match rebuilt, Loc.snippet ~lim:120 e.Tast.loc with
        | Some t, _ -> Some t
        | None, Some t
          when String.length t > 7 && String.sub t 0 7 = "(slice "
               && not (String.contains t '\n')
               && not (String.ends_with ~suffix:"\xe2\x80\xa6" t) -> Some t
        | _ -> None
      in
      match written, f.Tast.snames.(s), kind, exact with
      | Some t, _, `Slice, _ ->
        fix_slice ("wrap the slice in clone, as in (clone " ^ t ^ ")")
      | None, Some n, `Slice, true ->
        fix_slice ("wrap the slice in clone, as in (clone (slice " ^ n ^ "))")
      | _, _, `Slice, _ -> fix_slice "wrap the slice in (clone ...)"
      | _, _, `Addr, _ ->
        let pointee =
          match e.Tast.ty with
          | Types.Ptr (_, t) -> tyname e.Tast.loc t
          | t -> tyname e.Tast.loc t
        in
        fix_addr pointee
    in
    let whose =
      match f.Tast.snames.(s) with
      | Some n -> Printf.sprintf "%s is a local of %s" n who
      | None -> "That value lives in the frame of " ^ who
    in
    Loc.failk "check/frame-escape" e.Tast.loc
      "%s %s %s%s. %s, and its storage is gone once %s returns, so every \
       later read through it reads whatever the next call leaves there. %s"
      (if String.equal who f.Tast.name then who
       else String.capitalize_ascii who)
      verb (what hit) target whose who fix
  in
  (* Every value position of the body, walked by [Tast.iter_tails]: a
     restart clause is a branch of this function whose value is the form's
     value when that restart is taken, and it is on that list. *)
  let tails =
    Tast.iter_tails (fun (e : Tast.expr) ->
      Option.iter
        (fail ~verb:"returns" ~target:""
           ~fix_slice:(fun c ->
               "Return a copy the caller owns: " ^ c
               ^ ", which puts the elements in the context allocator")
           ~fix_addr:(fun t ->
               if String.equal who f.Tast.name then
                 "Return the value instead: declare " ^ who
                 ^ " to return " ^ t ^ " and drop the addr"
               else
                 "Return the value, of type " ^ t
                 ^ ", instead of its address: drop the addr"))
        (escapes 0 e))
  in
  (* Only a store into the global itself can be fixed by changing the
     global's type; for a field, an element or a push, the value's type
     belongs to something else. *)
  let stored ~bare g v =
    Option.iter
      (fail ~verb:"stores" ~target:(" into the global " ^ g)
         ~fix_slice:(fun c ->
             "Store a copy that outlives the frame: " ^ c
             ^ ", which puts the elements in the context allocator")
         ~fix_addr:(fun t ->
             if bare then
               "Store the value instead: declare " ^ g ^ " as " ^ t
               ^ " and drop the addr"
             else "Store the value instead of its address"))
      (escapes 0 v)
  in
  let returns = not (Types.equal f.Tast.ret Types.Unit) in
  List.iter
    (Tast.walk (fun (e : Tast.expr) ->
         match e.Tast.e with
         | Tast.Return (Some v) when returns -> tails v
         | Tast.Set (p, v) when not (String.equal f.Tast.name "main") ->
           Option.iter
             (fun g ->
                stored ~bare:(match p with Tast.Pglobal _ -> true | _ -> false)
                  g v)
             (place_global p)
         (* A push or put into a container a global owns: the element was
            bound to a slot first, and its address is what the call takes. *)
         | Tast.Prim (Tast.Rt ("flan_vec_push" | "flan_map_put"), target :: rest)
           when not (String.equal f.Tast.name "main") ->
           Option.iter
             (fun g ->
                List.iter
                  (fun (a : Tast.expr) ->
                     match a.Tast.e with
                     | Tast.Prim (Tast.AddrOf, [ v ]) -> stored ~bare:false g v
                     | _ -> ())
                  rest)
             (expr_global target)
         | _ -> ()))
    f.Tast.body;
  if returns then
    match List.rev f.Tast.body with x :: _ -> tails x | [] -> ()

(* ── String, the prelude's owned text ────────────────────────────────
   A (defstruct String [bytes (Vec u8)]) in the prelude, kept valid UTF-8 by
   the arms in [named_call] that are the only way to change one — see
   [string_call]. Every run-time operation reaches the Vec, which is the
   struct's one field: the backends see a struct holding a Vec and nothing
   else, which is why neither has a String of its own. *)
let string_ty = Types.Named "String"
let is_string_ty t = Types.equal t string_ty
let string_vec_ty = Types.Vec (Types.Int Types.U8)
let u8_ty = Types.Int Types.U8
let string_or_ptr t =
  match t with
  | Types.Ptr (_, t) -> is_string_ty t
  | t -> is_string_ty t

(* The String's (Vec u8), through a pointer to one too. *)
let string_vec loc (s : Tast.expr) =
  let s =
    match s.Tast.ty with
    | Types.Ptr (_, t) when is_string_ty t -> mk loc t (Tast.Deref s)
    | _ -> s
  in
  mk loc string_vec_ty (Tast.Field (s, 0))

let box ?ctx loc (e : Tast.expr) : Tast.expr =
  let dyn sym args = rt loc Types.Dyn sym args in
  let structs =
    match ctx with Some c -> c.env.structs | None -> !view_structs
  in
  match e.Tast.ty with
  | Types.Dyn -> e
  (* Dyn text is immutable and a String is not, so a String crosses as a copy
     of its bytes rather than as the view any other struct would be. *)
  | t when is_string_ty t -> dyn "flan_dyn_from_string" [ string_vec loc e ]
  (* A dyn int is an i64, so a u64 past the largest i64 has none to become:
     read as its bits it would be a different, negative number. It traps
     here, at the crossing, as one read through a view does. *)
  | Types.Int Types.U64 -> dyn "flan_dyn_from_u64" [ e; here loc ]
  | Types.Int _ -> dyn "flan_dyn_from_i64" [ widen loc dyn_i64 e ]
  | Types.Float _ -> dyn "flan_dyn_from_f64" [ widen loc dyn_f64 e ]
  (* The ABI takes an [int32_t], because a C signature that says [_Bool] is a
     width argument nobody wants to have. *)
  | Types.Bool -> dyn "flan_dyn_from_bool" [ widen loc (Types.Int Types.I32) e ]
  (* A typed char stays a char on the dyn side (decision 127). *)
  | Types.Char -> dyn "flan_dyn_from_char" [ widen loc (Types.Int Types.I32) e ]
  (* A string is ptr+len and arrives as two arguments, the way every other
     (ptr, len) entry point in the runtime takes one. The runtime copies: the
     bytes may be a literal or a slice of a buffer the program goes on to
     write. *)
  | Types.String -> dyn "flan_dyn_from_bytes" [ e ]
  (* Unit does not box. A value of the zero-sized type carries nothing for a
     dyn word to hold, and [nil] -- the absent dyn value, writable as the
     literal [nil] -- is a different thing with a different constructor. The
     two get confused if unit is allowed to become one. *)
  | Types.Unit ->
    Loc.failk "check/dyn-unit" loc
      "() does not box into dyn. The absent dyn value is nil — write nil"
  | Types.Never -> e
  (* A [$t] is seen only in a generic's abstract pass; each copy is checked
     again at its concrete type, where the value boxes as that type does, and
     this node is thrown away with the rest of the pass. Admitting it is sound
     only when every type the variable can be at crosses, or a refusal would
     move from the definition to whichever call instantiates it at a pointer,
     an enum or a function, with no written requirement to blame — the rule
     beside [println]'s deferral. Every [is-numeric] type crosses (a u64 past
     the largest i64 traps at run time, not at a copy's check), so that bound
     admits it. [is-ordered] and [is-equal] do not: both admit an enum, which
     has no dyn value. The node is a cast rather than [flan_dyn_nil] because
     [is_nil_lit] would read that as a nil literal. *)
  | Types.Var v
    when (match ctx with
          | Some c -> declares c.env.tvpreds v "is-numeric"
          | None -> false) ->
    mk loc Types.Dyn (Tast.Prim (Tast.Cast Types.Dyn, [ e ]))
  | Types.Var _ ->
    let t = tyname loc e.Tast.ty in
    Loc.failk "check/dyn-type-variable" loc
      "%s may be a type with no dyn value, such as a pointer or an enum, so \
       it crosses into dyn only as a number. Write %s at the head of the body"
      t (where_text loc "is-numeric" t)
  (* A view, not a copy: the box holds a small record naming where the
     storage is and what one element is (its descriptor, [view_desc]), and
     every read or write goes straight through to the container's own
     storage — see runtime/flan_dyn.h's view section. A Vec's view points AT
     the Vec's header and reads its pointer and length live, so a push
     through the view cannot go stale; a slice and a fixed array cannot grow,
     so a snapshot taken at the crossing is sound for both. A struct's view
     is a map-like value: (get p :x), (set (get p :x) v), (put p :x v).

     A container, array or struct is handed over by address. One that is not
     a place already — a call's result — is bound to a slot of its own
     first, so the view points at storage that lives as long as the frame
     rather than at a temporary the next statement reuses. [frame_root] then
     says whether the storage is this frame's, for the runtime's dev check. *)
  | Types.Vec _ | Types.Array _ | Types.Named _ | Types.Slice (Types.Mut, _)
    when (match e.Tast.ty with
          | Types.Named n -> Hashtbl.mem structs n
          | _ -> true) ->
    let desc_of t =
      match view_desc structs t with
      | Ok d -> mk loc Types.String (Tast.Str d)
      | Error inner -> view_not_yet loc e inner
    in
    let i32 n = mk loc (Types.Int Types.I32) (Tast.Int (n, Types.I32)) in
    let i64 n = mk loc dyn_i64 (Tast.Int (n, Types.I64)) in
    let bind, e =
      match ctx, e.Tast.ty with
      | Some ctx, (Types.Vec _ | Types.Array _ | Types.Named _)
        when not (view_place e) ->
        let sl = fresh_slot ctx e.Tast.ty in
        Some (sl, e), mk loc e.Tast.ty (Tast.Local sl)
      | _ -> None, e
    in
    (match !view_global_init with
     | Some (g, kind) when frame_root e ->
       let fln = fln_source loc in
       let ty = tyname loc e.Tast.ty in
       Loc.failk "check/dyn-view-lifetime" loc
         "%s is a dyn global, and its initialiser builds a %s that is gone \
          once the initialiser returns, so a dyn view of it would outlive \
          it. Give %s its type, as in %s"
         g ty g
         (let form =
            match kind with Ast.Every -> "def" | Ast.Once -> "defonce" in
          if fln then
            Printf.sprintf "%s %s: %s = ..."
              (match kind with Ast.Every -> "def" | Ast.Once -> "once") g ty
          else Printf.sprintf "(%s %s %s ...)" form g ty)
     | _ -> ());
    let here = i32 (if frame_root e then 1L else 0L) in
    let view =
      match e.Tast.ty with
      | Types.Slice (_, elem) ->
        dyn "flan_dyn_view_slice" [ e; desc_of elem; here ]
      | Types.Vec elem ->
        dyn "flan_dyn_view_at" [ addr_of loc e; i64 0L; desc_of elem; i32 1L; here ]
      | Types.Array (n, elem) ->
        dyn "flan_dyn_view_at" [ addr_of loc e; i64 n; desc_of elem; i32 0L; here ]
      | t ->
        dyn "flan_dyn_view_at" [ addr_of loc e; i64 0L; desc_of t; i32 2L; here ]
    in
    (match bind with
     | None -> view
     | Some b -> mk loc Types.Dyn (Tast.Let ([ b ], [ view ])))
  (* A dyn view is written through by (set (at d i) x), and nothing on the
     dyn side can tell a read-only one apart, so a [[const T]] does not
     cross. *)
  | Types.Slice (Types.Const, elem) ->
    Loc.failk "check/dyn-const-view" loc
      "%s does not cross into dyn: a dyn view can be written through, and a \
       [const %s] can only be read. A dyn view is taken of the writable \
       storage it came from"
      (tyname loc e.Tast.ty) (tyname loc elem)
  (* No view for a map yet, and the suggestion is the *literal* rather than a
     constructor call: there is no [(map-new dyn)] — [map_new_types] wants a
     key and a value, and [map_type] refuses dyn as a key — so naming one
     would be advice that does not compile. A dyn map is written {:k v}. *)
  | Types.Map _ ->
    no_dyn_yet loc ~into:true e.Tast.ty
      ". A dyn map is written as a literal, {:key value ...}"
  (* [Option] is on this list in name only: [expect] intercepts it before
     [box] ever sees one — [box_option] is the real answer, M2 item 4 — so
     this arm only fires for a direct caller that hands [box] an Option
     itself, and none does today. Left refused rather than removed, so a
     caller that starts doing that gets a sentence instead of a silent
     mis-lowering. *)
  | Types.Named _ | Types.Enum _ | Types.Option _ | Types.Ptr _
  | Types.Alloc | Types.Fn _ | Types.CFn _ | Types.Len _
  | Types.LArray _ | Types.Vec _ | Types.Array _ | Types.Slice _ ->
    no_dyn_yet loc ~into:true e.Tast.ty ""

(* Every dyn an expectation opened ([expect]'s dyn arm), by the node that
   opened it, and the box: what lets a caller that asked for a typed value
   see that the value was a dyn, whichever opening the want picked. Keyed by
   identity and held weakly, so it is gone with the tree. *)
module Opened = Ephemeron.K1.Make (struct
    type t = Tast.expr
    let equal = ( == )
    let hash = Hashtbl.hash
  end)
let opened_by_want : Tast.expr Opened.t = Opened.create 16

(* What an [expect] mismatch found, by the refusal: the type a caller that
   skipped a join can still name the way the join would have. *)
module Found = Ephemeron.K1.Make (struct
    type t = Loc.diag
    let equal = ( == )
    let hash = Hashtbl.hash
  end)
let mismatch_found : Types.t Found.t = Found.create 16

let unbox loc (want : Types.t) (e : Tast.expr) : Tast.expr =
  let need sym ty = rt loc ty sym [ e; here loc ] in
  match want with
  | Types.Float Types.F64 -> need "flan_dyn_need_f64_at" dyn_f64
  | Types.Bool ->
    (* The ABI answers an [int32_t]; [bool] is an [i1]. The narrowing is the
       language's own cast and cannot fail — the runtime already decided the
       value was a bool, so what comes back is 0 or 1. *)
    widen loc Types.Bool (need "flan_dyn_need_bool_at" (Types.Int Types.I32))
  (* Only a dyn char: an int is a number until (char n) converts it. *)
  | Types.Char -> rt loc Types.Char "flan_dyn_need_char" [ e; here loc ]
  (* Any integer width, checked at run time at this site (TODO.org, "Dyn
     unless annotated"): an int in the width's range, or a char's code point
     where it fits — ASCII only into a byte, since a byte past ASCII is not
     that char in UTF-8. The runtime answers an i64 it has already checked,
     so the narrowing after it cannot lose a bit. *)
  | Types.Int k ->
    let code =
      match k with
      | Types.I8 -> 0L | Types.U8 -> 1L | Types.I16 -> 2L | Types.U16 -> 3L
      | Types.I32 -> 4L | Types.U32 -> 5L | Types.I64 -> 6L | Types.U64 -> 7L
    in
    let n =
      rt loc dyn_i64 "flan_dyn_need_int"
        [ e; mk loc (Types.Int Types.I32) (Tast.Int (code, Types.I32)); here loc ]
    in
    if k = Types.I64 then n else mk loc want (Tast.Prim (Tast.Cast want, [ n ]))
  (* An f32 is refused rather than served by a need_f64 and a rounding: the
     box carries one float width, and narrowing is written or it does not
     happen (TODO.org, "Implicit numeric widening is legal; narrowing stays a
     hard error"). *)
  | Types.Float _ ->
    no_dyn_yet loc ~into:false want " — take it as f64 and convert"
  | _ -> no_dyn_yet loc ~into:false want ""

(* A dyn where a str, a slice, a fixed array or a struct was written:
   [flan_dyn_need_as] with the written type's descriptor, answering through
   a slot of that type. The runtime decides, since only it can see what the
   dyn holds: a text is a str's own bytes, a view of the wanted elements is
   their own storage, a vec or a map is a checked copy, and a [T] that can be
   written through is never a copy — a write through one would not reach the
   dyn vec, so the answer would differ with the vec typed or dyn. Its comment
   in runtime/flan_dyn.c says where the copies live and how long a str from a
   text lasts.

   A fixed array or a struct that holds a Vec is refused: from a view it
   would be a second copy of an owning header. *)
let into_typed ctx loc (want : Types.t) (got : Tast.expr) : Tast.expr =
  let structs = ctx.env.structs in
  let rec owns (t : Types.t) =
    match t with
    | Types.Vec _ -> true
    | Types.Array (_, e) -> owns e
    | Types.Named n ->
      (match Hashtbl.find_opt structs n with
       | Some st -> List.exists (fun (f : Tast.field) -> owns f.Tast.fty) st.Tast.fields
       | None -> false)
    | _ -> false
  in
  match view_desc ~into:true structs want with
  | Error inner ->
    no_dyn_yet loc ~into:false want
      (if Types.equal inner want then ""
       else Printf.sprintf " — a dyn value has no %s to become" (tyname loc inner))
  | Ok _ when owns want ->
    no_dyn_yet loc ~into:false want " — it holds a Vec, which owns its storage"
  | Ok d ->
    let ds = fresh_slot ctx Types.Dyn and out = fresh_slot ctx want in
    let local s ty = mk loc ty (Tast.Local s) in
    mk loc want
      (Tast.Let
         ([ (ds, got); (out, mk loc want (Tast.Zero want)) ],
          [ rt loc Types.Unit "flan_dyn_need_as"
              [ local ds Types.Dyn; mk loc Types.String (Tast.Str d);
                addr_of loc (local out want); here loc ];
            local out want ]))

(* ── A numeric cast written on a dyn ─────────────────────────────────
 *
   TODO.org, "A numeric cast opens a dyn box".
 *
   [(f64 d)] where [d] is dyn. Until this, the only place in the language
   that opened a box was a typed parameter, which is why a program that
   wanted a number out of a dyn had to define a one-line function whose
   parameter slot did the unboxing and call *that*. A cast is already the
   operator for "convert this to that", so it is the spelling that should
   have worked, and now does.

   What is built is a branch on the box's tag, not a call that converts:

       (let ([s d])
         (if (= (flan_dyn_cast_kind s "file:1:2" "u32" 0) 1)
             (u32 (flan_dyn_need_f64 s))
             (u32 (flan_dyn_need_i64 s))))

   Each arm is an ordinary [Cast] over an ordinary [need], so the conversion
   is *the same node* a typed operand of that type would have produced.
   That is the point of this shape rather than a coercing runtime entry point
   that answers the finished number: [(i64 2.5)] is not a bare [fptosi] in
   this compiler — [Emit.check_cast] range-checks it first and signals
   ArithError when the value will not fit, and the x86 backend does the same
   — so a C function returning an [int64_t] would have had to grow its own
   second opinion about range and NaN, in a second place, for two backends.
   Here there is nothing to keep in step: [(i64 float-box)] *is* [(i64 x)]
   with an unbox in front of it, which is exactly what the semantics say.

   [need_f64] and [need_i64] are the trapping entry points, and neither can
   trap here: each is reached only on the arm where the tag has already been
   read as its own. The trap that can happen is the runtime's, for a box
   holding a non-number, and [flan_dyn_cast_kind] owns that sentence — bool
   included, which is what [flan_dyn_need_i64] already does with a bool at a
   typed parameter. The cross-kind case does not trap: it converts and warns
   once for the site, the author's call, recorded in TODO.org, "A numeric
   cast opens a dyn box".

   The slot exists because the value is read three times — once for the tag,
   once on whichever arm runs — and the argument may be an arbitrary
   expression. [unbox_option] above builds the same shape for the same
   reason. *)
let cast_dyn ctx loc (target : Types.t) (got : Tast.expr) : Tast.expr =
  let s = fresh_slot ctx Types.Dyn in
  let sv = mk loc Types.Dyn (Tast.Local s) in
  let want_float = match target with Types.Float _ -> 1 | _ -> 0 in
  let kind =
    rt loc (Types.Int Types.I32) "flan_dyn_cast_kind"
      [ sv; here loc;
        mk loc Types.String (Tast.Str (Types.to_string target));
        mk loc (Types.Int Types.I32) (Tast.Int (Int64.of_int want_float, Types.I32)) ]
  in
  let is_float =
    mk loc Types.Bool
      (Tast.Prim (Tast.Eq,
                  [ kind;
                    mk loc (Types.Int Types.I32) (Tast.Int (1L, Types.I32)) ]))
  in
  let arm sym ty = widen loc target (rt loc ty sym [ sv ]) in
  mk loc target
    (Tast.Let ([ (s, got) ],
               [ mk loc target
                   (Tast.If (is_float,
                             arm "flan_dyn_need_f64" dyn_f64,
                             arm "flan_dyn_int_of" dyn_i64)) ]))

(* nil is written [nil] and nothing else produces it, so this is the whole of
   "the checker can see a nil reaching here" — a name, not a dataflow fact.
   There is no propagation through a [let] or a call in this checker (see
   "Ownership tracking repealed" — flow analysis was removed on purpose), so a
   [nil] bound to a name and used later is exactly the case the runtime trap
   below exists for. That is the intended split, not a gap: the syntax a
   reader can see is refused where they are looking at it, and everything one
   step removed from the syntax is caught when the program runs. *)
let is_nil_lit (e : Tast.expr) =
  match e.Tast.e with
  | Tast.Prim (Tast.Rt "flan_dyn_nil", []) -> true
  | _ -> false

(* ── nil <-> None at (Option T) ────────────────────────────────────────────

   The dyn absence and the typed one are the same absence at the one boundary
   where both are meaningful, M2 item 4. Both directions build the same
   [If]-over-a-tag shape [get] and [map-remove] already build (check.ml
   4780-4900): the tag says which of [Some]/[None] it is, and the payload,
   when there is one, crosses the scalar boundary [box]/[unbox] already own.

   (Option (Option T)) does not cross either direction. Boxing [Some] of an
   inner [None] would box that [None] as nil — the same nil an outer [None]
   becomes — which is exactly the ambiguity [(Some nil)] is refused for one
   level down; unboxing has the mirror problem, one dyn absence asked to tell
   two levels of it apart. The type stays legal on the typed side (it is
   already constructible: nothing here refuses it), only the crossing does
   not exist for it.

   (Option dyn) needs no case of its own. Its payload is already dyn, so
   boxing it is the identity and unboxing it is the identity; the only thing
   that has to hold is that the payload is never nil, which is [(Some nil)]'s
   refusal below, not this boundary's. *)
let box_option ctx loc (t : Types.t) (got : Tast.expr) : Tast.expr =
  match t with
  | Types.Option inner ->
    Loc.failk "check/option-nested-dyn" loc
      "(Option (Option %s)) does not cross into dyn — Some None and None \
       would both box as nil"
      (tyname loc inner)
  | _ ->
    (* A literal [Some]/[None] built right here skips the runtime check: the
       checker already knows which case it is, so there is nothing to test at
       run time and the conversion is free on both backends. *)
    match got.Tast.e with
    | Tast.None_ -> rt loc Types.Dyn "flan_dyn_nil" []
    | Tast.Some_ x -> if Types.equal t Types.Dyn then x else box ~ctx loc x
    | _ ->
      let s = fresh_slot ctx (Types.Option t) in
      let sv = mk loc (Types.Option t) (Tast.Local s) in
      let tag = mk loc (Types.Int Types.I8) (Tast.Field (sv, 0)) in
      let is_some =
        mk loc Types.Bool
          (Tast.Prim (Tast.Ne,
                      [ tag; mk loc (Types.Int Types.I8) (Tast.Int (0L, Types.I8)) ]))
      in
      let payload = mk loc t (Tast.Field (sv, 1)) in
      let some_dyn = if Types.equal t Types.Dyn then payload else box ~ctx loc payload in
      let none_dyn = rt loc Types.Dyn "flan_dyn_nil" [] in
      mk loc Types.Dyn
        (Tast.Let ([ (s, got) ],
                   [ mk loc Types.Dyn (Tast.If (is_some, some_dyn, none_dyn)) ]))

(* [=] over a dyn pair, answering a bool. Shared by the [=] builtin and a
   literal [match] over a dyn, which is (= t lit) by definition. *)
let dyn_eq loc u v =
  unbox loc Types.Bool
    (rt loc Types.Dyn "flan_dyn_eq_at" [ box loc u; box loc v; here loc ])

let unbox_option ctx loc (t : Types.t) (got : Tast.expr) : Tast.expr =
  let oty = Types.Option t in
  match t with
  | Types.Option inner ->
    Loc.failk "check/option-nested-dyn" loc
      "(Option (Option %s)) does not cross from dyn — a dyn has one absence, \
       nil, which cannot tell None from Some None apart"
      (tyname loc inner)
  | _ when is_nil_lit got -> mk loc oty Tast.None_
  | _ ->
    let s = fresh_slot ctx Types.Dyn in
    let sv = mk loc Types.Dyn (Tast.Local s) in
    let not_nil =
      mk loc Types.Bool
        (Tast.Prim (Tast.Eq,
                    [ rt loc (Types.Int Types.I32) "flan_dyn_is_nil" [ sv ];
                      mk loc (Types.Int Types.I32) (Tast.Int (0L, Types.I32)) ]))
    in
    let none = mk loc oty Tast.None_ in
    let payload = if Types.equal t Types.Dyn then sv else unbox loc t sv in
    let some = mk loc oty (Tast.Some_ payload) in
    mk loc oty
      (Tast.Let ([ (s, got) ], [ mk loc oty (Tast.If (not_nil, some, none)) ]))

(* What a numeric mismatch has left to say, now that widening is silent.
   TODO.org, "Implicit numeric widening is legal; narrowing stays a hard
   error": every conversion that cannot change
   the number happens by itself, so a numeric pair that still reaches a refusal
   is one of exactly two things, and this tells them apart.

   Either the wanted type is *narrower* — the conversion can lose, which is
   what the language has always refused to do without being told, and the
   sentence names the cast and points out that the other direction needed
   nothing. Or there is no direction at all: i32 and u32 are the same width and
   each holds values the other cannot, so neither widens and the program has to
   say which half it means to keep.

   Written once and used by both refusals that can report one — [expect]'s, and
   the binary operators' when their two operands have no join. *)
(* ── The widening thunk ────────────────────────────────────────────────
   One per signature, and the whole of what a [CFn] costs on its way into
   an [Fn]. Its parameters are the signature's, it declares the environment,
   and its body calls through what it finds there — because that is where the
   original bare address was put.

   Which is the move that makes the two conventions meet in exactly one
   place. Every body reachable through an [Fn] value declares the trailing
   environment, so every indirect call is exactly typed and nothing anywhere
   relies on a callee ignoring an argument it never declared. That was the
   first design's hinge and it does not survive wasm32: [call_indirect]
   compares the signature at the call and a spare argument is a trap.

   Per *signature* and not per name, so a program pays one small function per
   distinct shape it widens rather than one per function it widens. Two
   widenings of the same shape share a thunk, which is what the memo below is
   for — the same arrangement [struct_key_pair] uses for a map's hash and
   equality pair, and for the same reason.

   **The memo is keyed on the types and the symbol spells them back**, and
   both halves matter. [mangle_ty] cannot serve as the spelling: it flattens
   a whole signature into one hyphen-joined string, which loses arity and
   every type boundary with it, so [(CFn [(Ptr i32)] i32)] and
   [(CFn [ptr i32] i32)] — the second over a struct someone called [ptr] —
   both come out [cfn-ptr-i32-to-i32]. Keyed on that string, the second
   widening silently reuses the first's thunk and calls it with the wrong
   arity, which is a miscompile on both backends and not a refusal anywhere.
   So the key is the types, compared with [Types.equal], and the name is
   [thick_enc]'s encoding, which no two signatures share.

   ([mangle_ty]'s ambiguity is older than this and is still there for the
   generic instantiation names it was written for. At one type's granularity
   it is hard to reach; at a whole signature's it is a line of Flan away.)

   **Why the name has to be the signature and not a counter.** A counter over
   the thunks minted so far is unique within one compilation and says nothing
   across two: reorder the definitions in the file and [thick/0] is a
   different signature than it was. [Session.compatible] compares a reload's
   functions against the running program's *by name*, so a thunk that changed
   shape under a fixed name reads to it as a function whose signature was
   edited, and the dev loop answers a form reorder with "Restart to change
   it". Spelled from the types, the name moves with the shape and that
   comparison is right again for the same reason it is right everywhere else.

   [fparent] is [<thick>]: not a name anyone wrote, so [defs] hides it, and a
   marker the redefinition modules match on to carry a copy of their own. *)

(* A signature written so that it can be read back: every type is
   self-delimiting, so no two distinct signatures encode alike.

   An atom is its length and then its spelling, which is what closes the gap
   [mangle_ty] leaves — a name's boundaries are in the string rather than
   inferred from the separators. A constructor is one letter, and the two
   that hold a count write it before their children, so [(Fn [i32] i32)] and
   [(Fn [] (Fn [i32] i32))] cannot read alike. [Named] and [Enum] carry
   different letters because a struct and a C enum may share a spelling. *)
let rec thick_enc (t : Types.t) =
  let atom s = Printf.sprintf "%d-%s" (String.length s) s in
  let arrow tag ps r =
    Printf.sprintf "%s%d-%s" tag (List.length ps)
      (String.concat "-" (List.map thick_enc (ps @ [ r ])))
  in
  match t with
  | Types.Named n -> "n" ^ atom n
  | Types.Enum n -> "e" ^ atom n
  | Types.Var v -> "y" ^ atom v
  | Types.Slice (Types.Mut, e) -> "s" ^ thick_enc e
  | Types.Slice (Types.Const, e) -> "k" ^ thick_enc e
  | Types.Ptr (Types.Mut, e) -> "p" ^ thick_enc e
  | Types.Ptr (Types.Const, e) -> "q" ^ thick_enc e
  | Types.Vec e -> "v" ^ thick_enc e
  | Types.Option e -> "o" ^ thick_enc e
  | Types.Array (n, e) -> Printf.sprintf "a%Ld-%s" n (thick_enc e)
  | Types.Map (k, v) -> Printf.sprintf "m%s-%s" (thick_enc k) (thick_enc v)
  | Types.Fn (ps, r) -> arrow "f" ps r
  | Types.CFn (ps, r) -> arrow "c" ps r
  | t -> atom (mangle_ty t)

let thick_thunk env loc ps r =
  let same (f : Tast.fn) =
    f.Tast.fparent = Some "<thick>"
    && List.length f.Tast.params = List.length ps
    && List.for_all2 Types.equal f.Tast.params ps
    && Types.equal f.Tast.ret r
  in
  match List.find_opt same env.lifted with
  | Some f -> f.Tast.name
  | None ->
    let n = List.length ps in
    let fty = Types.CFn (ps, r) in
    let args = List.mapi (fun i t -> mk loc t (Tast.Local i)) ps in
    let callee = mk loc fty (Tast.Local n) in
    let name = "thick/" ^ thick_enc fty in
    env.lifted <-
      { Tast.name; params = ps;
        slots = Array.of_list (ps @ [ fty ]);
        snames = Array.make (n + 1) None; as_slots = [];
        ret = r; body = [ mk loc r (Tast.CallPtr (callee, args)) ];
        fdefers = []; fenv = Some n; fparent = Some "<thick>"; floc = loc }
      :: env.lifted;
    name

(* The slot a lifted body's environment arrives in, minted when the body did
   not capture anything and so has none of its own.

   Every body that can be *reached* through an [Fn] value declares the
   parameter, whether or not it reads it: a lifted [fn] literal in an [Fn]
   position, and every handler clause, since [flan_signal] passes the frame's
   environment to all of them. The alternative is a call whose signature is
   one argument longer than the callee's, which SysV tolerates and wasm32
   does not. The slot is nameless, so the break loop hides it, and a body
   that never reads it costs one store the optimiser drops. *)
let declare_env ctx = function
  | Some _ as s -> s
  | None -> Some (fresh_slot ctx (Types.Ptr (Types.Mut, Types.Unit)))

let numeric_note ?(fln = false) ~(want : Types.t) ~(got : Types.t) () =
  let cast =
    if fln then Printf.sprintf "%s(x)" (Types.spell ~indented:fln want)
    else Printf.sprintf "(%s x)" (Types.spell ~indented:fln want)
  in
  if not (Types.is_numeric want && Types.is_numeric got) then ""
  else if Types.widens_to ~from:want ~into:got then
    Printf.sprintf
      " — %s into %s can lose, so it has to be written: %s. The other way \
       round, %s widens into %s by itself"
      (Types.spell ~indented:fln got) (Types.spell ~indented:fln want) cast
      (Types.spell ~indented:fln want) (Types.spell ~indented:fln got)
  else
    Printf.sprintf
      " — neither widens into the other, so the conversion has to be written: \
       %s"
      cast

(* The rest of the sentence when a read-only slice meets a writable one. *)
let const_note ?(fln = false) env ~(want : Types.t) ~(got : Types.t) =
  match want, got with
  | Types.Slice (Types.Mut, e), Types.Slice (Types.Const, e')
    when Types.equal e e' ->
    let copy =
      Option.map (fun c -> if fln then "clone(v)" else c) (const_copy env e) in
    Printf.sprintf
      " — a %s can only be read, and never becomes a %s that can be written \
       through. %sWhere nothing writes through it, the %s can be declared %s \
       instead"
      (Types.spell ~indented:fln got) (Types.spell ~indented:fln want)
      (match copy with
       | Some c ->
         Printf.sprintf "%s copies v into a %s of its own. " c
           (Types.spell ~indented:fln want)
       | None -> "")
      (Types.spell ~indented:fln want) (Types.spell ~indented:fln got)
  | Types.Ptr (Types.Mut, e), Types.Ptr (Types.Const, e')
    when Types.equal e e' ->
    Printf.sprintf
      " — a %s can only be read through, and never becomes a %s that can be \
       written through. Copy the %s out with %s and point at the copy; \
       where nothing writes through it, the %s can be declared %s instead"
      (Types.spell ~indented:fln got) (Types.spell ~indented:fln want) (Types.spell ~indented:fln e)
      (if fln then "deref(p)" else "(deref p)")
      (Types.spell ~indented:fln want) (Types.spell ~indented:fln got)
  | _ -> ""

let nil_has_no_none loc w =
  fail loc
    "nil has no None to become at %s — nil only converts to (Option T) \
     or to dyn itself; wrap the type in Option, or keep the value dyn"
    (tyname loc w)

(* A literal boxed where a dyn was wanted, and the literal. It brings no dyn
   of its own to an operator: (+ nil 1) over a literal 1 checked at dyn is as
   typed as (+ nil x) over an i32 x. *)
let boxed_literal (e : Tast.expr) =
  match e.Tast.e with
  | Tast.Prim (Tast.Rt ("flan_dyn_from_i64" | "flan_dyn_from_f64"
                       | "flan_dyn_from_char" | "flan_dyn_from_bool"), [ x ]) ->
    let x = match x.Tast.e with Tast.Prim (Tast.Cast _, [ y ]) -> y | _ -> x in
    (match x.Tast.e with
     | Tast.Int (n, _) when x.Tast.ty <> Types.Char ->
       (* The type the literal takes where nothing is wanted. *)
       let k =
         if Int64.compare n (Int64.of_int32 Int32.max_int) > 0
         || Int64.compare n (Int64.of_int32 Int32.min_int) < 0
         then Types.I64 else Types.I32
       in
       Some (Types.Int k)
     | Tast.Int _ | Tast.Float _ | Tast.Bool _ -> Some x.Tast.ty
     | _ -> None)
  | _ -> None

(* The operands of an arithmetic, bitwise or ordering operator gone dyn,
   before they are boxed: a literal [nil] among them with nothing else dyn is
   refused as [expect] refuses it at a typed want, whichever position it is
   in and whether or not the form has a want. A dyn that holds nil is the
   run-time trap's, so (+ 1 2 nil) is refused and (+ 1 2 (the dyn nil))
   traps. [=] and [!=] ask no such question: nil is unequal to a number. *)
let no_bare_nil (ops : Tast.expr list) =
  match List.find_opt is_nil_lit ops with
  | None -> ()
  | Some nil ->
    let makes_dyn (e : Tast.expr) =
      e.Tast.ty = Types.Dyn && not (is_nil_lit e) && boxed_literal e = None
    in
    if not (List.exists makes_dyn ops) then
      match
        List.find_map
          (fun (e : Tast.expr) ->
             if e.Tast.ty <> Types.Dyn then Some e.Tast.ty else boxed_literal e)
          ops
      with
      | Some t -> nil_has_no_none nil.Tast.loc t
      | None -> ()

let rec expect ctx loc ~want (got : Tast.expr) =
  match want with
  | None -> got
  | Some w ->
    (* The boundary: where a wanted type meets a produced one, and the one
       place the language's implicit conversions live. It runs before [fits]
       rather than instead of it: what comes back is an ordinary expression of
       the wanted type, and if the coercion did not produce one the usual
       message is still the one that reports it. *)
    let got =
      match w, got.Tast.ty with
      | Types.Dyn, Types.Dyn -> got
      | Types.Dyn, Types.Option t -> box_option ctx loc t got
      | Types.Dyn, _ -> box ~ctx loc got
      | Types.Option t, Types.Dyn when not (is_nil_lit got) ->
        let opened = unbox_option ctx loc t got in
        Opened.replace opened_by_want opened got;
        opened
      | Types.Option t, Types.Dyn -> unbox_option ctx loc t got
      (* A bare T has no None to become, and this nil is one the checker can
         actually see — the literal, written right where the mismatch is.
         Refused here, at the offending line, instead of waiting for the
         runtime trap [unbox] would otherwise reach for two arms down. *)
      | w, Types.Dyn when is_nil_lit got -> nil_has_no_none loc w
      | _, Types.Dyn when Types.fits ~expected:w ~actual:Types.Dyn -> got
      | (Types.String | Types.Slice _ | Types.Array _), Types.Dyn ->
        let opened = into_typed ctx loc w got in
        Opened.replace opened_by_want opened got;
        opened
      | Types.Named n, Types.Dyn when Hashtbl.mem ctx.env.structs n ->
        let opened = into_typed ctx loc w got in
        Opened.replace opened_by_want opened got;
        opened
      | _, Types.Dyn ->
        let opened = unbox loc w got in
        Opened.replace opened_by_want opened got;
        opened
      (* Implicit widening, and this single arm is the whole of its surface.
         [expect] is called by every site that annotates and by nothing else,
         so an argument, a return, a let or defonce with a type, a struct field
         initialiser, a push into a Vec and a C import's parameter all get it
         here at once and none of them had to learn about it.

         The conversion is performed, not waved through: [widen] emits the same
         [Cast] node the written (i64 x) emits, so the backends sext or zext by
         the *source* type's signedness and nothing downstream sees a node
         whose type disagrees with its bits. [widens_to] is what keeps that
         honest — it admits only conversions that cannot change the number, so
         the cast this inserts is one no program can tell happened. *)
      | _ when Types.widens_to ~from:got.Tast.ty ~into:w -> widen loc w got
      (* The other widening, and the only coercion between the two function
         types. A bare address satisfies a signature that asks for an
         environment. It goes this way only — an [Fn] has an environment and a
         [CFn] has nowhere to put one — so the reverse falls through to the
         ordinary refusal, which names both types and is the right sentence. *)
      | Types.Fn (ps, r), Types.CFn (ps', r')
        when Types.fn_accepts ~from:(ps', r') ~into:(ps, r) ->
        mk loc w (Tast.Thicken (thick_thunk ctx.env loc ps r, got))
      (* The same signature up to const, which [Types.fn_accepts] defines. *)
      | Types.Fn (ps, r), Types.Fn (ps', r')
      | Types.CFn (ps, r), Types.CFn (ps', r')
        when Types.fn_accepts ~from:(ps', r') ~into:(ps, r) ->
        { got with Tast.ty = w }
      (* A writable view seen as a read-only one. The two are the same two
         words, so the value is only retyped; the reverse is refused below,
         with [const_note] naming the copy that would make it writable. *)
      | (Types.Slice (Types.Const, _) | Types.Ptr (Types.Const, _)), _
        when Types.const_widens ~from:got.Tast.ty ~into:w ->
        { got with Tast.ty = w }
      (* Decision 138, Swift's rule: a T where a (Option T) is wanted is
         [Some] of it. One level each time — a T? into a T?? is [Some] of the
         Option, never the Option itself — and the payload goes through this
         same boundary first, so a T into a T?? is [Some (Some t)] and an i32
         into an (Option i64) is widened, then wrapped. Never the other way:
         a T? where a T is wanted is still refused, and a dyn is left to the
         nil <-> None arms above. When the payload is refused too, the
         refusal below names the Option, as it did before. *)
      | Types.Option t, g
        when (match g with Types.Dyn | Types.Never -> false | _ -> true)
             && not (Types.fits ~expected:w ~actual:g) ->
        (match expect ctx loc ~want:(Some t) got with
         | v when Types.fits ~expected:t ~actual:v.Tast.ty -> mk loc w (Tast.Some_ v)
         | _ -> got
         | exception Loc.Error _ -> got)
      | _ -> got
    in
    if Types.fits ~expected:w ~actual:got.Tast.ty then got
    else
      (* Kinded so that the one caller who knows more — a call argument, which
         can name the function and the parameter — can recognise this exact
         refusal at this exact span and say the rest. Every other reader of a
         diagnostic ignores [kind].

         [numeric_note] is the rest of the sentence when both sides are
         numbers, and it is on this message rather than beside it because a
         reader who has just been told i64 and i32 are different types needs
         to be told, in the same breath, which direction needed nothing. *)
      (try
         Loc.failk "check/type-mismatch" loc "expected %s, found %s%s%s"
           (tyname loc w) (tyname loc got.Tast.ty)
           (numeric_note ~fln:(Source.indented_at loc) ~want:w ~got:got.Tast.ty ())
           (const_note ~fln:(Source.indented_at loc) ctx.env ~want:w ~got:got.Tast.ty)
       with Loc.Error d ->
         Found.replace mismatch_found d got.Tast.ty;
         raise (Loc.Error d))

(* 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 | Types.Char -> true
  | Types.Array (_, t) -> bytewise_key t
  | _ -> false

let hash_ty = Types.Int Types.U64

(* The fresh context a frame starts from: no outer scope, no defers, no loops,
   and [defer_ok] false. As written it is a function the checker invented —
   nothing is reachable from it because none of it is a body anyone wrote — and
   that is how the emitted hashers and the constant-inference pass take it.

   A body someone *did* write starts here too and then reattaches the few
   fields that make it theirs: [owner] is the function's name, and an fn or a
   handler sets [outer] to the enclosing scope so that a reference to the
   enclosing function's locals is refused for the reason it is really refused
   for. Those are [with] clauses on this record rather than a literal of their
   own, so that a field added here is added to all of them.

   Each caller calls it again rather than sharing one value: [slots] and
   [slot_tys] are counted up per frame, and two frames that shared a context
   would share a slot counter. *)
(* The return type a body is checked against while it is being read for
   one ([_] in a defn's return slot; see [infer_returns]). Compared by
   address, so no type written anywhere is ever mistaken for it. What each
   [return] in that body gives is pushed on [infer_seen]. *)
let infer_ret = Types.Named "_"

(* The type two arms meet at — an [if]'s two, or two exits of a [_] body —
   the same whichever comes first: the wider where one widens into the other
   without loss ([Types.join]), the read-only where they differ only in const,
   and dyn where either is dyn, the other boxed. [None] is a refusal. *)
let arm_join (a : Types.t) (b : Types.t) =
  if Types.equal a Types.Never then Some b
  else if Types.equal b Types.Never then Some a
  else
    match Types.join a b with
    | Some j -> Some j
    | None ->
      match Types.const_join a b with
      | Some j -> Some j
      | None ->
        (* A T beside a T? meets at the T?, the T wrapped in [Some]
           (decision 138). Only the plain side moves, and by one level. *)
        let wraps p u =
          (match u with Types.Option _ | Types.Unit -> false | _ -> true)
          && (Types.equal p u || Types.widens_to ~from:u ~into:p)
        in
        (match a, b with
         | Types.Dyn, _ | _, Types.Dyn -> Some Types.Dyn
         | Types.Option p, u when wraps p u -> Some a
         | u, Types.Option p when wraps p u -> Some b
         | _ -> None)
(* The type two untyped literals meet at: the wider of their own types, and
   an integer beside a float at the float — [(if c 1 2.5)] is an f32, though
   i32 does not widen into f32, because the 1 was never an i32 to lose. Only
   for literals: a typed i32 beside a float literal still has to be converted. *)
let literal_meet (a : Types.t) (b : Types.t) =
  match Types.join a b, a, b with
  | Some j, _, _ -> Some j
  | None, Types.Int _, Types.Float _ -> Some b
  | None, Types.Float _, Types.Int _ -> Some a
  | None, _, _ -> None
let infer_seen : (Types.t * Loc.t * bool) list ref = ref []
(* What a refused subexpression stands as while recovering. [Zero] of [Never]
   is a value nothing else builds, so it is recognisable; see [check]. *)
let poison loc = { Tast.e = Tast.Zero Types.Never; ty = Types.Never; loc }

(* A poison, or a read of a local one was bound to. *)
let is_poison (r : Tast.expr) =
  Types.equal r.Tast.ty Types.Never
  && (match r.Tast.e with Tast.Zero Types.Never | Tast.Local _ -> true | _ -> false)

let record_recovered env (d : Loc.diag) =
  let same (x : Loc.diag) = x.Loc.dloc = d.Loc.dloc && String.equal x.Loc.dmsg d.Loc.dmsg in
  if not (List.exists same env.recovered) then env.recovered <- d :: env.recovered

(* [f] with recovery off, for a check whose refusal is an answer: a trial, a
   probe, a fallback that re-checks. *)
let speculate env f =
  env.speculating <- env.speculating + 1;
  Fun.protect ~finally:(fun () -> env.speculating <- env.speculating - 1) f

(* A refusal a caller has re-worded: recorded and stood in for while
   recovering, raised otherwise. The [check] it re-words was [guarded], so its
   own refusal came here rather than being recorded in its first wording. *)
let refuse_or_poison env loc (d : Loc.diag) =
  if env.recovering && env.speculating = 0 then begin
    record_recovered env d;
    env.poison <- env.poison + 1;
    poison loc
  end
  else raise (Loc.Error d)

(* [f], a declaration's body, with recovery on when [on]. Everything it
   recorded is raised as [Loc.Errors] at the end, together with whatever
   refusal ended it, so nothing checked with a poison in it is ever returned. *)
let with_recovery env ~on f =
  if not on then f ()
  else begin
    let saved = (env.recovering, env.recovered, env.poison) in
    let restore () =
      let r, d, p = saved in
      env.recovering <- r; env.recovered <- d; env.poison <- p
    in
    env.recovering <- true; env.recovered <- []; env.poison <- 0;
    match f () with
    | x ->
      let found = List.rev env.recovered in
      restore ();
      if found = [] then x else raise (Loc.Errors found)
    | exception Loc.Error d ->
      let found = List.rev env.recovered in
      restore ();
      (* Raised past the end of the body after something in it already
         failed: a return that does not fit, a value that is missing, both of
         them what the failure left behind. *)
      if found = [] then raise (Loc.Error d) else raise (Loc.Errors found)
    | exception e -> restore (); raise e
  end

let invented_ctx env ret =
  { env; ret; lits = None; slots = 0; slot_tys = []; slot_names = []; as_slots = []; scope = [];
    defers = []; defer_slot = None; outer = []; outer_what = None; caught = []; place_ok = false; envslot = None; parent = None; in_frames = None; loops = []; tail = false; used = false; kept = [];
    in_defer = false; defer_ok = false; defer_block = "a nested form";
    owner = "<none>" }

(* Whether a struct has exactly Error's two fields, which is what a parent must
   have: a handler for a parent is handed a view of that shape. *)
let error_shaped env n =
  match Hashtbl.find_opt env.structs n with
  | Some s ->
    (match s.Tast.fields with
     | [ { Tast.fname = "name"; fty = Types.String };
         { Tast.fname = "message"; fty = Types.String } ] -> true
     | _ -> false)
  | None -> false

(* What a signal site tells the runtime about its condition. A condition that
   something could catch through a parent, and that is not Error-shaped itself,
   gets a printer lifted out of the signalling function: the runtime calls it
   only when a parent's handler is about to run, or nothing handled it, so a
   signal nobody catches that way costs nothing. It prints what [println]
   prints, fields and values, and that is the message such a handler reads. *)
let condition_desc ctx loc name =
  let chain = condition_chain ctx.env name in
  let self = error_shaped ctx.env name in
  let render =
    if self || List.length chain < 2 then None
    else begin
      let ty = Types.Named name in
      let hctx = { (invented_ctx ctx.env Types.Unit) with owner = ctx.owner } in
      let pslot = fresh_slot hctx (Types.Ptr (Types.Mut, ty)) in
      let bslice = Types.Slice (Types.Mut, Types.Int Types.U8) in
      let emit x = mk loc Types.Unit (Tast.Prim (Tast.Rt "flan_msg_emit", [ x ])) in
      let emitter : Render.emitter =
        { Render.ebytes = emit;
          estr = (fun x -> emit (mk loc bslice (Tast.Prim (Tast.EscapeBytes, [ x ]))));
          ei64 = (fun x -> emit (to_bytes hctx loc Tast.I64ToBytes x));
          eu64 = (fun x -> emit (to_bytes hctx loc Tast.U64ToBytes x));
          ef64 = (fun x -> emit (to_bytes hctx loc Tast.F64ToBytes x));
          edyn = (fun x -> mk loc Types.Unit (Tast.Prim (Tast.Rt "flan_dyn_emit_msg", [ x ])));
          enested = (fun x -> mk loc Types.Unit (Tast.Prim (Tast.Rt "flan_dyn_emit_msg", [ x ]))) }
      in
      let value =
        mk loc ty (Tast.Deref (mk loc (Types.Ptr (Types.Mut, ty)) (Tast.Local pslot)))
      in
      let body = Render.render (render_ctx hctx emitter) 0 value in
      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 = "message/")
          ctx.env.lifted
      in
      let fname =
        Printf.sprintf "message/%s/%d/%s" ctx.owner (List.length mine) name
      in
      ctx.env.lifted <-
        { Tast.name = fname; params = [ Types.Ptr (Types.Mut, ty) ];
          slots = Array.of_list (List.rev hctx.slot_tys);
          snames = Array.of_list (List.rev hctx.slot_names); as_slots = hctx.as_slots;
          ret = Types.Unit; body; fdefers = [];
          fenv = None; fparent = Some ctx.owner; floc = loc }
        :: ctx.env.lifted;
      Some fname
    end
  in
  { Tast.cname = name; cchain = List.map type_id chain; cself = self;
    crender = render }

(* 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 (Types.Mut, sty)) (Tast.Local p))) in
  mk loc (Types.Ptr (Types.Mut, 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 [is-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. \
       Write {:where (is-hashable $%s)} at the head of the body, 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"
  | t when is_string_ty t ->
    fail loc
      "a String owns its bytes, and a map would share them with it rather \
       than copy them, so a String is not a map key. Key the map by str and \
       put %s, which is the String's text for as long as the String is not \
       changed"
      (if fln_source loc then "str(s)" else "(str s)")
  | 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 — 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 — key on the member you \
       meant" n
  (* A bytewise array took the arm above; this is one whose elements need
     their own pair, a string's or a struct's. *)
  | Types.Array (n, e) -> array_key_pair env loc n 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. Key on an \
       integer instead"
  | other ->
    fail loc
      "%s is not a map key. A key is an integer, an enum, a bool, a string, a \
       fixed array of those, or a struct of those"
      (tyname loc 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 it is not a map key — every value of it would \
         be the same key" n;
    let hparams = [ Types.Ptr (Types.Mut, sty); hash_ty; Types.Int Types.I64 ] in
    let eparams = [ Types.Ptr (Types.Mut, sty); Types.Ptr (Types.Mut, 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; as_slots = [];
        ret; body = []; fdefers = []; fenv = None; 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 (Types.Mut, 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 (Types.Mut, sty)) in
    let bp = fresh_slot ~name:"b" ectx (Types.Ptr (Types.Mut, 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); as_slots = ctx.as_slots;
        ret; body; fdefers = []; fenv = None; 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 for a fixed array whose elements are not bytewise: the struct
   pair's shape, with the field list replaced by a loop over the elements, so
   [[64 string]] is one call site in a loop and not sixty-four. Each element is
   hashed and compared by its own pair, so an array of structs holding strings
   is served by the same recursion. *)
and array_key_pair env loc n e =
  if Int64.compare n 0L <= 0 then
    fail loc
      "%s has no elements, so it is not a map key — every value of it would be \
       the same key" (tyname loc (Types.Array (n, e)));
  let aty = Types.Array (n, e) in
  (* The type's printed form, with what a symbol cannot hold replaced. *)
  let tag =
    String.map
      (fun c -> match c with
         | 'a' .. 'z' | 'A' .. 'Z' | '0' .. '9' | '_' | '-' -> c
         | _ -> '_')
      (tyname loc aty)
  in
  (* The mangle is many-to-one — [a+b] and [a_b] come out alike — so a digest
     of the printed type, which is an identity, keeps two such keys apart. *)
  let tag =
    tag ^ "/" ^ String.sub (Digest.to_hex (Digest.string (Types.to_string aty))) 0 12
  in
  let hname = "map/hash/array/" ^ tag and ename = "map/eq/array/" ^ tag 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 pty = Types.Ptr (Types.Mut, aty) in
    let hparams = [ pty; hash_ty; Types.Int Types.I64 ] in
    let eparams = [ pty; pty; Types.Int Types.I64 ] in
    let placeholder name ret params =
      { Tast.name; params; slots = Array.of_list params;
        snames = Array.make (List.length params) None; as_slots = [];
        ret; body = []; fdefers = []; fenv = None; fparent = None; floc = loc }
    in
    env.lifted <-
      placeholder hname hash_ty hparams
      :: placeholder ename (Types.Int Types.I8) eparams
      :: env.lifted;
    let h, eq = key_pair env loc e in
    let call ret f args =
      match f with
      | Tast.Rtfn s -> rt loc ret (direct s) args
      | Tast.Flanfn s | Tast.Fnval s -> mk loc ret (Tast.Call (s, args))
    in
    let elem_addr p i =
      let target = mk loc aty (Tast.Deref (mk loc pty (Tast.Local p))) in
      mk loc (Types.Ptr (Types.Mut, e))
        (Tast.Addr (Tast.Pindex (target, [ mk loc index_ty (Tast.Local i) ])))
    in
    (* The counter and its loop, which carries no break and no continue — the
       condition tast.ml puts on a [While] the checker invents. *)
    let loop ctx body =
      let i = fresh_slot ~name:"i" ctx index_ty in
      let iv = mk loc index_ty (Tast.Local i) in
      let limit = mk loc index_ty (Tast.Int (n, Types.I32)) in
      let one = mk loc index_ty (Tast.Int (1L, Types.I32)) in
      let cond = mk loc Types.Bool (Tast.Prim (Tast.Lt, [ iv; limit ])) in
      let step =
        mk loc Types.Unit
          (Tast.Set (Tast.Plocal i,
                     mk loc index_ty (Tast.Prim (Tast.Add, [ iv; one ]))))
      in
      mk loc Types.Unit
        (Tast.Let ([ (i, mk loc index_ty (Tast.Int (0L, Types.I32))) ],
                   [ mk loc Types.Unit (Tast.While (cond, [ body i ], [ step ])) ]))
    in
    let hctx = invented_ctx env hash_ty in
    let kp = fresh_slot ~name:"key" hctx pty 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 hbody =
      [ mk loc Types.Unit
          (Tast.Set (Tast.Plocal acc, mk loc hash_ty (Tast.Local seed)));
        loop hctx (fun i ->
            let one =
              call hash_ty h
                [ elem_addr kp i; mk loc hash_ty (Tast.Local seed);
                  size_of loc e ]
            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 ])));
        mk loc hash_ty (Tast.Local acc) ]
    in
    let ectx = invented_ctx env (Types.Int Types.I8) in
    let ap = fresh_slot ~name:"a" ectx pty in
    let bp = fresh_slot ~name:"b" ectx pty 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 ebody =
      [ loop ectx (fun i ->
            let same =
              call (Types.Int Types.I8) eq
                [ elem_addr ap i; elem_addr bp i; size_of loc e ]
            in
            mk loc Types.Unit
              (Tast.If (mk loc Types.Bool (Tast.Prim (Tast.Eq, [ same; i8 0L ])),
                        mk loc Types.Never (Tast.Return (Some (i8 0L))),
                        unit_at loc)));
        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); as_slots = ctx.as_slots;
        ret; body; fdefers = []; fenv = None; 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
   [(Ptr ())]: one opaque word, which is all the backend needs. *)
let key_fns env loc k =
  let h, e = key_pair env loc k in
  mk loc raw_alloc (Tast.FnAddr h), mk loc raw_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 (is-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 "is-hashable") then
      Loc.failk "check/generic-map-key" loc
        "%s over a map keyed by the type variable %s needs %s to be hashable. \
         Write {:where (is-hashable $%s)} at the head of the body"
        what (tyname loc k) (tyname loc k) v;
    true
  | _ -> false

(* The body shared by [get] and [map-remove]: both answer an (Option V), both
   ask the runtime one question over (key address, out address, sizes, hash,
   equality), and the only thing that differs between them is which symbol is
   called. [sym] is therefore the whole of the difference, and the entry points
   above keep their own preambles — the dyn case and the deferred-key case are
   not the same on the two sides.

   The key is checked and the out slot zeroed by the caller's [k] and by
   [Tast.Zero] here; the Option is built here rather than in the runtime,
   because the runtime answers 1/0 and fills [out] only when it answers 1. It
   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 map_lookup ctx ~want loc sym target kt vt k =
  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) sym
      [ 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
  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 ctx loc ~want
    (mk loc oty
       (Tast.Let ([ (ks, k);
                    (out, mk loc vt (Tast.Zero vt)) ],
                  [ mk loc oty (Tast.If (cond, some, none)) ])))

(* The braced-pairs scan a struct literal, a union value and a data case all
   do: each key is refused if it has already been given, with a note at the
   first mention, and the table of what was given comes back for the fill that
   follows. [noun] is the word the message uses — a union's are members, the
   other two have fields — and [~known] is the caller's own unknown-key
   refusal, run after the duplicate check on the same pair so that a key given
   twice is reported as the duplicate it is rather than as whatever the second
   mention is. A caller that wants its unknown-key pass run over all the pairs
   first, before any of this, passes no [~known] and keeps its own loop. *)
let given_once ~noun ?(known = fun _ _ -> ()) kvs =
  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") ]
            "%s %s is given twice" noun k
        | None -> ());
       known k v;
       Hashtbl.add seen k v)
    kvs;
  seen

(* ── Counting a library's resources ─────────────────────────────────

   [Shim.resources] says which bindings acquire, release or change a resource
   in place. The generated wrapper of each one carries [%res-acquire],
   [%res-release] and [%res-done] forms over its own locals — names the reader
   cannot produce, so no program can write them — and the call site opens the
   note with where it is. The runtime pairs the two by the binding's name.

   A resource is known by one field, not by its whole value: a program sets
   [looping] on a Music or the [transform] of a Model and still unloads the
   same resource. The field is the first pointer in the struct, depth first —
   an Image's pixels, a Sound's audio buffer, a Mesh's vertices, a Model's
   meshes — and, in a struct that holds no pointer, a field named [id], which
   is how a Texture2D or a RenderTexture2D names its GPU object. A struct with
   neither is keyed by every leaf field, hashed separately so padding never
   reaches the key.

   Every note is a [flan_dev_reg_note_] call. A release build drops that
   family before building its arguments, and none of the notes binds a slot,
   so what a release build emits is exactly what it emitted before the notes
   existed. *)
let res_field env (t : Types.t) : int list option =
  let fields n =
    match Hashtbl.find_opt env.structs n with
    | Some s -> s.Tast.fields
    | None -> []
  in
  let rec first_ptr t =
    match t with
    | Types.Named n when Hashtbl.mem env.structs n ->
      List.find_map
        (fun (i, (f : Tast.field)) ->
           match f.Tast.fty with
           | Types.Ptr _ -> Some [ i ]
           | ft -> Option.map (fun p -> i :: p) (first_ptr ft))
        (List.mapi (fun i f -> (i, f)) (fields n))
    | _ -> None
  in
  match first_ptr t with
  | Some p -> Some p
  | None ->
    (match t with
     | Types.Named n ->
       List.find_map
         (fun (i, (f : Tast.field)) ->
            if String.equal f.Tast.fname "id" then Some [ i ] else None)
         (List.mapi (fun i f -> (i, f)) (fields n))
     | _ -> None)

let rec res_hash loc env (e : Tast.expr) : Tast.expr =
  let seed = mk loc hash_ty (Tast.Int (0L, Types.U64)) in
  match e.Tast.ty with
  | Types.Named n when Hashtbl.mem env.structs n ->
    let fields = (Hashtbl.find env.structs n).Tast.fields in
    snd
      (List.fold_left
         (fun (i, acc) (fl : Tast.field) ->
            let leaf = mk loc fl.Tast.fty (Tast.Field (e, i)) in
            (i + 1,
             rt loc hash_ty "flan_hash_combine" [ acc; res_hash loc env leaf ]))
         (0, seed) fields)
  | t -> rt loc hash_ty "flan_key_hash_flat" [ addr_of loc e; seed; size_of loc t ]

let res_key loc env (e : Tast.expr) : Tast.expr =
  match res_field env e.Tast.ty with
  | None -> res_hash loc env e
  | Some path ->
    let leaf =
      List.fold_left
        (fun (x : Tast.expr) i ->
           match x.Tast.ty with
           | Types.Named n ->
             let f = List.nth (Hashtbl.find env.structs n).Tast.fields i in
             mk loc f.Tast.fty (Tast.Field (x, i))
           | _ -> x)
        e path
    in
    res_hash loc env leaf

(* An argument that can be evaluated a second time and mean the same thing:
   a name, or the address of one or of a field of one. The in-place re-key
   reads its argument before and after the call, and anything with an effect
   in it is not re-keyed. *)
let rec res_pure (e : Tast.expr) =
  match e.Tast.e with
  | Tast.Local _ | Tast.Global _ -> true
  | Tast.Field (x, _) -> res_pure x
  | Tast.Addr p | Tast.Prim (Tast.AddrOf, [ { Tast.e = Tast.Addr p; _ } ]) ->
    res_place p
  | Tast.Prim (Tast.AddrOf, [ x ]) -> res_pure x
  | _ -> false

and res_place (p : Tast.place) =
  match p with
  | Tast.Plocal _ | Tast.Pglobal _ -> true
  | Tast.Pfield (t, _) -> res_pure t
  | _ -> false

let tracked_call loc env name (tr : Shim.track) ret (args : Tast.expr list) =
  let str x = mk loc Types.String (Tast.Str x) in
  let call = mk loc ret (Tast.Call (name, args)) in
  let opened =
    if tr.Shim.acquire || tr.Shim.releases <> [] then
      [ rt loc Types.Unit "flan_dev_reg_note_res_site" [ str name; here loc ] ]
    else []
  in
  let rekeyed =
    if ret <> Types.Unit then []
    else
      List.filter_map
        (fun i ->
           match List.nth_opt args i with
           | Some ({ Tast.ty = Types.Ptr (_, t); _ } as p) when res_pure p ->
             Some (mk loc t (Tast.Deref p), t)
           | _ -> None)
        tr.Shim.rekey
  in
  (* The old keys go to the runtime before the call and the new ones after,
     in the reverse order, so it can pair them on a stack. *)
  let before =
    List.map
      (fun (v, _) ->
         rt loc Types.Unit "flan_dev_reg_note_res_rekey_from" [ res_key loc env v ])
      rekeyed
  in
  let after =
    List.rev_map
      (fun (v, t) ->
         rt loc Types.Unit "flan_dev_reg_note_res_rekey_to"
           [ res_key loc env v; str (Types.to_string t) ])
      rekeyed
  in
  match opened @ before, after with
  | [], [] -> call
  | pre, post -> mk loc ret (Tast.Do (pre @ [ call ] @ post))

(* Every expression goes through here, and [check_value] is the one that
   knows the forms. What this adds is [refuse_owned_copy], asked of whatever
   came back unless the form was checked as the target of a place. *)

(* The conditions [check_truthy] has refused, each with the body it was
   checked in and its diagnostic, for as long as the outermost call is on the
   stack — see [check_truthy]. Physical identity on both, since a generic's
   body is the same syntax checked again at another type. *)
let truthy_failed :
  (Ast.expr * (string * binding) list * Types.t * Loc.diag) list ref = ref []

(* Whether two scopes bind the same names at the same types, which is what a
   refusal under them can depend on — the slots are fresh on every pass. A
   memo keyed on less would replay a refusal after a retry changed a type. *)
let same_scope (a : (string * binding) list) (b : (string * binding) list) =
  a == b
  || List.equal
       (fun (n, (x : binding)) (m, (y : binding)) ->
          String.equal n m && Types.equal x.bty y.bty)
       a b
let truthy_depth = ref 0

(* The same for an [if], keyed on its condition and the expectation:
   an [if] whose else arm is tried on its own terms first (see [check_if])
   would otherwise be re-checked, refused, by the trial of every [if] above
   it — the square of a refused or/and chain's length. *)
let if_failed :
  (Loc.t,
   Ast.expr * ((string * binding) list * Types.t) * (Types.t option * bool)
   * Loc.diag)
    Hashtbl.t =
  Hashtbl.create 16
let if_depth = ref 0

(* An arm refused at the other arm's type, keyed the same way: the arm is
   then checked on its own terms, and an [if] above it that checks it again
   — its own trial, then for real — finds the refusal here rather than
   walking the arm to it once more, which in a chain nested in else arms
   would be twice per level. Cleared for each program. *)
let arm_failed :
  (Loc.t,
   Ast.expr * ((string * binding) list * Types.t) * Types.t * Loc.diag)
    Hashtbl.t =
  Hashtbl.create 16

(* A dyn value opened at a typed want: the box, and the want it was opened
   at. Two arms that meet this way meet at dyn — the typed one is boxed, not
   the dyn one opened — whichever is written first. *)
let not_kept = "check/arm-not-kept"

let to_dyn ctx (x : Tast.expr) = expect ctx x.Tast.loc ~want:(Some Types.Dyn) x

let opened_dyn ~(box : Tast.expr -> Tast.expr) (v : Tast.expr) =
  (* An opening is a value position of its own, whatever shape the
     conversion built. *)
  let stop x = Opened.mem opened_by_want x in
  let any = ref false in
  Tast.iter_tails ~stop (fun x -> if stop x then any := true) v;
  if not !any then None
  else
    (* Every value position meets at dyn: an opened one is put back to the
       box it opened, and any other is boxed. *)
    Some
      (Tast.map_tails ~stop ~ty:Types.Dyn
         (fun x ->
            match Opened.find_opt opened_by_want x with
            | Some b -> b
            | None -> box x)
         v)


(* A Vec or a Map parameter is a copy of the caller's header — Odin's rule —
   so growing it reallocates a block only this function's copy points at, and
   the caller's container never sees the elements. The warnings found so far,
   one per parameter, printed by [build_program]; the parameters themselves
   are [grow_params], above [view_refusal], which reads them too. *)
let grow_warnings : Loc.diag list ref = ref []

let note_grown ctx op loc (target : Tast.expr) =
  (* The parameter the container is reached from, through struct fields
     taken by value — a field of a parameter is in the parameter's copy too —
     and the path written back out. A [Deref] ends the walk: through a
     pointer the caller's own storage is what grows. *)
  let rec root (e : Tast.expr) =
    match e.Tast.e with
    | Tast.Local s -> Some (s, fun p -> p)
    | Tast.Field (inner, i) ->
      (match inner.Tast.ty with
       | Types.Named n ->
         (match Hashtbl.find_opt ctx.env.structs n with
          | Some st when i < List.length st.Tast.fields ->
            let f = (List.nth st.Tast.fields i).Tast.fname in
            Option.map
              (fun (s, path) -> (s, fun p -> Printf.sprintf "(.%s %s)" f (path p)))
              (root inner)
          | _ -> None)
       | _ -> None)
    | _ -> None
  in
  match target.Tast.ty, root target, !grow_params with
  | ((Types.Vec _ | Types.Map _) as t), Some (s, path), (c, ps) :: _ when c == ctx ->
    (match List.assoc_opt s ps with
     | Some (p : Ast.field)
       when not
              (List.exists
                 (fun (d : Loc.diag) -> d.Loc.dloc = p.Ast.floc)
                 !grow_warnings) ->
       let ts = tyname loc t in
       let msg =
         match target.Tast.e with
         | Tast.Local _ ->
           Printf.sprintf
             "%s is a %s passed by value, a copy of the caller's header, so \
              the %s at %s grows this function's copy and the caller's \
              container never sees it. Take it as (Ptr %s) and write (%s \
              (deref %s) ...), and each caller passes (addr c) for its \
              container c"
             p.Ast.fname ts op (Loc.to_string loc) ts op p.Ast.fname
         | _ ->
           let pt = tyname loc (List.nth ctx.slot_tys (ctx.slots - 1 - s)) in
           Printf.sprintf
             "%s is a %s passed by value, a copy of the caller's, so the %s \
              at %s grows %s in this function's copy and the caller's never \
              sees it. Take it as (Ptr %s), where %s reaches the caller's own, \
              and each caller passes (addr c) for its %s c"
             p.Ast.fname pt op (Loc.to_string loc) (path p.Ast.fname) pt
             (path p.Ast.fname) pt
       in
       grow_warnings :=
         Loc.diag ~kind:"check/grown-parameter" p.Ast.floc msg :: !grow_warnings
     | _ -> ())
  | _ -> ()

(* Recovery, when [env.recovering] is on: a subexpression that is refused is
   recorded and stands as a [poison] of type [Never], which fits any want, so
   checking carries on around it and every error in a body is reported. What
   an earlier failure causes is not reported: an error raised by a node one of
   whose subexpressions failed, or with [Never] wanted, is dropped, as long as
   something has been recorded. That last condition keeps a poison from ever
   reaching a backend unreported — a scope with a poison in it always ends in
   a raise (see [with_recovery]). *)
let rec check ctx ?want (e : Ast.expr) : Tast.expr =
  let env = ctx.env in
  let guarded = env.guard_next in
  env.guard_next <- false;
  if (not env.recovering) || env.speculating > 0 || guarded then
    check_plain ctx ?want e
  else begin
    let seen = env.poison in
    let caused () =
      (env.recovered <> [] || Hashtbl.length env.infer_failed > 0)
      && (env.poison > seen || want = Some Types.Never)
    in
    match check_plain ctx ?want e with
    | r ->
      if is_poison r then env.poison <- env.poison + 1;
      r
    | exception Loc.Error d ->
      if not (caused ()) then begin
        record_recovered env d;
        (* A call refused as a whole — the wrong number of arguments, say —
           never checked its arguments, and a mistake inside one is still a
           mistake. They are checked on their own, with no expectation, so
           only what no expectation could change is kept: a name that is not
           there. *)
        match e.Ast.e with
        (* A type written in a value position — [map-new([const u8], i32)] —
           is not a value to look names up in. *)
        | Ast.Call ({ Ast.e = Ast.Var ("map-new" | "builtin/map-new"); _ }, args) ->
          recheck_args ctx (List.filteri (fun i _ -> i >= 2) args)
        | Ast.Call ({ Ast.e = Ast.Var ("vec-new" | "builtin/vec-new"); _ }, args) ->
          recheck_args ctx (List.filteri (fun i _ -> i >= 1) args)
        | Ast.Call (_, args) -> recheck_args ctx args
        | _ -> ()
      end;
      env.poison <- env.poison + 1;
      poison e.Ast.loc
    (* A checker arm that was never written for a [Never] operand may fail
       some other way over one. Only then, and only as a consequence. *)
    | exception (Not_found | Invalid_argument _ | Failure _ | Assert_failure _
                | Match_failure _) when caused () ->
      env.poison <- env.poison + 1;
      poison e.Ast.loc
  end

and recheck_args ctx (args : Ast.expr list) =
  let env = ctx.env in
  let before = env.recovered in
  List.iter (fun a -> ignore (check ctx a)) args;
  let rec fresh l = if l == before then [] else match l with [] -> [] | d :: r -> d :: fresh r in
  let kept =
    List.filter
      (fun (d : Loc.diag) ->
         String.starts_with ~prefix:"check/unknown-" d.Loc.kind
         || String.equal d.Loc.kind "check/private")
      (fresh env.recovered)
  in
  env.recovered <- kept @ before

and check_plain ctx ?want (e : Ast.expr) : Tast.expr =
  let place = ctx.place_ok in
  ctx.place_ok <- false;
  let r = check_value ctx ?want e in
  if not place then refuse_owned_copy ctx r;
  r

(* A form checked as the target of a place: indexed, sliced, a field read,
   measured, its address taken, or handed to a builtin that works on the
   container where it stands. *)
and check_target ctx (e : Ast.expr) =
  ctx.place_ok <- true;
  check ctx e

(* Decision 81 (2026-09-25). A value that owns storage — a Vec, a Map, or an
   array, Option or struct holding one — reached through a [[const T]] or a
   (Ptr const T) is not copied out as a value. Its header shares its block
   with the original, so a copy that could be grown, freed or handed on as
   writable would be the original written through. It is used where it
   stands instead: indexed, sliced (to a [[const T]]), its fields read when
   they own nothing, or its address taken as a (Ptr const T). Refusing at the
   source is the whole rule; there is no tracking of where a copy went. *)
and refuse_owned_copy ctx (r : Tast.expr) =
  match const_reached r with
  | Some view when owning ctx.env r.Tast.ty ->
    let fln = Source.indented_at r.Tast.loc in
    let t = tyname r.Tast.loc r.Tast.ty in
    let fix =
      match r.Tast.ty with
      | (Types.Vec _ | Types.Map _) when not (region_only ctx.env r.Tast.ty) ->
        Printf.sprintf "%s copies it into a %s of its own"
          (if fln then "clone(v)" else "(clone v)") t
      (* Nothing copies an array, an Option or a struct that owns storage,
         nor a container whose elements do: its address is the way to it. *)
      | _ ->
        Printf.sprintf "%s gives a %s to read it through"
          (if fln then "addr(v)" else "(addr v)")
          (tyname r.Tast.loc (Types.Ptr (Types.Const, r.Tast.ty)))
    in
    Loc.failk "check/const-owned-copy" r.Tast.loc
      "this copies a %s out of a %s, which can only be read, and the copy \
       would share its storage with the original. Use it where it stands — \
       index it, slice it or read its fields — or %s"
      t (tyname r.Tast.loc view) fix
  | _ -> ()

and check_value 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;
  let used = ctx.used || List.memq e ctx.kept in
  ctx.used <- false;
  let skipping = !skip_wrap in
  skip_wrap := false;
  match e.Ast.e with
  (* A literal where an (Option T) is wanted is built at T and then wrapped
     (decision 138): [s = -1] over an [i64?] is [Some] of an i64 -1. It has
     no type until one is asked of it, so it is asked the payload's, rather
     than being built at a default and wrapped at the wrong width. *)
  | Ast.Int _ | Ast.UInt _ | Ast.Float _ | Ast.Byte _ | Ast.Call _ | Ast.Arr (_ :: _)
    when (match want with Some (Types.Option _) -> not skipping | _ -> false)
         && (lone_literal e || (match e.Ast.e with Ast.Arr _ -> true | _ -> false)) ->
    let w = Option.get want in
    let t = match w with Types.Option t -> t | _ -> assert false in
    (match trial ctx (fun () -> check ctx ~want:t e) with
     | Ok v when Types.fits ~expected:t ~actual:v.Tast.ty -> mk loc w (Tast.Some_ v)
     | Ok v -> expect ctx loc ~want v
     (* Refused at T: checked again at the Option as it was before 138, so
        the refusal names what was wanted, [str?], and not only its payload. *)
     | Error _ ->
       skip_wrap := true;
       check ctx ?want e)
  (* A negative literal in a generic body, at an instantiation that made it
     unsigned. The cast the ordinary refusal names would be wrong at every
     other type the function is called at, so the fix is one that needs no
     negative number at all, and the refusal says which call asked. *)
  | Ast.Int n
    when Int64.compare n 0L < 0 && ctx.env.chain <> []
         && (match want with
             | Some (Types.Int k) -> not (Types.signed k)
             | _ -> false) ->
    let t = Option.get want in
    (* [instantiate] adds the note naming the call that asked for this copy. *)
    let gname, _, _ = List.nth ctx.env.chain (List.length ctx.env.chain - 1) in
    let var =
      match List.find_opt (fun (_, u) -> Types.equal u t) ctx.env.subst with
      | Some (v, _) -> Printf.sprintf "$%s = %s" v (tyname loc t)
      | None -> tyname loc t
    in
    Loc.failk literal_at_want loc
      "%Ld does not fit in %s, which holds no negative number, and %s is called \
       at %s — the body has to work at every type it is called at, so write \
       it with no negative literal, as in (- x %Ld) in place of (+ x %Ld)"
      n (tyname loc t) gname var (Int64.neg n) n
  | Ast.Int n -> int_literal loc ~want ~preds:ctx.env.tvpreds n
  | Ast.UInt (n, s) -> wide_literal loc ~want n s
  (* A char literal that ends up dyn is a dyn char, never an int. *)
  | Ast.Byte b when want = Some Types.Dyn ->
    rt loc Types.Dyn "flan_dyn_from_char"
      [ mk loc (Types.Int Types.I32) (Tast.Int (Int64.of_int b, Types.I32)) ]
  (* A char literal is a code point, and a byte type holds one only when it
     is ASCII: \é as a u8 would be 0xE9, which is not é in UTF-8 and never
     equals a byte of it. Refused by the char's name, not its number. *)
  | Ast.Byte b
    when (match want with
          | Some (Types.Int (Types.U8 | Types.I8)) -> b > 127
          | Some (Types.Int Types.I16) -> b > 32767
          | Some (Types.Int Types.U16) -> b > 65535
          | _ -> false) ->
    let t = tyname loc (Option.get want) in
    let c = Form.byte_repr b in
    if (match want with
                      | Some (Types.Int (Types.U8 | Types.I8)) -> true
                      | _ -> false)
    then
      Loc.failk literal_at_want loc
        "%s is %d bytes in UTF-8, not one, so it is not a %s. Write the str \
         \"%s\" for its bytes, or take its code point as an i32"
        c (String.length (Form.utf8 b)) t (Form.utf8 b)
    else
      Loc.failk literal_at_want loc
        "%s is code point %d, which does not fit in a %s. Take its code point \
         as an i32" c b t
  (* Where typed code wants a number the literal is that number, as an integer
     literal would be; everywhere else it is a char (decision 127). *)
  | Ast.Byte b
    when (match want with
          | Some (Types.Int _ | Types.Float _) -> true
          | Some (Types.Var v) -> declares ctx.env.tvpreds v "is-numeric"
          | _ -> false) ->
    int_literal loc ~want ~preds:ctx.env.tvpreds (Int64.of_int b)
  | Ast.Byte b ->
    expect ctx loc ~want (mk loc Types.Char (Tast.Int (Int64.of_int b, Types.U32)))
  (* The float literal's own dyn case, for the reason the integer's has one:
     the ABI carries one width and the literal is built at it. f64 is already
     what an unconstrained float literal defaults to, so this only has to stop
     the "expected dyn, found the float literal" arm below from firing. *)
  | Ast.Float x when want = Some Types.Dyn ->
    box loc (mk loc dyn_f64 (Tast.Float (x, Types.F64)))
  | Ast.Float x ->
    let k =
      match want with
      | Some (Types.Float k) -> k
      (* A float literal at a type variable, refused even under [is-numeric] —
         the asymmetry with the integer literal above is deliberate and is the
         same asymmetry the concrete arms already have. An untyped integer
         constant is usable wherever a float is wanted; a float literal is
         never usable where an integer is wanted (Odin's rule, stated at the
         [Int] case). So [is-numeric] admits integers, and a body written with a
         float literal has no meaning at the integer half of its own bound.
         Refusing here keeps that a refusal at the definition rather than one
         that surprises whichever call site first instantiates at [i32]. *)
      | Some (Types.Var v) ->
        (* Under {:where (is-integer $t)} the sentence is simpler and its own:
           the bound has no float half at all, so the literal has no meaning
           at *any* type the variable can become, not merely at some. *)
        if declares ctx.env.tvpreds v "is-integer" then
          Loc.failk literal_at_want loc
            "the float literal %g cannot stand where $%s is wanted — \
             {:where (is-integer $%s)} admits no float type. Write an integer \
             literal, or take the value as a parameter"
            x v v
        else
          Loc.failk literal_at_want loc
            "the float literal %g cannot stand where $%s is wanted — %s may \
             be instantiated at an integer type. Write an integer literal, \
             which is admitted at every numeric type, or take the value as a \
             parameter"
            x v
            (if declares ctx.env.tvpreds v "is-numeric" then
               Printf.sprintf "{:where (is-numeric $%s)} admits integers too, so $%s" v v
             else Printf.sprintf "$%s" v)
      | Some other when other <> Types.Never ->
        Loc.failk literal_at_want loc "expected %s, found the float literal %g"
          (tyname loc other) x
      | _ -> float_default ()
    in
    (* Where f32 is wanted, a literal past its range would be infinity or 0,
       silently. *)
    (if k = Types.F32 && Float.is_finite x && x <> 0.0 then
       let f = Int32.float_of_bits (Int32.bits_of_float x) in
       if Float.is_integer f && f = 0.0 then
         Loc.failk literal_at_want loc
           "%g is too small for f32, which rounds it to 0 — the smallest \
            f32 above 0 is about 1.4e-45" x
       else if not (Float.is_finite f) then
         Loc.failk literal_at_want loc
           "%g does not fit in f32, whose largest value is about 3.4e38" x);
    mk loc (Types.Float k) (Tast.Float (x, k))
  | Ast.Str s when want = None && lit_has "dyn" && not !typed_literals -> box loc (mk loc Types.String (Tast.Str s))
  | Ast.Str s -> expect ctx loc ~want (mk loc Types.String (Tast.Str s))
  | Ast.Kw k ->
    (* Two keywords in one spelling, told apart by the expectation. Where an
       enum type is expected, :space resolves at compile time against its
       members and a typo is an error here rather than a wrong number at run
       time (plan.org, settled: keywords at typed call sites) — no runtime
       value exists at all. Everywhere else :foo is a first-class dyn value,
       interned by the runtime so two spellings of one name are one word and
       equality is an identity compare. The enum reading keeps priority
       because it existed first and costs nothing; nothing is lost, since a
       site that wants the dyn keyword against an enum expectation has none. *)
    (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 ->
          (* The near miss first, because the raylib enums carry a
             disambiguating member prefix — [:r] is four edits from [:key-r]
             and one thought, and the list alone makes the reader do the
             thought. The list still follows: the suggestion can be wrong. *)
          (match member_near_miss members k with
           | Some (m, _) ->
             fail loc "%s has no member :%s — did you mean :%s? It has %s"
               name k m
               (String.concat " "
                  (List.map (fun (m, _) -> ":" ^ m) members))
           | None ->
             fail loc "%s has no member :%s — it has %s" name k
               (String.concat " "
                  (List.map (fun (m, _) -> ":" ^ m) members))))
     | Some Types.Dyn | None ->
       expect ctx loc ~want
         (rt loc Types.Dyn "flan_dyn_kw" [ mk loc Types.String (Tast.Str k) ])
     | Some other ->
       fail loc
         ":%s is an enum member where an enum is expected and a dyn keyword \
          elsewhere, but %s is expected here" k
         (tyname loc other))
  (* {:a 1 :b s} — a dyn map, built where it stands. Always dyn: the
     runtime owns the storage the way (vec-new dyn) does, keys and values are
     both dyn words, and a typed want other than dyn refuses through [expect]
     like any other dyn value would. The literal lowers to a fresh slot — a
     rooted one, because a slot of type dyn is what [Emit.root_plan] counts — so
     the map stays reachable across the allocations its own entries make. *)
  | Ast.MapLit (tag, kvs) ->
    let m = fresh_slot ctx Types.Dyn in
    let mval = mk loc Types.Dyn (Tast.Local m) in
    (* A class's constructor stores through [flan_dyn_slot_init], which is
       the plain store plus the slot's type check, worded for the
       constructor rather than for a [put] nobody wrote. *)
    let sets =
      List.map
        (fun ((k : Ast.expr), v) ->
           let args =
             [ mval; check ctx ~want:Types.Dyn k; check ctx ~want:Types.Dyn v ]
           in
           (* The key's location is the slot's, in the defclass: the
              constructor has no other place of its own to name. *)
           if tag = None then rt loc Types.Unit "flan_dyn_map_set" args
           else rt loc Types.Unit "flan_dyn_slot_init" (args @ [ here k.Ast.loc ]))
        kvs
    in
    (* A shape tag, if this is the literal a class's constructor was written
       from. It is the class's name interned as a keyword, and it goes into
       the object's header rather than into the entries — so everything below
       this line, the rooting included, is the untagged case unchanged. *)
    let empty =
      match tag with
      | None -> rt loc Types.Dyn "flan_dyn_map_new" []
      | Some cls ->
        (* The class's slots and their types ride along, so the first
           instance built registers the class with the runtime and every
           store after it — this literal's own included — is checked. A
           class registered already, by an earlier instance or by a reload,
           keeps what it has: redefining one is a reload's business. *)
        let spec =
          match Hashtbl.find_opt ctx.env.classes cls with
          | Some slots -> class_spec_of slots
          | None -> ""
        in
        rt loc Types.Dyn "flan_dyn_map_new_class"
          [ rt loc Types.Dyn "flan_dyn_kw" [ mk loc Types.String (Tast.Str cls) ];
            mk loc Types.String (Tast.Str spec) ]
    in
    expect ctx loc ~want
      (mk loc Types.Dyn (Tast.Let ([ (m, empty) ], sets @ [ mval ])))
  | Ast.Quote _ ->
    unimplemented loc "a quoted symbol (restart names)" 6
  (* A length variable read as a value is the integer it was bound to, as a
     literal — so it takes its width from where it stands, the way a written
     8 would. In the abstract pass it is a 1: a literal that fits every
     integer type, since the real one is answered again per copy. A local of
     the same name shadows it. *)
  | Ast.Var name
    when (List.mem name ctx.env.lenvars
          || (match List.assoc_opt name ctx.env.subst with
              | Some (Types.Len _) -> true
              | _ -> false))
         && lookup ctx name = None ->
    let n =
      match List.assoc_opt name ctx.env.subst with
      | Some (Types.Len n) -> n
      | _ -> 1L
    in
    check ctx ?want { e with Ast.e = Ast.Int n }
  | Ast.Var name -> var ctx loc ~want name
  | Ast.Do body -> ctx.tail <- tail; ctx.used <- used; 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 ~used ?want ~defer_ok loc bs body
  | Ast.If (c, t, e') -> check_if ctx ~tail ~used ?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 names = narrows c in
    let c = check_truthy ctx c in
    let body = in_loop ctx ?label (fun () ->
      scoped ctx (fun () ->
          with_narrowed ctx names (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 ctx 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"
      (match ctx.in_frames with Some n -> n | None -> assert false)

  | Ast.Return v when ctx.ret == infer_ret ->
    let lit = match v with Some x -> adapts x | None -> false in
    let v = Option.map (check ctx) v in
    infer_seen :=
      (match v with
       | Some (x : Tast.expr) -> (x.Tast.ty, loc, lit)
       | None -> (Types.Unit, loc, false))
      :: !infer_seen;
    (match ctx.defers, v with
     | [], _ -> mk loc Types.Never (Tast.Return v)
     (* Thrown away after, so the order the defers run in is not built. *)
     | ds, _ -> mk loc Types.Never (Tast.Do (ds @ [ mk loc Types.Never (Tast.Return v) ])))
  | 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"
            (tyname loc ctx.ret);
        None
      | Some v -> Some (check ctx ~want:ctx.ret v)
    in
    (* The value is computed first, then whatever has been deferred *so far*
       runs, then the function returns — the order the fall-off-the-end path
       in [check_fn] has, so [(return x)] and a last form [x] agree. A defer
       written below this return has not executed yet and must not fire. *)
    (match ctx.defers, v with
     | [], _ -> mk loc Types.Never (Tast.Return v)
     | ds, Some (value : Tast.expr)
       when not (Types.equal value.Tast.ty Types.Never
                 || Types.equal value.Tast.ty Types.Unit) ->
       let s = fresh_slot ctx value.Tast.ty in
       let r =
         mk loc Types.Never
           (Tast.Return (Some (mk loc value.Tast.ty (Tast.Local s))))
       in
       mk loc Types.Never (Tast.Let ([ (s, value) ], ds @ [ r ]))
     (* A unit value has nothing to keep, and is still evaluated first. *)
     | ds, Some value when Types.equal value.Tast.ty Types.Unit ->
       mk loc Types.Never
         (Tast.Do
            ((value :: ds)
             @ [ mk loc Types.Never (Tast.Return (Some (unit_at loc))) ]))
     (* A value that never arrives is computed first too, and the defers
        after it are unreachable: a trap runs none, and a transfer out of it
        runs the function's [fdefers]. *)
     | _, Some _ -> mk loc Types.Never (Tast.Return v)
     | ds, None ->
       mk loc Types.Never
         (Tast.Do (ds @ [ mk loc Types.Never (Tast.Return None) ])))
  (* (set (at target i) x) against a dyn target — a dyn vec from (vec-new
     dyn), or a typed container's own view (M2 item 3) — is a call and not a
     place: [flan_dyn_set_at] tag-checks [x]'s dyn tag against what the vec
     or the view holds and traps on a mismatch, which is not a memory write
     [Tast.Set] could express through a pointer. [target] is checked once,
     here, and handed to [vec_at]/[indexed] unchecked in the [else] branch
     below rather than re-checked by [check_place] — checking it twice would
     evaluate a target with a side effect twice. A dyn target indexed more
     than once — nothing in this milestone builds one — still falls to the
     ordinary [Ast.Set] arm below, and [indexed] refuses it by name. *)
  | Ast.Set (Ast.Pindex (target, [ idx ]), v) ->
    let target = check_target ctx target in
    if target.Tast.ty = Types.Dyn then
      let i = check ctx ~want:Types.Dyn idx in
      let v = check ctx ~want:Types.Dyn v in
      expect ctx loc ~want
        (rt loc Types.Unit "flan_dyn_set_at" [ target; i; v; here loc ])
    else begin
      let p, pty =
        match target.Tast.ty with
        | Types.Vec _ ->
          let pp, ty = vec_at ctx loc target [ idx ] in
          Tast.Pderef pp, ty
        | _ ->
          (* [~place], for the reason [check_place] passes it: [indexed]
             accepts a string, and this arm never reaches [check_place]. *)
          let iidx, ty = indexed ~place:loc ctx target [ idx ] in
          Tast.Pindex (target, iidx), ty
      in
      let v = check ctx ~want:pty v in
      expect ctx loc ~want (mk loc Types.Unit (Tast.Set (p, v)))
    end
  (* (set (get inst :slot) x) — a class instance's declared slot. A call and
     not a place for [flan_dyn_set_at]'s reason: the runtime has to look at
     the value to know it is an instance, which of its slots the key names,
     and whether [x] fits the type that slot was declared with, and it traps
     on each with a sentence of its own. A typed map has no such place; its
     entries are written with [put]. *)
  | Ast.Set (Ast.Pslot (target, k), v) ->
    let target = check ctx target in
    if target.Tast.ty <> Types.Dyn then
      fail loc
        "(get m k) is a place only on a class instance, and this is %s. A \
         map's entries are written with put"
        (tyname loc target.Tast.ty);
    let k = check ctx ~want:Types.Dyn k in
    let v = check ctx ~want:Types.Dyn v in
    expect ctx loc ~want
      (rt loc Types.Unit "flan_dyn_slot_set" [ target; k; v; here loc ])
  (* A name narrowed by [if x?] takes a value of its payload's type, which
     keeps it present. An Option would end the narrowing partway through the
     block, so it is refused (decision 133): the block reads x as present
     throughout. *)
  | Ast.Set (Ast.Pvar n, v)
    when (match lookup ctx n with Some b -> b.bwhat = Some narrowed_tag | None -> false) ->
    let b = Option.get (lookup ctx n) in
    (* A parameter or a captured copy is refused as it is outside the block. *)
    let place, _ = check_place ctx loc (Ast.Pvar n) in
    (match trial ctx (fun () -> check ctx ~want:b.bty v) with
     | Ok vv -> expect ctx loc ~want (mk loc Types.Unit (Tast.Set (place, vv)))
     | Error d ->
       (match trial ctx (fun () -> check ctx ~want:(Types.Option b.bty) v) with
        | Ok { Tast.ty = Types.Option _; _ } ->
          fail loc
            "%s is tested with %s? above, so in this block it is %s, and it \
             cannot be given an Option here: the block reads it as present \
             throughout. Assign a %s, or test a new name, as in while %s as \
             item, and assign %s from that"
            n n (tyname loc b.bty) (tyname loc b.bty) n n
        | _ -> raise (Loc.Error d)))
  | Ast.Set ((Ast.Pvar n as p), v) when lit_recorded ctx n <> None ->
    let key = Option.get (lit_recorded ctx n) in
    let p, pty = check_place ctx loc p in
    let v = lit_down ctx key pty v in
    expect ctx loc ~want (mk loc Types.Unit (Tast.Set (p, v)))
  (* (set (.name x) v) on a dyn is (put x :name v): a class slot's declared
     type is checked by put, and a map takes a key it did not hold. Not
     [flan_dyn_slot_set], which refuses a plain map — .name reads either, so
     assigning it writes either. The target is checked once, here. *)
  | Ast.Set (Ast.Pfield (target, name), v) ->
    let t = check_target ctx target in
    if t.Tast.ty = Types.Dyn then begin
      refuse_const_change ctx loc t;
      let k = dyn_kw ctx loc name in
      let v = check ctx ~want:Types.Dyn v in
      expect ctx loc ~want
        (rt loc Types.Unit "flan_dyn_map_put" [ t; k; v; here loc ])
    end else begin
      let p, pty = field_place ~store:true ctx loc target t name in
      let v = check ctx ~want:pty v in
      expect ctx loc ~want (mk loc Types.Unit (Tast.Set (p, v)))
    end
  | Ast.Set (p, v) ->
    let p, pty = check_place ctx loc p in
    let v = check ctx ~want:pty v in
    expect ctx loc ~want (mk loc Types.Unit (Tast.Set (p, v)))
  (* On a dyn, (.name x) is (get x :name) — the same call, so a missing key is
     nil and a value that is not a map traps with get's own sentence. *)
  | Ast.Field (target, name) ->
    let t = check_target ctx target in
    if t.Tast.ty = Types.Dyn then
      expect ctx loc ~want
        (rt loc Types.Dyn "flan_dyn_get" [ t; dyn_kw ctx loc name; here loc ])
    else
    let target, sname = struct_of ctx target t 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" (tyname loc (Types.Named sname)) name
     | Some i ->
       let fty = (List.nth s.Tast.fields i).Tast.fty in
       expect ctx loc ~want (mk loc fty (Tast.Field (target, i))))
  | Ast.Struct (name, kvs) -> check_struct ctx ~want loc name kvs
  | Ast.Bare kvs -> check_bare ctx ~want loc kvs
  (* A bracket literal where a dyn is wanted is the runtime's own vec, built
     where it stands — the same lowering the map literal gets, and what makes
     {:xs [1 2]} mean what it reads as. Everywhere else brackets stay the
     fixed-array literal they always were. *)
  | Ast.Arr items when want = Some Types.Dyn ->
    dyn_vec ctx loc (map_lr (fun x -> check ctx ~want:Types.Dyn x) items)
  | Ast.Arr items when want = None && lit_has "dyn" && not !typed_literals ->
    dyn_vec ctx loc (map_lr (fun x -> check ctx ~want:Types.Dyn x) items)
  | 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 ctx loc ~want (mk loc ty (Tast.Zero ty))
  (* Parse writes one only into a type position of a call named vec-new or
     map-new, and the builtins read it before it could get here. A program's
     own function of that name does not. *)
  | Ast.TypeArg _ ->
    fail loc "this is a type, and a value is wanted here"
  | Ast.ArrayFill (dims, v) -> check_array_fill ctx ~want loc dims v
  | Ast.ArrayGen (dims, f) -> check_array_gen ctx ~want loc dims f
  | Ast.The (t, v) -> check_the ctx ~want loc t v
  | Ast.Match (scrutinee, arms) -> check_match ctx ~tail ~used ?want loc scrutinee arms
  | Ast.IfLet (scrutinee, arm, els) ->
    check_if_let ctx ~tail ~used ?want loc scrutinee arm els
  | Ast.Chain (n, v, body) -> check_chain ctx ~want loc n v body
  | Ast.Narrow (names, body) ->
    with_narrowed ctx names (fun () ->
        ctx.tail <- tail; ctx.used <- used; check ctx ?want body)
  | Ast.Alias (pairs, body) ->
    scoped ctx (fun () ->
        List.iter
          (fun (g, h) ->
             match lookup ctx h with
             | Some b -> ctx.scope <- (g, b) :: ctx.scope
             | None -> ())
          pairs;
        ctx.tail <- tail; ctx.used <- used; check ctx ?want body)
  (* Constant integer arithmetic where a type variable is wanted is folded to
     the literal it computes first, so [(+ x (+ 1 2))] is admitted wherever
     [(+ x 3)] is. The instantiation re-checks the form unfolded, at a concrete
     type, where the ordinary arithmetic is fine. *)
  | Ast.Call ({ Ast.e = Ast.Var ("+" | "-" | "*" | "/" | "%"); _ }, _)
    when (match want with Some (Types.Var _) -> true | _ -> false)
         && literal_arith e <> None ->
    int_literal loc ~want ~preds:ctx.env.tvpreds (Option.get (literal_arith e))
  | Ast.Call (head, args) ->
    let outer = ctx.kept in
    (* A with-allocator's arguments after the first are a body, run in
       order, and not values. *)
    (match head.Ast.e with
     | Ast.Var ("with-allocator" | "builtin/with-allocator") -> ctx.kept <- []
     | _ -> ctx.kept <- args);
    Fun.protect ~finally:(fun () -> ctx.kept <- outer)
      (fun () -> 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
     | _ when ctx.ret == infer_ret ->
       Loc.failk "check/infer-some" loc
         "some returns None from the function when there is nothing, and \
          this function's return type is read off its body, which cannot \
          say what the Option holds. Write the return type: (Option T)"
     | Types.Option _ ->
       let v = check ctx v in
       (match v.Tast.ty with
        | Types.Option t ->
          expect ctx loc ~want (mk loc t (Tast.UnwrapSome v))
        | other ->
          fail loc "some takes an (Option T), found %s" (tyname loc other))
     | other ->
       fail loc
         "some early-returns None, so the enclosing function must return an \
          Option; this one returns %s" (tyname loc 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, bounds, body) ->
    check_dotimes ctx ~want loc label name bounds 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
      (* Its own arm ahead of the general one. "A condition is a struct, not
         dyn" is true and useless here: a dyn holding a condition struct is
         one edit away from working, and the edit is naming the struct type.
         Since the descriptors landed, the fields inside it may be dyn — which
         is the half of the answer the general sentence would have hidden. *)
      | Types.Dyn ->
        fail c.Tast.loc
          "a condition is matched by its type and dyn is not one — write the \
           condition's struct type, whose dyn fields are fine"
      | t ->
        fail c.Tast.loc
          "a condition is a struct, not %s" (tyname loc t)
    in
    (* A condition that *holds* a dyn is not refused. The condition crosses as
       a pointer to a value in the signalling frame, and that value is on the
       collector's
       root stack with its type's descriptor beside it — which is exactly the
       shape the transfer needed and could not have. Where the condition is
       not a place, the backends evaluate it into a rooted slot rather than a
       scratch temporary, so a handler that allocates cannot collect the
       payload it was handed. See [Emit.addr_rooted]. *)
    (* §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 ctx loc ~want
      (mk loc ty (Tast.Signal (kind, condition_desc ctx loc name, c)))

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

  (* 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";
    let written = args in
    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"
             (tyname loc a.Tast.ty)
         | _ -> ())
      args;
    let sg = restart_sig (List.map (fun (a : Tast.expr) -> a.Tast.ty) args) in
    (* What the run-time refusal needs to write its fix, after the signature
       and a 0x1f: the syntax (i indented, p parenthesised), then each
       argument as written, or x. Only the message reads past the 0x1f; the
       comparison is on [type_id sg]. *)
    let said =
      let spell (a : Ast.expr) =
        match a.Ast.e with
        | Ast.Float x ->
          let t = Printf.sprintf "%g" x in
          if String.exists (fun c -> c = '.' || c = 'e' || c = 'n' || c = 'i') t
          then t else t ^ ".0"
        | _ ->
          (* The argument as written, when it is on one line of a file the
             checker can read; otherwise an ellipsis. *)
          let l = a.Ast.loc in
          match Loc.source_line l with
          | Some line
            when l.Loc.macro = None && l.Loc.eline = l.Loc.line && l.Loc.col >= 1
                 && l.Loc.ecol > l.Loc.col && l.Loc.ecol - 1 <= String.length line ->
            String.sub line (l.Loc.col - 1) (l.Loc.ecol - l.Loc.col)
          | _ -> spell_arg "\u{2026}" a
      in
      String.concat "\x1f"
        (sg :: (if fln_source loc then "i" else "p") :: List.map spell written)
    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, said, type_id sg, loc))
    in
    expect ctx 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 always runs at function \
         exit. Write it at the top level of the function body, or in a let \
         that is itself at the top level"
        ctx.defer_block;
    register_defer ctx loc forms

and int_literal loc ~want ?(preds = []) ?(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 integer literal where a *type variable* is wanted: the abstract pass
     over a generic body, checking [(> x 0)] or [(+ x 1)] with [x] at [$t].

     It is admitted exactly when [$t] is declared [is-numeric], and that bound is
     what makes it sound rather than optimistic: every type [is-numeric] admits
     is an integer or a float, and an untyped integer constant is usable at all
     of them — the same rule the [Float k] arm below encodes for a concrete
     float. So there is no instantiation of a [is-numeric] variable at which this
     literal has no meaning, which is the promise the abstract pass exists to
     make.

     The node built here is never emitted. A generic body produces no code; the
     instantiation re-checks the same form with [$t] substituted, and then the
     [Int k] or [Float k] arm above builds the literal at the concrete type and
     runs the range check. [I64] is the placeholder width and is chosen only so
     that a value too wide for [I32] survives the abstract pass to be ranged at
     the instantiation that actually has a type — [(defn f [x $t] $t (+ x 300))]
     is fine at [i32] and a refusal at [u8], and [u8] is where it is refused. *)
  | Some (Types.Var v) when declares preds v "is-numeric" ->
    mk loc (Types.Var v) (Tast.Int (n, Types.I64))
  (* A literal in dyn position takes i64 and not the i32 an unconstrained one
     defaults to. This is where "dyn integers are i64" stops being a statement
     about the ABI and becomes one about the language: [(defonce x dyn 5)] holds
     an i64 five, and the defaulting question a wider set of boxes would raise
     never arises because there is only the one box. Handled here rather than
     left to [expect] so the literal is *built* at the right width — the range
     check below is the one that matters, and 3000000000 is a dyn integer even
     though it is not an i32. *)
  | Some Types.Dyn ->
    box loc (mk loc dyn_i64 (Tast.Int (in_range loc Types.I64 n, Types.I64)))
  (* 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))
  (* The same position without the bound. An unconstrained variable supports
     only what every type supports, and holding a number is not that, so the
     refusal names the bound that would admit it rather than reporting a type
     mismatch the programmer cannot act on. *)
  | Some (Types.Var v) ->
    Loc.failk literal_at_want loc
      "the integer literal %Ld cannot stand where $%s is wanted — nothing \
       declares $%s numeric. Write {:where (is-numeric $%s)} at the head of \
       the body"
      n v v v
  | Some Types.Char ->
    Loc.failk literal_at_want loc
      "the integer literal %Ld is not a char, and a char compares only with \
       a char. Take its code point with %s, or make a char with %s"
      n (if Source.indented_at loc then "i32(c)" else "(i32 c)")
      (if Source.indented_at loc then Printf.sprintf "char(%Ld)" n
       else Printf.sprintf "(char %Ld)" n)
  | Some other when other <> Types.Never ->
    Loc.failk literal_at_want loc "expected %s, found the integer literal %Ld"
      (tyname loc other) n
  | _ -> mk loc (Types.Int default) (Tast.Int (in_range loc default n, default))

(* A wide literal where a dyn is wanted. A global's initialiser adds the fix
   (its type); anywhere else there is nothing to retype. *)
and wide_at_dyn s =
  Printf.sprintf
    "expected dyn, found the integer literal %s, which is above the largest \
     dyn int (9223372036854775807), so it has no dyn value" s

(* An integer written at or above 2^63, in decimal or in hex. Only a u64 holds
   one, so it is accepted there and refused everywhere else, in the spelling it
   was written in — its pattern read as an i64 is a different number. *)
and wide_literal loc ~want n s =
  match want with
  | Some (Types.Int Types.U64) -> mk loc (Types.Int Types.U64) (Tast.Int (n, Types.U64))
  | Some (Types.Int k) ->
    Loc.failk literal_at_want loc "%s does not fit in %s" s (Types.ikind_name k)
  | Some (Types.Float _ as t) ->
    Loc.failk literal_at_want loc
      "%s is too large for any integer type but u64, and an integer literal \
       where %s is wanted is read as one — write (%s (u64 %s))"
      s (tyname loc t) (tyname loc t) s
  | Some Types.Never | None ->
    Loc.failk literal_at_want loc
      "%s does not fit in i32, the type an integer literal takes when nothing \
       says otherwise — write (u64 %s) for a u64"
      s s
  | Some Types.Dyn -> Loc.failk literal_at_want loc "%s" (wide_at_dyn s)
  | Some other ->
    Loc.failk literal_at_want loc
      "expected %s, found the integer literal %s, which only a u64 holds"
      (tyname loc other) s

(* 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 ?(pattern = false) 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)
    (* A literal at or above 2^63 is a [UInt] and never reaches here as a
       literal; see [wide_literal]. [pattern] is the folded-constant path,
       which holds a u64 as its 64-bit pattern and cannot tell 2^64 - 1 from
       -1, so there every pattern is a u64. *)
    else if bits = 64 then pattern || Int64.compare n 0L >= 0
    else
      Int64.compare n 0L >= 0
      && Int64.compare n (Int64.shift_left 1L bits) < 0
  in
  if ok then n
  else if Int64.compare n 0L < 0 && not (Types.signed k) then
    (* A negative number at an unsigned type is never the value it reads as.
       The cast is how to ask for the bit pattern, and names what it is. *)
    let mask =
      if bits = 64 then -1L else Int64.sub (Int64.shift_left 1L bits) 1L
    in
    let tn = Types.ikind_name k in
    Loc.failk literal_at_want loc
      "%Ld does not fit in %s, which holds no negative number — write (%s %Ld) \
       for the %s with the same bits, %Lu"
      n tn tn n tn (Int64.logand n mask)
  else Loc.failk literal_at_want 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 ?(qualified = false) loc ~want name =
  match name with
  (* The qualifier in a value position: [builtin/nil], [builtin/true],
     [builtin/context/allocator] — the last one falls out for free, since
     stripping one prefix off it leaves a name this match has an arm for.

     A qualified name that gets past these arms must be refused and not
     handed on to the tables below, which is the whole difference between
     this and the call path. Falling through would look up [length] in
     [env.fns] and answer with the address of the very definition the reader
     wrote [builtin/] to get away from — the feature inverted, silently. So
     the catch-all arm below asks [qualified] before it looks anything up. *)
  | _ when not qualified && qualified_builtin name <> None ->
    let bare = Option.get (qualified_builtin name) in
    if not (Hashtbl.mem builtin_set bare) then not_a_builtin loc bare;
    var ctx ~qualified:true loc ~want bare
  | "true" | "false" ->
    expect ctx loc ~want (mk loc Types.Bool (Tast.Bool (name = "true")))
  (* The dyn absence value, written down. It arrived with maps — (get m k) on
     a key the map does not hold answers it — and this is its producer, so a
     program can store one, compare against one, and put one in a map. It is
     always dyn here: whatever it becomes at a typed want — None at an
     (Option T), a refusal at a bare T — is [expect]'s boundary logic, M2
     item 4. *)
  | "nil" ->
    expect ctx loc ~want (rt loc Types.Dyn "flan_dyn_nil" [])
  (* [Dir.north]: an enum's member named through its type, as a data case is
     [Shape.Rect]; the same value as [:north] where a Dir is expected. *)
  | _ when lookup ctx name = None && enum_member ctx.env name <> None ->
    let head = String.sub name 0 (String.rindex name '.') in
    let field = String.sub name (String.length head + 1) (String.length name - String.length head - 1) in
    (* A local named like the enum shadows it, as a local shadows any
       global: [Dir.north] is then that local's field. *)
    if lookup ctx head <> None then
      check ctx ?want { Ast.e = Ast.Field ({ Ast.e = Ast.Var head; loc }, field); loc }
    else
      let e, v = Option.get (enum_member ctx.env name) in
      expect ctx loc ~want (mk loc (Types.Enum e) (Tast.Int (v, Types.I32)))
  | "None" ->
    (match want with
     | Some (Types.Option t) -> mk loc (Types.Option t) Tast.None_
     (* The mirror of [nil] becoming [None]: at a dyn want, None *is* nil,
        with nothing to build and nothing to check — there is only one dyn
        absence and this is it, not an (Option T) that then gets boxed. *)
     | Some Types.Dyn -> rt loc Types.Dyn "flan_dyn_nil" []
     | Some other when other <> Types.Never ->
       fail loc "expected %s, found None" (tyname loc other)
     | _ ->
       fail loc
         "nothing here says what None is an Option of — use it where an \
          Option is expected, or name one, as in %s"
         (if fln_source loc then "the(Option(i32), None)" else "(the (Option i32) None)"))
  (* 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 ctx loc ~want
      (let s = fresh_slot ctx Types.Alloc in
       mk loc Types.Alloc
         (Tast.Let
            ([ (s, mk loc Types.Alloc (Tast.Zero Types.Alloc)) ],
             [ rt loc Types.Unit "flan_context_value"
                 [ addr_of loc (mk loc Types.Alloc (Tast.Local s)) ];
               mk loc Types.Alloc (Tast.Local s) ])))
  | "context/temp" ->
    expect ctx loc ~want
      (seal_alloc ctx loc (rt loc raw_alloc "flan_context_temp" []))
  | _ when qualified ->
    (* In [builtin_set] — the arm above checked — but not one of the four
       arms above this one, so it is a builtin that exists only as a call.
       There is no value to hand back: a builtin is an arm in the compiler,
       not a function in the program, so it has no address for a [Tast.FnAddr]
       to carry. Bare [length] in this position says "unknown name"; this says
       the true thing instead, which is that the name is real and the position
       is wrong. *)
    fail loc
      "%s%s is the builtin %s, which is a call and not a value — a builtin \
       has no address to pass. Write (%s%s ...) at the call, or wrap it in a \
       defn to pass that" builtin_prefix name name builtin_prefix name
  | _ ->
    match lookup ctx name with
    (* A literal local while its uses are being recorded: the use is noted.
       One its guess cannot serve is read at the type it asks for, so the
       check goes on to the uses after it, and the round is marked to be
       thrown away. A dyn want says the dyn width ([lit_solve]). *)
    | Some ({ blit = Some key; _ } as b)
      when (match ctx.lits, want with
            | Some s, Some t ->
              let t = lit_payload t in
              s.recording && not !lit_quiet
              && (Types.equal t Types.Dyn
                  || lit_admits (Option.value (lit_kind key) ~default:`Int) t)
            | _ -> false) ->
      let s = Option.get ctx.lits and t = lit_payload (Option.get want) in
      let operand = List.memq loc !lit_operand_locs in
      let c = if operand || Types.equal t Types.Dyn then Hint else Up in
      lit_add s key (c, t, loc);
      (try expect ctx loc ~want (mk loc b.bty (Tast.Local b.slot))
       with Loc.Error _ when lit_kind key <> Some `Box && not operand ->
         s.dirty <- true;
         expect ctx loc ~want (mk loc t (Tast.Local b.slot)))
    | Some b ->
      expect ctx loc ~want (local_of loc b)
    (* A local of the enclosing function, in a body that was lifted out of it:
       captured by value, here, where it is first named. Asked *before* the
       globals, because that is what the name means at the place it is
       written — inside the enclosing function a local shadows a global of the
       same name, and a body lifted out of it must not silently mean something
       else. *)
    | None when capture ctx loc name <> None ->
      let b = Option.get (capture ctx loc name) in
      expect ctx loc ~want (mk loc b.bty (Tast.Local b.slot))
    | None ->
      match Hashtbl.find_opt ctx.env.globals name with
      | Some _
        when Hashtbl.mem char_consts name
             && (match want with
                 | Some (Types.Int _ | Types.Float _) -> true
                 | _ -> false) ->
        check ctx ?want { Ast.e = Ast.Byte (Hashtbl.find char_consts name); loc }
      | Some (ty, _) ->
        expect ctx 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 ctx 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 — 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 defonce 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. *)
          (* A name with several versions is several functions, so the name
             alone is not a value. A wanted function type with a count of
             parameters says which one was meant. *)
          let wanted_version () =
            match Hashtbl.find_opt ctx.env.versions name with
            | None -> None
            | Some vs ->
              match Option.bind want fn_sig with
              | Some (ps, _) when List.mem_assoc (List.length ps) vs ->
                Some (List.assoc (List.length ps) vs)
              | wanted ->
                let arities =
                  String.concat "\n"
                    (List.map (fun (_, v) -> "  " ^ version_text ctx.env loc v) vs)
                in
                (match wanted with
                 (* The function type wanted here takes a count none of them
                    does, and no wrapping changes that. *)
                 | Some (ps, _) ->
                   let k = List.length ps in
                   Loc.failk "check/several-versions" loc
                     "%s has no arity that takes %d argument%s, which the \
                      function type wanted here does. Its arities are:\n%s"
                     name k (if k = 1 then "" else "s") arities
                 | None ->
                   let fln = fln_source loc in
                   let k, v0 = List.hd vs in
                   let xs =
                     match Hashtbl.find_opt ctx.env.fparams v0 with
                     | Some fs -> List.map (fun (f : Ast.field) -> f.Ast.fname) fs
                     | None -> List.init k (fun i -> Printf.sprintf "x%d" (i + 1))
                   in
                   Loc.failk "check/several-versions" loc
                     "%s has several arities, one per number of arguments, so \
                      the name alone does not say which function this is. \
                      Wrap it in a function that calls the one you mean, as \
                      in %s. Its arities are:\n%s"
                     name
                     (if fln then
                        Printf.sprintf "fn(%s) => %s(%s)" (String.concat ", " xs)
                          name (String.concat ", " xs)
                      else
                        Printf.sprintf "(fn [%s] (%s %s))" (String.concat " " xs)
                          name (String.concat " " xs))
                     arities)
          in
          let name =
            match wanted_version () with Some v -> v | None -> name
          in
          (match Hashtbl.find_opt ctx.env.fns name with
           | Some (params, ret) ->
             private_ref ctx loc name;
             (* 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. Wrap it in a defn and pass that" name;
             expect ctx loc ~want
               (mk loc (Types.CFn (params, ret))
                  (Tast.FnAddr (Tast.Fnval name)))
           | None ->
             (* The float constants no literal can write, reached only once
                every table above has missed, so a program's own binding of
                one of these names is the one it gets. *)
             match special_float name with
             | Some (x, k) ->
               expect ctx loc ~want (mk loc (Types.Float k) (Tast.Float (x, k)))
             | None -> unknown_name ctx loc (written_name 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; ctx.used <- false; expect ctx 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 used = ctx.used in
    ctx.used <- false;
    let rec go = function
      | [ last ] ->
        ctx.defer_ok <- defer_ok;
        ctx.tail <- tail;
        ctx.used <- used;
        let l = check ctx ?want last in [ l ], l.Tast.ty
      | x :: rest ->
        ctx.defer_ok <- defer_ok;
        ctx.tail <- false;
        ctx.used <- 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.

   **Capture is by value.** The body sees its parameters, the program's
   globals, and the locals of the function it was written in — those last
   copied into an environment at the instant the value is made (see
   [capture] and [close_over]). The copies go on that function's frame, and
   [place_closures] moves them to an environment the collector allocates for
   a value that may outlive the frame — so it may be returned, stored or
   pushed like any other value: spec-memory.md's case 3.

   **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 ?gen loc (params : string list) body =
  (* [gen] is (array-gen ...)'s way in for an inline fn: the *form* knows the
     parameter types — one i32 index per dimension — without there being a
     [(Fn ...)] want to say so, and the return is the annotated element type,
     or [None] to take the body's own. Everything else threads [want]. The
     caller has already checked the arity, in its own words. *)
  (* Which of the two function types was asked for. [CFn] is a bare
     address, so a literal written into one has nowhere to put an
     environment — it is checked exactly as an [Fn] is and then refused *if
     it turned out to capture*, which is a decision only the finished body
     can make. Nothing else differs. *)
  let bare = match want with Some (Types.CFn _) -> true | _ -> false in
  let pts, ret0 =
    match gen with
    | Some (pts, r) -> pts, r
    | None ->
      match Option.map fn_sig want with
      | Some (Some (ps, r)) when List.length ps = List.length params ->
        ps, Some r
      | Some (Some (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")
          (tyname loc
             (if bare then Types.CFn (ps, r) else Types.Fn (ps, r)))
      | _ ->
        match want with
        | Some other when other <> Types.Never ->
          fail loc "expected %s, found an fn" (tyname loc other)
        | _ ->
          if fln_source loc then
            fail loc
              "nothing here says what this fn's parameters are — an fn takes \
               its types from the position it is written in. Pass it where a \
               Fn(T, ...) -> R is expected, or name the type where it is \
               bound: let f: Fn(T, ...) -> R = fn(...) => ..."
          else
          fail loc
            "nothing here says what this fn's parameters are — an fn takes \
             its types from the position it is written in. Write it as an \
             argument whose parameter is a (Fn [T ...] R), or a \
             (CFn [T ...] R) when it captures nothing"
  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. When the return is being inferred the context gets
     Unit provisionally — a [return] inside such a body would check against
     it, which is a rough edge left rough on purpose: the body of a generator
     is an expression, and no machinery is built for the form nobody writes. *)
  let fctx =
    { (invented_ctx ctx.env (Option.value ret0 ~default:Types.Unit)) with
      outer = ctx.scope; outer_what = Some "an fn"; parent = Some ctx;
      owner = ctx.owner }
  in
  List.iter2
    (fun n t -> ignore (bind fctx n t ~assignable:false)) params pts;
  (* The last form is checked at the return type the position wants, as a
     defn's is at its declared one, so a value that takes its type from what
     is asked of it — a kept [when], [None], a bare struct — gets it here. *)
  let last_want =
    match ret0 with
    | Some r when not (Types.equal r Types.Unit) -> Some r
    | _ -> None
  in
  let n = List.length body in
  let fbody =
    map_lr
      (fun (i, e) -> if i = n - 1 then check fctx ?want:last_want e else check fctx e)
      (List.mapi (fun i e -> (i, 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 — or, when nothing
     declared one ([ret0] is [None]), the last form's own type *is* the
     return, which is what lets a bare generator's element type be read off
     its body. *)
  let fbody, ret =
    match List.rev fbody with
    (* An fn with no body answers unit, the same as a defn whose declared
       return type is () and whose body is empty. Unlike a defn it declares no
       return type of its own, so there is nothing here to contradict — but
       the *position* names one, and a position wanting a value is the case
       [Check] has to refuse. Without this the empty body would simply fall
       through and the call would read a return value nothing ever wrote. *)
    | [] ->
      (match ret0 with
       | Some r when not (Types.equal r Types.Unit) ->
         fail loc
           "an fn with no body answers (), and this one is in a position \
            that wants %s — write the value it should answer"
           (tyname loc r)
       | _ -> fbody, Types.Unit)
    | last :: rest ->
      (match ret0 with
       | Some r ->
         List.rev (expect fctx last.Tast.loc ~want:(Some r) last :: rest), r
       | None -> fbody, last.Tast.ty)
  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
  (* And the environment, now that the body has named everything it is going
     to. [close_over] allocates in both frames, so it runs after the body's
     slots and before the lifted function is recorded. *)
  let prefix, fenv, bind, addr = close_over ~fname ctx fctx loc in
  (* A [CFn] is a bare address and has nowhere to keep an environment, so a
     literal that captured cannot be one. Refused with the name of what it
     captured, because that is the fact the writer has to act on — and with
     the fix named, which is the wider type. *)
  if bare && fctx.caught <> [] then begin
    let names = List.map fst fctx.caught in
    Loc.failk "check/cfn-captures" loc
      "this fn captures %s, so it is a %s and not a %s: a CFn is the bare \
       address, one word, with nowhere for the copies to live. Widen the \
       position to Fn, or pass %s in as a parameter"
      (String.concat ", " names)
      (tyname loc (Types.Fn (pts, ret))) (tyname loc (Types.CFn (pts, ret)))
      (match names with [ n ] -> n | _ -> "them")
  end;
  (* An [Fn]-position literal declares the environment whether or not it
     captured: it is reached by a call that passes one. A [CFn]-position
     one must not — it is reached by calls that pass none, and a parameter
     nobody supplies is read off whatever the register held. *)
  let fenv = if bare then fenv else declare_env fctx fenv in
  let lifted =
    { Tast.name = fname; params = pts;
      slots = Array.of_list (List.rev fctx.slot_tys);
      snames = Array.of_list (List.rev fctx.slot_names); as_slots = fctx.as_slots;
      ret; body = prefix fbody; fdefers = [];
      fenv; fparent = Some ctx.owner; floc = loc }
  in
  refuse_frame_escapes lifted;
  ctx.env.lifted <- lifted :: ctx.env.lifted;
  let fty = if bare then Types.CFn (pts, ret) else Types.Fn (pts, ret) in
  (* [Flanfn] and not [Fnval], which is the handler clause's choice and is the
     same choice for the same reason. [Fnval] exists so that a *name* taken as
     a value in a dev build answers with the body that is current, which means
     a load from that name's indirection cell. A lifted body has no name
     anyone can type and no way to be redefined on its own: it is reached by
     address from the body it was written in, and a redefinition of that body
     carries its own copy. So the cell would never hold anything but this
     symbol, and asking for one is how a redefinition module came to reference
     a cell nothing declares. *)
  let v =
    match addr with
    | None -> mk loc fty (Tast.FnAddr (Tast.Flanfn fname))
    (* The value, and the store that fills its environment on this frame
       around it. Whether the environment stays there is decided once the
       whole program is checked, by [place_closures]: a value that may
       outlive this frame has its copies moved to an environment the
       collector allocates instead. *)
    | Some a ->
      let c = mk loc fty (Tast.Closure (Tast.Flanfn fname, a)) in
      mk loc fty (Tast.Let ([ Option.get bind ], [ c ]))
  in
  expect ctx loc ~want v

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

   It *can* see the establishing function's locals, by value: the same capture
   an [fn] literal gets, and the one place it has no escaping case left over.
   A handler frame is popped by the body that pushed it and nothing in the
   language can name one, so the establishing frame is alive whenever the
   clause runs and the copies on it are good. What is still refused is a store
   into a captured name — the clause holds a copy, and writing to it would
   leave the local as it was — so §1's accumulation case still accumulates
   into a global, and now with whatever the establishing function knew
   readable beside it.

   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 ?(what = "handler-bind") loc clauses body =
  let frames =
    (* Left to right, and not [List.map], whose order is unspecified: each of
       these calls lifts a function onto [ctx.env.lifted] and names it after
       the count already there, so an order nobody chose would number the
       clauses of one handler-bind differently between builds. The names go in
       a redefinition module, which is where that would be noticed — see the
       argument in [check_fn]. *)
    map_lr
      (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" (tyname loc t)
         in
         (* Its own context: a fresh frame, an empty scope, and no way to reach
            the enclosing one. *)
         let hctx =
           { (invented_ctx ctx.env Types.Unit) with
             outer = ctx.scope; outer_what = Some "a handler";
             parent = Some ctx }
         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 (Types.Mut, 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 (Types.Mut, 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
         (* And the environment, the same machinery an [fn] literal's capture
            uses and settled by the same argument — only with no escaping
            case to leave over. A handler frame is popped by the body that
            pushed it and nothing in the language can name one, so the clause
            cannot be reached from anywhere the establishing frame is not
            alive. So its copies stay on the establishing frame, in
            a slot rooted with the environment's descriptor. *)
         let prefix, fenv, bind, addr =
           close_over ~fname ctx hctx c.Ast.hloc
         in
         (* Every clause declares the environment, captured or not:
            [flan_signal] reads it off the frame and passes it to whichever
            clause matched, and it cannot know which of them captured. *)
         let fenv = declare_env hctx fenv in
         let lifted =
           { Tast.name = fname; params = [ Types.Ptr (Types.Mut, ty) ];
             slots = Array.of_list (List.rev hctx.slot_tys);
             snames = Array.of_list (List.rev hctx.slot_names); as_slots = hctx.as_slots;
             ret = Types.Unit; body = prefix hbody; fdefers = [];
             fenv; fparent = Some ctx.owner; floc = c.Ast.hloc }
         in
         refuse_frame_escapes lifted;
         ctx.env.lifted <- lifted :: ctx.env.lifted;
         { Tast.htype = type_id name; hfn = fname; henv = addr }, bind)
      clauses
  in
  (* The stores that fill the environments, one per clause that captured,
     around the whole form: a handler frame carries the address and the frame
     is pushed before the body runs, so the copies have to be made before
     either. *)
  let envbinds = List.filter_map snd frames in
  let frames = List.map fst frames 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
  (* [what] is the form the reader wrote. A handler-case establishes its
     frames through this function, so a [return] under one has to be refused
     naming handler-case rather than naming the machinery underneath it. *)
  ctx.in_frames <- Some what;
  (* The body's last form is the form's value, which is [with-allocator]'s
     shape and for the same reason: both wrap a body in something established
     around it and taken off after, and neither is a reason for the body to
     stop being an expression. §3 needs it — a [restart-case] whose body is a
     [handler-bind] has to agree in type with its clauses, which is how all
     four of this repository's crossing probes are written — and it is what
     [handler-case] is *not*: that one's value is its clause's, which is the
     whole difference between the two. [check_handler_case] below builds one
     out of this form and a [restart-case], so both spellings run through
     here and only the clause's landing place differs.

     This used to be [ignore want] and a flat [Types.Unit], and nothing
     complained, because a unit in value position is only caught where the
     expectation is checked. So the two backends each answered a caller that
     asked anyway, and answered differently: [emit.ml] a literal zero, this
     machine whatever the body's last form had left in the slot. Neither was a
     value; one of them merely looked like one. *)
  let body, ty =
    barrier ctx ("a " ^ what) (fun () ->
      let rec go = function
        | [] -> [ unit_at loc ], Types.Unit
        | [ 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
      in
      go body)
  in
  ctx.in_frames <- saved;
  let h = mk loc ty (Tast.Handled (frames, body)) in
  let h =
    if envbinds = [] then h else mk loc ty (Tast.Let (envbinds, [ h ]))
  in
  expect ctx loc ~want h

(* (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;
  restart_clauses ctx ?want ~what:"restart-case" loc tbody clauses

(* The clauses of a [restart-case], checked against a body that has already
   been checked. Separate from the form above because [handler-case] supplies
   its own body — a [handler-bind] it built — and has to name itself in the
   refusals rather than naming the machinery it is made of. *)
and restart_clauses ctx ?want ?(hidden = false) ~what loc (tbody : Tast.expr)
    clauses =
  (* 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 %s offers %s twice" what 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 (tyname loc 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 " ^ what)
                (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 ];
           rloc = c.Ast.rloc;
           rreport = Option.value c.Ast.rreport ~default:"";
           rhidden = hidden })
      clauses
  in
  let ty = match !ty with Some t -> t | None -> Types.Never in
  mk loc ty (Tast.RestartCase (clauses, tbody))

(* (handler-case BODY [(Type [c] BODY-1) ...]) — the unwinding handler, and
   spec-conditions.md's one remaining open question about it, answered: it *is*
   a handler-bind plus a transfer, built here rather than given nodes and
   backends of its own.

       (handler-case B [(T [c] A)])
    == (restart-case (handler-bind [(T [c] (invoke-restart 'R c))] B)
         (R [c T] A))

   That is Common Lisp's own definition of the operator, and every property
   this form is supposed to have falls out of the two it is made of rather
   than being re-implemented beside them.

   - The clause runs *here*, at the handler-case, because a restart clause
     does; so it sees this function's locals, which a handler clause cannot,
     and its value is the whole form's, because a restart-case's clause value
     is the whole restart-case's.
   - The stack below is gone by then. §5's defers, and the allocator a
     [with-allocator] rebound, are honoured on the way out because that is
     what a transfer already does for every frame it leaves.
   - A condition matching no clause installs no frame, so nothing here sees
     it and it keeps going outward exactly as it would have.
   - The body and every clause agree on one type, because §3 already says a
     restart-case's body and clauses do. A clause that disagrees is refused
     where it is written, like an [if] whose arms disagree.

   The condition crosses as a restart argument, which means by value into a
   buffer this frame owns — which is the only thing that can work, since §5
   kills the signalling frame the condition was living on the moment the
   transfer starts.

   The restart the two halves meet over is named after this function and
   numbered within it, and the number is the count of handler clauses already
   lifted out of this function. That count never goes down, and every
   handler-case lifts at least one clause before the next one can read it, so
   within a name's own bucket the numbers are strictly increasing and no two
   forms can mint the same name. A clause body written inside another handler
   clause counts against the [<none>] bucket rather than against a function's,
   which is the same argument again and not a hole: that bucket is one list
   for the whole program and it only grows.

   Uniqueness is the requirement rather than a nicety. Two handler-cases
   sharing a name, one inside the other's extent, would have the inner frame
   shadow the outer one (§4), which lands a condition at the wrong form —
   and, because the two would be expecting different condition types, lands it
   as a run-time signature refusal rather than as a wrong answer. *)
and check_handler_case ctx ?want loc body clauses =
  let what = "handler-case" in
  (* Resolved once here, for the refusal below; [check_handler_bind] resolves
     them again for the frames, which is cheap and keeps that function whole. *)
  let names =
    List.map
      (fun (c : Ast.hclause) ->
         match resolve ctx.env c.Ast.hty with
         | Types.Named n -> n
         | t ->
           fail c.Ast.hloc
             "a handler matches a struct type, not %s" (tyname loc t))
      clauses
  in
  (* Two clauses for one condition type: the first would take every one of
     them and the second could never run, and nothing in the source says which
     the reader meant. The same refusal a duplicate restart name gets, and for
     the same reason. *)
  let seen = ref [] in
  List.iter2
    (fun (c : Ast.hclause) n ->
       if List.mem n !seen then
         fail c.Ast.hloc "this handler-case handles %s twice" n;
       seen := n :: !seen)
    clauses names;
  let k =
    List.length
      (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
  let rnames =
    List.map (Printf.sprintf "handler-case/%s/%d/%s" ctx.owner k) names
  in
  (* The handler half: one clause per arm, whose whole body is the transfer.
     It is lifted into a function of its own like any handler clause, and the
     condition it was handed is copied into the restart frame's buffer on its
     way out. *)
  let handlers =
    List.map2
      (fun (c : Ast.hclause) r ->
         { c with
           Ast.hbody =
             [ { Ast.e =
                   Ast.InvokeRestart
                     (r, [ { Ast.e = Ast.Var c.Ast.hname; loc = c.Ast.hloc } ]);
                 loc = c.Ast.hloc } ] })
      clauses rnames
  in
  (* The landing half: one restart clause per arm, taking the condition as its
     single parameter and running what the reader actually wrote. *)
  let landings =
    List.map2
      (fun (c : Ast.hclause) r ->
         { Ast.rname = r;
           rparams =
             [ { Ast.fname = c.Ast.hname; fty = c.Ast.hty;
                 floc = c.Ast.hloc } ];
           rreport = None; rbody = c.Ast.hbody; rloc = c.Ast.hloc })
      clauses rnames
  in
  let tbody = check_handler_bind ctx ?want ~what loc handlers [ body ] in
  (* Hidden: the landing is reached only through the handler above, and a break
     loop under this form would otherwise list it as if someone could mean it. *)
  restart_clauses ctx ?want ~hidden:true ~what loc tbody landings

(* The forms of a [defer], checked in place and hung on the function. What is
   left where it stands is one store: this defer's number into the counter
   [defer_slot] describes, which is how the transfer exit tells a defer that
   has registered from one the text has not reached yet. The form's type is
   still [unit], which is all a reader of the value can see. *)
and register_defer ctx loc forms =
  (* Saved and put back rather than cleared, which is the same thing today and
     will not be the day a defer may hold one. Nothing reaches here from
     inside a defer now — [defer_ok] is false in there — so the saved value is
     always false; written this way so that if it ever is not, the flag comes
     back rather than being dropped. *)
  let was_in_defer = ctx.in_defer in
  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 <- was_in_defer;
  ctx.defers <- mk loc Types.Unit (Tast.Do forms) :: ctx.defers;
  let slot =
    match ctx.defer_slot with
    | Some s -> s
    | None ->
      let s = fresh_slot ctx (Types.Int Types.I64) in
      ctx.defer_slot <- Some s;
      s
  in
  mk loc Types.Unit
    (Tast.Set
       (Tast.Plocal slot,
        mk loc (Types.Int Types.I64)
          (Tast.Int (Int64.of_int (List.length ctx.defers), Types.I64))))

(* The transfer exit's copy of the defers, each under the count that says it
   registered. [ds] is innermost first, so the last one registered is at the
   head and the [j]th from the end is defer number [j].

   The zero the counter starts at is written by [defer_counter_zero] below, at
   the top of the body: a slot is an alloca like any other and holds whatever
   the stack held until something stores to it, which at -O2 is not zero and
   is exactly how this was found. *)
and guarded_defers slot (ds : Tast.expr list) =
  let n = List.length ds in
  List.mapi
    (fun i (d : Tast.expr) ->
       let loc = d.Tast.loc in
       let i64 = Types.Int Types.I64 in
       let test =
         mk loc Types.Bool
           (Tast.Prim
              (Tast.Ge,
               [ mk loc i64 (Tast.Local slot);
                 mk loc i64 (Tast.Int (Int64.of_int (n - i), Types.I64)) ]))
       in
       mk loc Types.Unit (Tast.If (test, d, unit_at loc)))
    ds

and defer_counter_zero slot loc =
  mk loc Types.Unit
    (Tast.Set
       (Tast.Plocal slot,
        mk loc (Types.Int Types.I64) (Tast.Int (0L, Types.I64))))

(* [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. *)
(* A text or bracket literal local used where only its typed reading works —
   sliced, its address taken, cloned, destructured: a typed use, recorded. *)
and lit_typed_use ctx (e : Ast.expr) =
  match e.Ast.e, ctx.lits with
  | Ast.Var n, Some s when s.recording ->
    (match lookup ctx n with
     | Some { blit = Some key; _ } when lit_kind key = Some `Box ->
       lit_add s key (Up, Types.Unit, e.Ast.loc)
     | _ -> ())
  | _ -> ()

(* The literal local [n] names, while its uses are being recorded. *)
and lit_recorded ctx n =
  match ctx.lits, lookup ctx n with
  | Some s, Some { blit = Some key; _ } when s.recording -> Some key
  | _ -> None

(* [v] read as arithmetic: the literal locals among its operands, and the
   operands that are something else (a call, an index, a typed name). Number
   literals are neither. The result's type is the join of all of them, so the
   locals are merged with whatever [v] is stored into and the others are
   what it brings. *)
and lit_parts ctx (v : Ast.expr) =
  (* [env]: names a [let] inside [v] binds, with what they were bound to, so
     (let [t a0] t) passes a0 through as (do a0) and an if's arms do. *)
  let rec go env (v : Ast.expr) (vars, others) =
    match v.Ast.e with
    | Ast.Var n ->
      (match List.assoc_opt n env with
       | Some (Some (vs, os)) -> (vs @ vars, os @ others)
       | Some None -> (vars, v :: others)
       | None ->
         match lookup ctx n with
         | Some { blit = Some k; _ } when lit_kind k <> Some `Box -> (k :: vars, others)
         | _ -> (vars, v :: others))
    | Ast.Int _ | Ast.Float _ | Ast.Byte _ -> (vars, others)
    | Ast.Call ({ Ast.e = Ast.Var ("+" | "-" | "*" | "/" | "%" | "min" | "max"); _ }, args)
      when args <> [] ->
      List.fold_left (fun acc a -> go env a acc) (vars, others) args
    | Ast.Do (_ :: _ as xs) -> go env (List.nth xs (List.length xs - 1)) (vars, others)
    | Ast.Let (bs, (_ :: _ as xs)) ->
      let env =
        List.fold_left
          (fun env (b : Ast.binding) ->
             (b.Ast.bname,
              if b.Ast.bty = None then Some (go env b.Ast.bval ([], [])) else None)
             :: env)
          env bs
      in
      go env (List.nth xs (List.length xs - 1)) (vars, others)
    | Ast.If (_, t, Some e) -> go env e (go env t (vars, others))
    | _ -> (vars, v :: others)
  in
  go [] v ([], [])

(* A float literal, or an integer one past i32, anywhere in [v]'s arithmetic. *)
and lit_wide_literals (v : Ast.expr) =
  let rec go (v : Ast.expr) =
    match v.Ast.e with
    | Ast.Float _ -> [ (Types.Float (float_default ()), v.Ast.loc) ]
    | Ast.Int n when Int64.compare n (Int64.of_int32 Int32.max_int) > 0
                     || Int64.compare n (Int64.of_int32 Int32.min_int) < 0 ->
      [ (Types.Int Types.I64, v.Ast.loc) ]
    | Ast.Call ({ Ast.e = Ast.Var ("+" | "-" | "*" | "/" | "%" | "min" | "max"); _ }, args) ->
      List.concat_map go args
    | _ -> []
  in
  go v

(* [v] stored into the literal local [key] (a [set] or a [recur]), while
   recording: the literal locals it is arithmetic over are merged with [key],
   and each other operand says, on its own terms, what it brings ([Down]) —
   never the guess the round happens to have. Then [v] is checked at [key]'s
   guess, quietly, since a want there is the guess and says nothing. *)
and lit_down ctx key pty (v : Ast.expr) =
  let s = Option.get ctx.lits in
  let quietly f =
    let was = !lit_quiet in
    lit_quiet := true;
    Fun.protect ~finally:(fun () -> lit_quiet := was) f
  in
  let vars, others = lit_parts ctx v in
  List.iter (lit_union s key) vars;
  List.iter (fun (t, l) -> lit_add s key (Hint, t, l)) (lit_wide_literals v);
  List.iter
    (fun (o : Ast.expr) ->
       match trial ctx (fun () -> check ctx o) with
       | Ok e -> lit_add s key (Down, e.Tast.ty, o.Ast.loc)
       | Error _ -> ())
    others;
  match trial ctx (fun () -> quietly (fun () -> check ctx ~want:pty v)) with
  | Ok e -> e
  | Error _ ->
    s.dirty <- true;
    quietly (fun () -> check ctx v)

(* The type a literal initialiser is checked at while a session is open —
   its current guess, or the decision — numbering it while recording.
   [None] for anything that is not a literal, or with no session open. *)
and lit_local ctx name (e : Ast.expr) =
  match ctx.lits, lit_kind e with
  | Some s, Some kind ->
    if s.recording && not (Phys.mem s.ids e) then begin
      Phys.replace s.ids e s.count;
      s.count <- s.count + 1;
      s.keys <- (e, name) :: s.keys
    end;
    Some (lit_guess ~subst:ctx.env.subst s e kind)
  | _ -> None

(* A literal local's initialiser, at the type [lit_local] gave it: [Unit] is
   a text or bracket literal's typed reading ([lit_default]). *)
and lit_init ctx t (e : Ast.expr) =
  if Types.equal t Types.Unit then with_typed_literals (fun () -> check ctx e)
  else check ctx ~want:t e

(* [run] is a [let] or a [loop] with some of [inits] literals, and the
   outermost such form of this function: the session opens here. See
   [lit_session]. *)
and with_lits : 'a. ctx -> Loc.t -> Ast.expr list -> (unit -> 'a) -> 'a =
  fun ctx loc inits run ->
  if ctx.lits <> None || not (List.exists (fun e -> lit_kind e <> None) inits)
  then run ()
  else begin
    let s = { decided = Phys.create 16; recording = false; ids = Phys.create 16;
              keys = []; count = 0; parent = Hashtbl.create 16;
              cons = Hashtbl.create 16; dirty = false } in
    ctx.lits <- Some s;
    incr lit_depth;
    let remember () =
      let subst = ctx.env.subst in
      List.iter
        (fun (k, _) ->
           let kind = Option.value (lit_kind k) ~default:`Int in
           let t = lit_guess ~subst s k kind in
           let others =
             Option.value (Phys.find_opt lit_memo k) ~default:[]
             |> List.filter (fun (sb, _) -> sb != subst)
           in
           Phys.replace lit_memo k ((subst, t) :: others))
        s.keys
    in
    Fun.protect
      ~finally:(fun () ->
          ctx.lits <- None;
          decr lit_depth;
          if !lit_depth = 0 then Phys.reset lit_memo)
    @@ fun () ->
    let unsettled = Loc.diag ~kind:"check/lit-unsettled" loc "unsettled" in
    (* The decisions the uses recorded so far make, written into
       [s.decided], and the locals whose decision moved. *)
    let settle () =
      let solved = lit_solve s in
      let moved = ref [] in
      List.iter
        (fun (k, name, r) ->
           match r with
           | Ok t ->
             let kind = Option.value (lit_kind k) ~default:`Int in
             if not (Types.equal t (lit_guess ~subst:ctx.env.subst s k kind)) then begin
               moved := (k, name, t) :: !moved;
               Phys.replace s.decided k t
             end
           | Error _ -> ())
        solved;
      (solved, List.rev !moved)
    in
    let conflict solved =
      List.find_map
        (fun (k, name, r) -> match r with Error e -> Some (k, name, e) | Ok _ -> None)
        solved
    in
    let log () =
      if lit_has "log" then
        Phys.iter
          (fun k t ->
             let d = lit_default k (Option.value (lit_kind k) ~default:`Int) in
             if not (Types.equal t d) then
               Printf.eprintf "LITINF %s:%d:%d %s -> %s\n" k.Ast.loc.Loc.file
                 k.Ast.loc.Loc.line k.Ast.loc.Loc.col (tyname loc d) (tyname loc t))
          s.decided
    in
    let rec round n =
      Phys.reset s.ids; s.keys <- []; s.count <- 0;
      Hashtbl.reset s.parent; Hashtbl.reset s.cons; s.dirty <- false;
      s.recording <- true;
      incr lit_recording;
      (* A ref, because [trial] is monomorphic inside this recursive group. *)
      let answer = ref None in
      (* What the settle inside the trial found, which has already written
         its decisions: settling again outside would see nothing move. *)
      let settled = ref None in
      let outcome =
        Fun.protect
          ~finally:(fun () -> decr lit_recording; s.recording <- false)
          (fun () ->
             trial ctx (fun () ->
                 let r = run () in
                 let solved, moved = settle () in
                 settled := Some (solved, moved);
                 (* The guesses held: this check is the answer. *)
                 if moved <> [] || s.dirty || conflict solved <> None then
                   raise (Loc.Error unsettled);
                 answer := Some r;
                 poison loc))
      in
      match outcome, !answer with
      | Ok _, Some r -> log (); remember (); r
      | _ ->
        let solved, moved =
          match !settled with Some sm -> sm | None -> settle ()
        in
        (match conflict solved with
         | Some (k, name, ((t1, l1), (t2, l2))) -> lit_conflict k name t1 l1 t2 l2
         | None -> ());
        if moved <> [] && n < lit_rounds then round (n + 1)
        else if moved <> [] then begin
          (* Still moving: a local fed through more calls than the rounds
             follow. It is the local that needs its type written. *)
          let k, name, t = List.hd moved in
          lit_unsettled k name t
        end
        else begin
          (* Nothing left to learn: checked for real, so a refusal is the
             ordinary one and a whole-file check goes on past it. *)
          log ();
          remember ();
          run ()
        end
    in
    round 1
  end

(* A literal local whose uses kept changing its type past [lit_rounds]. *)
and lit_unsettled (k : Ast.expr) name t =
  let lit = lit_spelling k in
  let fix =
    if fln_source k.Ast.loc then Printf.sprintf "let %s: %s = %s" name (tyname k.Ast.loc t) lit
    else Printf.sprintf "(%s %s)" (tyname k.Ast.loc t) lit
  in
  Loc.failk "check/literal-unsettled" k.Ast.loc
    "the type of %s depends on too long a chain of the values stored into it \
     to be read off them. Write the type it should have: %s"
    name fix

and lit_spelling (k : Ast.expr) =
  let lit =
    match k.Ast.e with
    | Ast.Int n -> Int64.to_string n
    | Ast.Float x -> Printf.sprintf "%g" x
    | Ast.Byte b -> Printf.sprintf "\\%c" (Char.chr b)
    | Ast.Call (_, [ { Ast.e = Ast.Int n; _ } ]) -> Int64.to_string (Int64.neg n)
    | Ast.Call (_, [ { Ast.e = Ast.Float x; _ } ]) -> Printf.sprintf "%g" (-.x)
    | _ -> "..."
  in
  let whole = lit <> "" && String.for_all (fun c -> (c >= '0' && c <= '9') || c = '-') lit in
  if whole && lit_kind k = Some `Float then lit ^ ".0" else lit

(* Two uses of a literal local that no one type satisfies. *)
and lit_conflict (k : Ast.expr) name t1 l1 t2 l2 =
  let lit =
    match k.Ast.e with
    | Ast.Int n -> Int64.to_string n
    | Ast.Float x -> Printf.sprintf "%g" x
    | Ast.Byte b -> Printf.sprintf "\\%c" (Char.chr b)
    | Ast.Call (_, [ { Ast.e = Ast.Int n; _ } ]) -> Int64.to_string (Int64.neg n)
    | Ast.Call (_, [ { Ast.e = Ast.Float x; _ } ]) -> Printf.sprintf "%g" (-.x)
    | _ -> "..."
  in
  (* %g drops the point from a whole float; put it back so the fix reads as
     a float literal. 1e+20 already does. *)
  let whole = lit <> "" && String.for_all (fun c -> (c >= '0' && c <= '9') || c = '-') lit in
  let lit = if whole && lit_kind k = Some `Float then lit ^ ".0" else lit in
  let fix =
    if fln_source k.Ast.loc then Printf.sprintf "let %s: %s = %s" name (tyname l1 t1) lit
    else Printf.sprintf "(%s %s)" (tyname l1 t1) lit
  in
  Loc.failk "check/literal-uses" k.Ast.loc
    ~notes:[ Loc.note l1 (Printf.sprintf "%s is used as %s here" name (tyname l1 t1));
             Loc.note l2 (Printf.sprintf "and as %s here" (tyname l2 t2)) ]
    "%s is used as %s and as %s, and %s can have only one type. Write the \
     one it should have: %s"
    name (tyname l1 t1) (tyname l2 t2) lit fix

and check_let ctx ?(tail = false) ?(used = false) ?want ?(defer_ok = false) loc bs body =
  with_lits ctx loc
    (List.filter_map
       (fun (b : Ast.binding) -> if b.Ast.bty = None then Some b.Ast.bval else None)
       bs)
  @@ fun () ->
  scoped ctx (fun () ->
    let bs =
      map_lr
        (fun (b : Ast.binding) ->
           let want = Option.map (resolve ctx.env) b.Ast.bty in
           let lit = if b.Ast.bty = None then lit_local ctx b.Ast.bname b.Ast.bval else None in
           ctx.used <- true;
           let v =
             match lit with
             | Some t -> lit_init ctx t b.Ast.bval
             | None -> check ctx ?want b.Ast.bval
           in
           (match v.Tast.ty with
            (* A refused initialiser, already reported: the name is bound to
               the poison so that what follows is still checked. *)
            | Types.Never when is_poison v -> ()
            | Types.Unit | Types.Never ->
              fail b.Ast.bloc "%s would be bound to %s, which is not a value"
                b.Ast.bname (tyname loc v.Tast.ty)
            | _ -> ());
           (* Locals are assignable places; parameters are not. *)
           let slot =
             bind ctx b.Ast.bname v.Tast.ty ~assignable:true
               ?lit:(Option.map (fun _ -> b.Ast.bval) lit)
           in
           (slot, v))
        bs
    in
    (* After the bindings, because checking each of them withdrew it. *)
    ctx.tail <- tail;
    ctx.used <- used;
    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" 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 cannot leave a (loop ...), and that is the nearest loop. \
            Answer with the value, or use a while"
           verb
       | Some l ->
         fail loc
           "%s :%s would leave a (loop ...), and it may not. Answer with the \
            value, or use a while" 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 cannot leave %s, and the nearest loop is outside it. Write the \
            loop inside %s, or leave with a value and test that after"
           verb what what
       | Some l ->
         fail loc
           "%s :%s would leave %s, and it may not. Name a loop inside %s"
           verb l what what)
  in
  go 0 ctx.loops

(* [(dotimes [i n] ...)], [(dotimes [i start stop] ...)] and
   [(dotimes [i start stop step] ...)].

   **The convention.** [stop] is exclusive, so [(dotimes [i 0 n] ...)] is the
   same loop as [(dotimes [i n] ...)] — one rule rather than two, and the
   shorter form stays the longer one with its defaults left off. A negative
   step counts down and tests with [>] instead of [<], which is what makes
   [(dotimes [i 9 -1 -1] ...)] run 9 down to 0.

   **Each bound once, before the loop.** [start] is the counter's initial
   value, [stop] and a non-literal [step] each get a hidden slot, and all three
   are checked — and therefore evaluated — left to right, outside the counter's
   scope. A body that assigns to what they were computed from cannot change the
   trip count.

   **The sign of the step.** When it is a literal the direction is known here
   and the condition is the one comparison it always was, so nothing changed
   for every loop anyone has written. A literal 0 is refused: it is an infinite
   loop spelled as an accident. A step that is only known at run time gets a
   condition that asks the sign first, and the cost lands on exactly the loops
   that need it. A run-time 0 falls out of that test as a loop that runs no
   times at all — neither arm of the sign test holds — which is deterministic
   and terminating, the two things an accidental hang is not. *)
and check_dotimes ctx ~want loc label name (b : Ast.bounds) body =
  (* Left to right, and all three before the counter is bound: they are
     evaluated before it exists, so [(dotimes [i i (* outer i *)] ...)] reads
     the outer name and the order a counter function sees is the written one. *)
  let start = Option.map (fun e -> check ctx ~want:index_ty e) b.Ast.dstart in
  let stop = check ctx ~want:index_ty b.Ast.dstop in
  let step = Option.map (fun e -> check ctx ~want:index_ty e) b.Ast.dstep in
  let int k = mk loc index_ty (Tast.Int (k, Types.I32)) in
  (* A literal step, if that is what was written. The default is 1, which is a
     literal too, so the one-bound form takes this path and emits exactly what
     it has always emitted. *)
  let literal =
    match step with
    | None -> Some 1L
    | Some { Tast.e = Tast.Int (k, _); _ } -> Some k
    | Some _ -> None
  in
  (match literal, step with
   | Some 0L, Some s ->
     fail s.Tast.loc
       "a step of 0 never moves the counter. Give it a step that moves, as \
        in (dotimes [i 0 10 2] ...); left out, the step is 1"
   | _ -> ());
  scoped ctx (fun () ->
    let i = bind ctx name index_ty ~assignable:false in
    let limit = fresh_slot ctx index_ty in
    (* A slot only when the step is not a literal: a literal needs no slot to
       be evaluated once, and the one-bound form's frame keeps the shape it
       had. *)
    let stepslot =
      match literal with None -> Some (fresh_slot ctx index_ty) | Some _ -> None
    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 limitv = mk loc index_ty (Tast.Local limit) in
    let stepv =
      match literal, stepslot with
      | Some k, _ -> int k
      | None, Some s -> mk loc index_ty (Tast.Local s)
      | None, None -> assert false
    in
    let cmp op = mk loc Types.Bool (Tast.Prim (op, [ iv; limitv ])) in
    let cond =
      match literal with
      | Some k when k > 0L -> cmp Tast.Lt
      | Some _ -> cmp Tast.Gt
      | None ->
        (* Both directions, asked in the order that leaves 0 with neither: the
           counter has not passed the stop *and* the step is going that way.
           Written as nested [If]s because that is what [and] and [or] already
           become, so nothing new reaches a backend. *)
        let sign op =
          mk loc Types.Bool (Tast.Prim (op, [ stepv; int 0L ]))
        in
        mk loc Types.Bool
          (Tast.If (sign Tast.Gt, cmp Tast.Lt,
                    mk loc Types.Bool
                      (Tast.If (sign Tast.Lt, cmp Tast.Gt,
                                mk loc Types.Bool (Tast.Bool false)))))
    in
    let advance =
      mk loc Types.Unit
        (Tast.Set (Tast.Plocal i,
                   mk loc index_ty (Tast.Prim (Tast.Add, [ iv; stepv ]))))
    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, [ advance ])) in
    let binds =
      (i, match start with Some s -> s | None -> int 0L)
      :: (limit, stop)
      :: (match stepslot, step with
          | Some s, Some v -> [ (s, v) ]
          | _ -> [])
    in
    expect ctx loc ~want (mk loc Types.Unit (Tast.Let (binds, [ 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 =
  with_lits ctx loc (List.map snd bs) @@ fun () ->
  scoped ctx (fun () ->
    (* Each initial value is evaluated once, before the loop, exactly as a
       [let]'s is and as [dotimes]'s bound is — and bound before the next is
       checked, as a [let]'s is, so a later initialiser sees an earlier
       name. *)
    let binds =
      map_lr
        (fun (n, v0) ->
           let lit = lit_local ctx n v0 in
           let v =
             match lit with Some t -> lit_init ctx t v0 | None -> check ctx v0
           in
           (match v.Tast.ty with
            (* A refused initialiser, already reported: the name is bound to
               the poison so that what follows is still checked. *)
            | Types.Never when is_poison v -> ()
            | Types.Unit | Types.Never ->
              fail v.Tast.loc "%s would be bound to %s, which is not a value" n
                (tyname loc v.Tast.ty)
            | _ -> ());
           (bind ctx n v.Tast.ty ~assignable:true
              ?lit:(Option.map (fun _ -> v0) lit), v))
        bs
    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 ctx loc ~want (mk loc ty (Tast.Let (binds, [ loop ])))
    | Some r ->
      expect ctx 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 ...) — 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, and it may not. Write the loop inside %s"
        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. Something here would still run afterwards";
  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 (slot, ty) ->
         match
           List.find_opt (fun (_, (b : binding)) -> b.slot = slot) ctx.scope
         with
         | Some (_, { blit = Some key; _ })
           when (match ctx.lits with Some s -> s.recording | None -> false) ->
           lit_down ctx key ty a
         | _ -> 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) ]))

(* Every boolean-position test in the language funnels through here: [if]'s
   own condition, [while]'s, and [not]'s argument. ([when] and [cond] are
   sugar built out of [Ast.If] in parse.ml, so they get this for free
   without a separate case. [and] and [or] are sugar too, and both their
   tests and their answers get this for free the same way — see
   [shortcircuit] in parse.ml, where each binds its test to a temp and
   answers that temp on the path it decides, so the deciding operand
   itself comes back rather than a bare bool.)

   A dyn scrutinee is tested for truthiness, Clojure's rule: nil and false
   are the only falsey values, and everything else — 0, "", an empty vec, an
   empty map, a keyword — is truthy. A typed scrutinee stays strictly bool,
   exactly as before.

   The scrutinee is checked with no expectation first so its own type
   decides which rule applies. That is fine for the passing cases — dyn, or
   already bool — but a *refused* one has to be re-checked with the old
   [want:Bool] rather than reported from here, and that covers two shapes of
   "asked the wrong question first": a bare integer or float literal answers
   differently to "what type is this" than to "is this a bool" (check.ml's
   int_literal/float arms only give the nicer answer, "expected bool, found
   the integer literal 5", when asked the second way), and [None] does not
   even have an answer to the first question — "nothing here says what None
   is an Option of" — where the second gets straight to "expected bool,
   found None". Asking the first way first is what makes the dyn case work,
   so the refusal path — success or exception both — asks the second way
   again, after the fact, purely to get the sentence a typed if has always
   given.

   [loc] comes from [c] itself, not from the caller's [if]/[while]/[not] —
   the built-in rt call and cast have to sit at the condition's own position
   or an --x86 disassembly and the dev inspector point at the wrong column
   when the two differ (an [if] whose test is not its first token).

   The [exception Loc.Error _] arm swallows a rejection from arbitrary depth
   inside [c] and re-runs the whole of [check ctx c] a second time, which is
   sound only because every one of [ctx]'s save-restore sites — [barrier],
   and the [in_frames]/[in_defer]/[loops]/[scope] plumbing [check] itself
   uses — is not exception-safe: a failure mid-walk can leave one of those
   pushed without its pop. Today that is harmless, because the second call
   always either succeeds outright or raises again and this function's own
   caller then aborts the compile — nothing downstream ever reads [ctx]
   again on that path. It would stop being harmless the day some later
   want-sensitive elaboration on this path can *succeed* by yielding a
   concrete [Bool] on retry rather than failing a second time: then the
   first, swallowed pass's half-restored state and any name or slot it
   registered before raising would both still be live.

   That same retry-on-failure is also, deliberately, not made cheaper by
   only retrying at the leaf that actually needs a nicer message (an int or
   float literal, or [None]) and re-raising everywhere else: the shorter
   path was tried and shelved, because "everywhere else" is not safe to
   generalise past [not]'s one level of nesting — a condition that is
   itself a compound form carrying its own literals arbitrarily deep (an
   [if] or [let] standing where a condition is expected) would need [want]
   threaded through exactly as far as this function's own second call
   already threads it, and stopping short changes which of *those*
   literals gets the nicer message, not just the speed. The cost that
   buys is real: nested [not] on a program that does not type-check re-runs
   this whole function once per level of nesting inside the level above it,
   which would be exponential in how deep the nesting goes. What keeps it
   linear is [truthy_failed]: a condition this function has already refused,
   in the same body, is refused again with the same diagnostic rather than
   re-checked, so a retry re-walks its subtree once and stops at the first
   condition below it that was settled. The message is the one the first
   pass produced, so no message changes.

   Keywords are a separate, deliberate loss rather than a bug: a bare
   [:kw] used to be checked here with [want:Types.Bool] from the start, so
   it hit the keyword arm's [Some other] case and refused by name — "is an
   enum member where an enum is expected and a dyn keyword elsewhere, but
   bool is expected here". Checking it here with no expectation first, as
   every other scrutinee now is, resolves it as the dyn keyword instead
   (there being no enum in play), and dyn keywords are unconditionally
   truthy — so [(if :kw a b)] now takes [a], where it used to refuse
   outright. The author's call: lispy truthiness wins wherever it can, so
   this refusal is given up on purpose and not special-cased back in;
   test_flan.ml pins the new answer down so it is not lost again by
   accident. *)
and check_truthy ctx c =
  (* Only where a refusal is raised: while recovering, one is recorded where
     it happens and the check goes on, so a replayed one would hide others. *)
  if ctx.env.recovering && ctx.env.speculating = 0 then check_truthy_once ctx c
  else
  match
    List.find_opt
      (fun (n, sc, r, _) -> n == c && r == ctx.ret && same_scope sc ctx.scope)
      !truthy_failed
  with
  | Some (_, _, _, d) -> raise (Loc.Error d)
  | None ->
    let scope = ctx.scope in
    incr truthy_depth;
    Fun.protect
      ~finally:(fun () ->
          decr truthy_depth;
          if !truthy_depth = 0 then truthy_failed := [])
      (fun () ->
         try check_truthy_once ctx c
         with Loc.Error d as ex ->
           if !lit_recording = 0 then truthy_failed := (c, scope, ctx.ret, d) :: !truthy_failed;
           raise ex)

and check_truthy_once ctx c =
  let loc = c.Ast.loc in
  (* Speculative, because a refusal here is answered by asking again at
     [bool]; and that second ask is guarded, because its refusal is re-worded
     below. Recovery sees each refusal once, in its final words. *)
  match speculate ctx.env (fun () -> check ctx c) with
  | c0 when c0.Tast.ty = Types.Dyn ->
    widen loc Types.Bool (rt loc (Types.Int Types.I32) "flan_dyn_truthy" [ c0 ])
  | c0 when Types.fits ~expected:Types.Bool ~actual:c0.Tast.ty -> c0
  | c0 ->
    (* Re-checked at [bool] first, and the answer is kept only when it is a
       message that knows something this one does not: a literal names itself
       ("found the integer literal 1"), and [None] names itself, and both of
       those point at the mistake better than a type name would. What comes
       back as the *generic* mismatch — "expected bool, found i32", which is
       true and tells a reader nothing they did not have — is the one replaced
       below.

       The rule, rather than the fact. [expected bool, found i32] is true and
       says nothing a reader did not already know; what they do not know is
       that this language has exactly two things a condition may be, and that
       the dyn one is not the typed one. A dyn condition is Clojure's — nil
       and false are false and 0 is true — so a message that told somebody to
       compare against zero *in general* would be wrong about half the
       language. It is said only of the typed side, which is where they are.

       The comparison is spelled with the condition's own name where there is
       one, because [(!= x 0)] is a thing to type and [(!= … 0)] is not.
       Anything more complicated than a name gets the operator and no
       template: a reconstructed expression would be a guess at code the
       reader can see for themselves. *)
    (ctx.env.guard_next <- true;
     match check ctx ~want:Types.Bool c with
     | c1 -> c1
     | exception Loc.Error d when not (String.equal d.Loc.kind "check/type-mismatch") ->
       refuse_or_poison ctx.env loc d
     | exception Loc.Error _ ->
    let how =
      let zero = match c0.Tast.ty with Types.Float _ -> "0.0" | _ -> "0" in
      let comparable =
        match c0.Tast.ty with Types.Int _ | Types.Float _ -> true | _ -> false
      in
      match c.Ast.e, comparable with
      | Ast.Var n, true -> Printf.sprintf " — test it, as (!= %s %s)" n zero
      | _, true -> Printf.sprintf " — test it against %s with !=" zero
      | _ -> ""
    in
    (try
       Loc.failk "check/condition-not-bool" loc
         "a condition is a bool or a dyn, and this is %s%s"
         (tyname loc c0.Tast.ty) how
     with Loc.Error d -> refuse_or_poison ctx.env loc d))
  | exception Loc.Error _ -> check ctx ~want:Types.Bool c

and check_if ctx ?(tail = false) ?(used = false) ?want loc c t e =
  if ctx.env.recovering && ctx.env.speculating = 0 then
    check_if_once ctx ~tail ~used ?want loc c t e
  else
  match
    List.find_opt
      (fun (n, (sc, r), w, _) ->
         n == c && r == ctx.ret && w = (want, used) && same_scope sc ctx.scope)
      (Hashtbl.find_all if_failed c.Ast.loc)
  with
  | Some (_, _, _, d) -> raise (Loc.Error d)
  | None ->
    let scope = ctx.scope in
    incr if_depth;
    Fun.protect
      ~finally:(fun () ->
          decr if_depth;
          if !if_depth = 0 then Hashtbl.reset if_failed)
      (fun () ->
         try check_if_once ctx ~tail ~used ?want loc c t e
         with Loc.Error d as ex ->
           if !lit_recording = 0 then Hashtbl.add if_failed c.Ast.loc (c, (scope, ctx.ret), (want, used), d);
           raise ex)

and check_if_once ctx ~tail ~used ?want loc c t e =
  if as_binds c = [] then check_if_tested ctx ~tail ~used ?want loc c t e
  else scoped ctx (fun () -> check_if_tested ctx ~tail ~used ?want loc c t e)

and check_if_tested ctx ~tail ~used ?want loc c t e =
  let t =
    match narrows c with
    | [] -> t
    | names -> { t with Ast.e = Ast.Narrow (names, t) }
  in
  let c, t =
    match as_binds c with
    | [] -> (check_truthy ctx c, t)
    | _ ->
      (* What an [as] named reaches the block through a name no reader can
         write, bound in the scope this if was given; the else is checked
         without it. *)
      let cv, named = as_cond ctx c in
      (cv, { t with Ast.e = Ast.Alias (named, t) })
  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. Both arms are kept when the [if] is. *)
  let in_tail f = ctx.tail <- tail; ctx.used <- used; f () in
  match e with
  | None -> check_when ctx ~used ?want loc c (fun ?want () ->
      branch ctx (fun () -> in_tail (fun () -> check ctx ?want t)))
  (* A kept chain whose last else is missing — a [cond] with no [:else],
     whose fallthrough is [(do)], or an [if] whose else is a [when] — is one
     [when] spread over several tests: an Option, [None] when no test holds,
     and [Some] of the arm that ran. *)
  | Some e when kept_open ~used want e ->
    (match e.Ast.e with
     | Ast.Do [] ->
       check_when ctx ~used:true ?want loc c (fun ?want () ->
           branch ctx (fun () -> in_tail (fun () -> check ctx ?want t)))
     | _ ->
       let tw =
         match want with
         | Some (Types.Option i) -> Some i
         | Some Types.Dyn -> Some Types.Dyn
         | _ -> None
       in
       let arm w = branch ctx (fun () -> in_tail (fun () -> check ctx ?want:w t)) in
       (* At an Option want the arm is asked the payload first, and the chain
          wraps it; refused there, it is asked the Option itself, which it
          then is (decision 140). So a T?? wanted of a T? arm is Some of it,
          and the chain's own None stays the outer one. *)
       let t, at_payload =
         match want with
         | Some (Types.Option _) ->
           (match trial ctx (fun () -> arm tw) with
            | Ok t -> t, true
            | Error d ->
              (match trial ctx (fun () -> arm want) with
               | Ok t -> t, false
               | Error _ -> raise (Loc.Error d)))
         | _ -> arm tw, false
       in
       let rest ~used ?want () =
         branch ctx (fun () ->
             ctx.tail <- tail; ctx.used <- used; check ctx ?want e)
       in
       match t.Tast.ty with
       | ty when at_payload && not (Types.equal ty Types.Never) ->
         let oty = Option.get want in
         let e = rest ~used:true ~want:oty () in
         mk loc oty (Tast.If (c, mk loc oty (Tast.Some_ t), e))
       | Types.Unit ->
         expect ctx loc ~want
           (mk loc Types.Unit (Tast.If (c, t, rest ~used:false ())))
       | Types.Never ->
         let e = rest ~used:true ?want () in
         mk loc e.Tast.ty (Tast.If (c, t, e))
       | Types.Dyn ->
         let e = rest ~used:true ~want:Types.Dyn () in
         expect ctx loc ~want (mk loc Types.Dyn (Tast.If (c, t, e)))
       (* An arm that is already an Option is the chain's value as it is,
          and [None] when no test holds — one level flattened (decision
          140): an arm's None and no arm running are one answer. *)
       | Types.Option _ as o ->
         let e = rest ~used:true ~want:o () in
         expect ctx loc ~want (mk loc o (Tast.If (c, t, e)))
       | ty ->
         let oty = Types.Option ty in
         let e = rest ~used:true ~want:oty () in
         expect ctx loc ~want
           (mk loc oty (Tast.If (c, mk loc oty (Tast.Some_ t), e))))
  (* Two literal arms meet at the wider of their own types, as two literal
     elements of an array do: [(if c 1 2.5)] is an f64. *)
  | Some e
    when want = None && lone_literal t && lone_literal e
         && (match literal_join ctx t e with
             | Some j -> not (Types.equal j (Types.Int Types.I32))
             | None -> false) ->
    let want = literal_join ctx t e in
    let t = branch ctx (fun () -> in_tail (fun () -> check ctx ?want t)) in
    let e = branch ctx (fun () -> in_tail (fun () -> check ctx ?want e)) in
    mk loc t.Tast.ty (Tast.If (c, t, e))
  | Some e when want = None
                && ((adapts t && not (adapts e || is_none_lit e))
                    (* [if c then None else 5]: the else arm decides T, and
                       None meets it at T? below, as the other order does. *)
                    || (is_none_lit t && not (is_none_lit e)))
                && not (and_sentinel e) ->
    (* A literal has no type of its own until something asks, so with no
       expectation the other arm decides: [(if c 4000000 n)] over an i64 [n]
       is an i64, as [(+ 4000000 n)] is. *)
    let e = branch ctx (fun () -> in_tail (fun () -> check ctx e)) in
    let twant = if e.Tast.ty = Types.Never then None else Some e.Tast.ty in
    let then_at w = branch ctx (fun () -> in_tail (fun () -> check ctx ?want:w t)) in
    (* [None] or [Some(1)] beside a plain T: the two meet at T?, the other
       arm wrapped (decision 138). Tried only once the arm is refused at T,
       so an arm that fits T is never an Option. *)
    let t, e =
      match e.Tast.ty with
      | Types.Option _ | Types.Dyn | Types.Unit | Types.Never -> then_at twant, e
      | ety ->
        (match trial ctx (fun () -> then_at twant) with
         | Ok t -> t, e
         | Error _ ->
           let oty = Types.Option ety in
           (match trial ctx (fun () -> then_at (Some oty)) with
            | Ok t -> t, expect ctx e.Tast.loc ~want:(Some oty) e
            | Error _ -> then_at twant, e))
    in
    let ty = if e.Tast.ty = Types.Never then t.Tast.ty else e.Tast.ty in
    mk loc ty (Tast.If (c, t, e))
  | 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. *)
    (* A slice or a pointer from the then-branch is not the else-branch's
       want: the two may differ only in const, and they meet at the
       read-only one whichever side it is on — [Types.const_join]. *)
    let free_join =
      want = None
      && (match t.Tast.ty with Types.Slice _ | Types.Ptr _ -> true | _ -> false)
    in
    (* A bool arm and a dyn arm meet at dyn, the bool boxed — Clojure's rule,
       so (or false (box "s")) answers "s" rather than unboxing the string at
       bool and trapping. The other order already met at dyn, the then arm
       deciding. So after a bool then arm the else arm is checked on its own
       terms first, since checking it at bool is what unboxes it, and kept
       when it is a bool or a dyn. Anything else is abandoned and checked at
       bool as before, for that path's messages. A chain whose arms all fit
       is checked once; a refused one re-checks each level below the refusal
       once more, the square of its depth. *)
    (* The else arm at the then arm's type first, as it always was: a value
       that takes its type from what is asked of it — [(+ b 1)] beside an
       i64, [nil] beside an Option — is asked the then arm's. Only when that
       is refused as a mismatch is it checked on its own terms, and the two
       meet at [arm_join], so [(if c x32 y64)] is the i64 [(if c y64 x32)]
       is. A dyn opened at the then arm's type is not a meeting: the two
       meet at dyn, as they do the other way round. The arm is checked once
       each way at most, and a refusal at the then arm's type is kept
       ([arm_failed]) for the ifs above that check it again. *)
    let joined =
      if want <> None || free_join || t.Tast.ty = Types.Never
         || t.Tast.ty = Types.Bool || and_sentinel e || lone_literal e
      then None
      else
        let alone () = branch ctx (fun () -> in_tail (fun () -> check ctx e)) in
        let key = (ctx.scope, ctx.ret) in
        let at_then () =
          match
            List.find_opt
              (fun (n, (sc, r), w, _) ->
                 n == e && r == ctx.ret && Types.equal w t.Tast.ty
                 && same_scope sc ctx.scope)
              (Hashtbl.find_all arm_failed e.Ast.loc)
          with
          | Some (_, _, _, d) -> Error d
          | None ->
            match
              trial ctx (fun () ->
                  branch ctx (fun () ->
                      in_tail (fun () -> check ctx ~want:t.Tast.ty e)))
            with
            | Ok v -> Ok v
            | Error d ->
              if !lit_recording = 0 then Hashtbl.add arm_failed e.Ast.loc (e, key, t.Tast.ty, d);
              Error d
        in
        let meet v =
          match arm_join t.Tast.ty v.Tast.ty with
          | Some j -> Some (j, expect ctx v.Tast.loc ~want:(Some j) v)
          | None -> None
        in
        (* The else arm refused at T and fine at T? — [None], [Some(1)] —
           and the two meet at T?, the then arm wrapped (decision 138). *)
        let at_option () =
          match t.Tast.ty with
          | Types.Option _ | Types.Dyn | Types.Unit -> None
          | ty ->
            let oty = Types.Option ty in
            (match
               trial ctx (fun () ->
                   branch ctx (fun () -> in_tail (fun () -> check ctx ~want:oty e)))
             with
             | Ok v when Types.equal v.Tast.ty oty -> Some (oty, v)
             | _ -> None)
        in
        (* Only where the arms met nowhere else, so nothing that met before
           meets differently: a dyn else arm still meets at dyn. *)
        match
          (match at_then () with
        | Ok v ->
          (match opened_dyn ~box:(to_dyn ctx) v with
           | Some box -> Some (Types.Dyn, box)
           | None -> Some (t.Tast.ty, v))
        | Error _ when adapts e -> None
        | Error d ->
          (* A mismatch, or a dyn the then arm's type could not open: the
             arm on its own terms meets the then arm. Anything else refused
             it at the then arm's type, and that refusal is said. *)
          (match
             trial ctx (fun () ->
                 let v = alone () in
                 if is_mismatch d || Types.equal v.Tast.ty Types.Dyn then v
                 else raise (Loc.Error (Loc.diag ~kind:not_kept v.Tast.loc "")))
           with
           | Ok v -> meet v
           | Error own when String.equal own.Loc.kind not_kept -> None
           (* Refused on its own terms too, and not as a mismatch — an
              unknown name, say: that is the real error, and nothing is said
              about a type the arm was never going to have. *)
           | Error own when is_mismatch d && not (is_mismatch own) ->
             let v = alone () in
             (match meet v with
              | Some r -> Some r
              | None ->
                Some (t.Tast.ty, expect ctx v.Tast.loc ~want:(Some t.Tast.ty) v))
           | Error _ -> None))
        with
        | None -> at_option ()
        | j -> j
    in
    match joined with
    | Some (j, v) ->
      let t = expect ctx t.Tast.loc ~want:(Some j) t in
      mk loc j (Tast.If (c, t, v))
    | None ->
    let own_else =
      if want = None && t.Tast.ty = Types.Bool then
        match
          trial ctx (fun () ->
              let v = branch ctx (fun () -> in_tail (fun () -> check ctx e)) in
              match v.Tast.ty with
              | Types.Bool | Types.Dyn | Types.Never -> v
              | _ -> raise (Loc.Error (Loc.diag v.Tast.loc "not bool or dyn")))
        with
        | Ok v -> Some v
        | Error _ -> None
      else None
    in
    let t =
      match own_else with
      | Some v when v.Tast.ty = Types.Dyn ->
        expect ctx t.Tast.loc ~want:(Some Types.Dyn) t
      | _ -> t
    in
    let ewant =
      match want with
      | Some _ -> want
      | None ->
        if t.Tast.ty = Types.Never || free_join then None else Some t.Tast.ty
    in
    (* [(and a b c)] is [(let [t a] (if t (let [u b] (if u c u)) t))], so the
       *last* operand of an [and] is the then arm and the sentinel that carries
       the previous operand's location is the else arm. With no expectation
       the then arm supplies one, the sentinel is checked against it, and the
       mismatch was reported at the sentinel — which is a caret on the operand
       before the one that is wrong. TODO.org, "and's last operand gets a
       misdirected caret", records three fixes for this that
       were rejected and one that was not: prefer the arm that is not a
       compiler temp when deciding which to blame. That is this.

       Only [and] needs it. In an [or] the chain sits in the else arm and the
       sentinel in the then arm, so every operand is already blamed at its own
       location; and with an expectation in hand both arms are checked against
       it rather than against each other, so nothing here runs. *)
    let e =
      match own_else with
      | Some v -> v
      | None ->
      let reworded = want = None && and_sentinel e in
      match
        branch ctx (fun () ->
          in_tail (fun () ->
            if reworded then ctx.env.guard_next <- true;
            check ctx ?want:ewant e))
      with
      | v -> v
      | exception Loc.Error d
        when reworded && String.equal d.Loc.kind "check/type-mismatch" ->
        (try
           Loc.failk "check/shortcircuit-operand" t.Tast.loc
             "an and answers false or its last operand, so the two have to be \
              one type — this operand is %s, and false is a bool"
             (tyname loc t.Tast.ty)
         with Loc.Error d -> refuse_or_poison ctx.env e.Ast.loc d)
      | exception Loc.Error d when reworded -> refuse_or_poison ctx.env e.Ast.loc d
    in
    let t, e =
      match free_join, Types.const_join t.Tast.ty e.Tast.ty with
      | true, Some j when e.Tast.ty <> Types.Never ->
        expect ctx t.Tast.loc ~want:(Some j) t,
        expect ctx e.Tast.loc ~want:(Some j) e
      | _ -> t, 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"
          (tyname loc t.Tast.ty) (tyname loc e.Tast.ty)
    in
    mk loc ty (Tast.If (c, t, e))

(* A one-armed [if], which [when] is. As a statement it is Unit whatever its
   branch evaluates to. Kept — a [let]'s value, an argument, a return, or
   anything else with a type wanted of it — it answers (Option T): [Some] of
   the branch when the test held and [None] when it did not. A branch that
   is already an Option is that Option, flattened one level (decision 140,
   Kotlin's [?.] rather than Rust's [bool::then]): [None] from the branch and
   a failed test are one answer. A (Option (Option T)) branch stays one.

   Dyn has no Option. Where a dyn is wanted, or the branch is a dyn, a false
   test answers nil and a true one the branch's value — one absence, as a
   dyn map's [get] has.

   A branch with no value (Unit) or none at all (Never) keeps the statement's
   Unit, so what is refused about binding one is refused as before. *)
and check_when ctx ~used ?want loc c
    (branch_at : ?want:Types.t -> unit -> Tast.expr) =
  let stmt t = expect ctx loc ~want (mk loc Types.Unit (Tast.If (c, t, unit_at loc))) in
  let nil () = rt loc Types.Dyn "flan_dyn_nil" [] in
  let valueless (t : Tast.expr) =
    match t.Tast.ty with Types.Unit | Types.Never -> true | _ -> false
  in
  match want with
  | Some (Types.Unit | Types.Never) -> stmt (branch_at ())
  | Some Types.Dyn ->
    let t = branch_at ~want:Types.Dyn () in
    mk loc Types.Dyn (Tast.If (c, t, nil ()))
  | Some (Types.Option inner as oty) ->
    (* The payload first, wrapped; refused there, the Option itself, which
       the branch then is (decision 140). *)
    let t =
      match trial ctx (fun () -> branch_at ~want:inner ()) with
      | Ok t -> if t.Tast.ty = Types.Never then t else mk loc oty (Tast.Some_ t)
      | Error d ->
        (match trial ctx (fun () -> branch_at ~want:oty ()) with
         | Ok t -> if t.Tast.ty = Types.Never then t else expect ctx loc ~want:(Some oty) t
         | Error _ -> raise (Loc.Error d))
    in
    mk loc oty (Tast.If (c, t, mk loc oty Tast.None_))
  | None when not used -> stmt (branch_at ())
  | _ ->
    let t = branch_at () in
    if valueless t then stmt t
    else if Types.equal t.Tast.ty Types.Dyn then
      expect ctx loc ~want (mk loc Types.Dyn (Tast.If (c, t, nil ())))
    else if (match t.Tast.ty with Types.Option _ -> true | _ -> false) then
      expect ctx loc ~want (mk loc t.Tast.ty (Tast.If (c, t, mk loc t.Tast.ty Tast.None_)))
    else
      let oty = Types.Option t.Tast.ty in
      expect ctx loc ~want
        (mk loc oty (Tast.If (c, mk loc oty (Tast.Some_ t), mk loc oty Tast.None_)))

(* Whether a two-armed [if] is kept and its else chain ends without one —
   [(do)], or a one-armed [if] — so the whole chain answers an Option. *)
and kept_open ~used want (e : Ast.expr) =
  let kept =
    match want with
    | Some (Types.Unit | Types.Never) -> false
    | Some _ -> true
    | None -> used
  in
  let rec open_ (e : Ast.expr) =
    match e.Ast.e with
    | Ast.Do [] | Ast.If (_, _, None) | Ast.IfLet (_, _, None) -> true
    | Ast.If (_, _, Some e') | Ast.IfLet (_, _, Some e') -> open_ e'
    | _ -> false
  in
  kept && open_ e

(* The type two literals meet at, each at its own type — a wide integer at
   u64, which is the only type that holds one. *)
and literal_join ctx (a : Ast.expr) (b : Ast.expr) =
  let own (x : Ast.expr) =
    match x.Ast.e with
    | Ast.UInt _ -> Some (Types.Int Types.U64)
    | _ -> probe ctx x.Ast.loc (fun () -> (check ctx x).Tast.ty)
  in
  match own a, own b with
  | Some x, Some y -> literal_meet x y
  | _ -> None

(* Whether a name would reach a callee if it were called — a global function, a
   generic, or a local holding a function value. The three sources [named_call]
   itself consults, in its own order; builtins are deliberately not among them,
   so that [(println {.f v})] still reports what it reports today. *)
and callable ctx name =
  Hashtbl.mem ctx.env.fns name
  || Hashtbl.mem ctx.env.gsigs name
  || (match lookup ctx name with
      | Some b -> (match b.bty with Types.Fn _ -> true | _ -> false)
      | None -> false)

(* [(Pair 1 2)] and [(Pair {.a 1 .b 2})]: which copy of a generic struct a
   value builds. The position says, when a copy of this struct is wanted
   there; otherwise the fields do, each given one's type binding the
   template's variables the way a generic call's arguments bind its own. The
   fields are only probed here — each check is abandoned — and the ordinary
   constructor checks them again against the copy it is handed. *)
and generic_ctor ctx ~want loc name given =
  let env = ctx.env in
  let g = Hashtbl.find env.gstructs name in
  match want with
  | Some (Types.Named k)
    when (match Hashtbl.find_opt struct_apps k with
          | Some (h, _) -> String.equal h name
          | None -> false) ->
    realise env loc (Types.Named k); k
  | _ ->
    let open_key =
      struct_copy env loc name (List.map (fun (p, _) -> Types.Var p) g.gparams)
    in
    let fields = (Hashtbl.find env.structs open_key).Tast.fields in
    let pairs =
      match given with
      | `Positional args when List.length args = List.length fields ->
        List.combine fields args
      (* The wrong number of fields: the copy at variables is handed on, and
         the constructor says what is wrong with the count in its own words. *)
      | `Positional _ -> []
      | `Named kvs ->
        List.filter_map
          (fun (f, v) ->
             List.find_opt
               (fun (fl : Tast.field) -> String.equal fl.Tast.fname f) fields
             |> Option.map (fun fl -> (fl, v)))
          kvs
    in
    let subst = ref [] and unsure = ref [] in
    (* An untyped literal has no type of its own to bring, so the fields that
       do have one bind first: [(Node 2 (addr c))] over a [(Node i64)] [c] is
       a [(Node i64)], and the 2 takes its width from that. *)
    let literal (a : Ast.expr) =
      match a.Ast.e with
      | Ast.Int _ | Ast.UInt _ | Ast.Float _ | Ast.Byte _ -> true
      | _ -> false
    in
    (* A literal's own type, the one it has with nothing expected of it. *)
    let literal_type (a : Ast.expr) =
      match a.Ast.e with
      | Ast.Float _ -> Types.Float (float_default ())
      | Ast.UInt _ -> Types.Int Types.U64
      | Ast.Byte b when b > 127 -> Types.Int Types.I32
      | Ast.Byte _ -> Types.Int Types.U8
      | _ -> Types.Int Types.I32
    in
    let pairs =
      List.filter (fun (_, a) -> not (literal a)) pairs
      @ List.filter (fun (_, a) -> literal a) pairs
    in
    (* Variables only literals have bound so far: a later literal may widen
       them, as a generic call's literal arguments meet at the wider type —
       [(Pair 1 2.5)] is a [(Pair f64)]. *)
    let lit_only = ref [] in
    (* Which field's value decided each variable, for the refusal of a
       literal that does not fit what it decided. *)
    let decided_by = ref [] in
    List.iter
      (fun ((f : Tast.field), (a : Ast.expr)) ->
         match f.Tast.fty with
         (* A literal at a variable a typed field already decided: it has to
            be usable at that type, and when it is not the refusal names the
            field that decided it. *)
         | Types.Var v
           when literal a && List.mem_assoc v !subst
                && not (List.mem v !lit_only) ->
           let b = List.assoc v !subst in
           (match a.Ast.e, b with
            | Ast.Float x, Types.Int _ ->
              let notes =
                match List.assoc_opt v !decided_by with
                | Some (fname, at) ->
                  [ Loc.note at
                      (Printf.sprintf ".%s is %s here, which decides $%s" fname
                         (tyname loc b) v) ]
                | None -> []
              in
              Loc.failk "check/generic-struct-field" a.Ast.loc ~notes
                "%s's .%s is $%s, which is %s here, and %g is a float literal. \
                 Write .%s as an integer, or give .%s a float type"
                name f.Tast.fname v (tyname loc b) x f.Tast.fname
                (match List.assoc_opt v !decided_by with
                 | Some (fname, _) -> fname
                 | None -> f.Tast.fname)
            | _ -> ())
         | Types.Var v when literal a && not (List.mem_assoc v !subst && not (List.mem v !lit_only)) ->
           let t = (literal_type a) in
           (match List.assoc_opt v !subst with
            | None -> subst := (v, t) :: !subst; lit_only := v :: !lit_only
            | Some b ->
              (match literal_meet b t with
               | Some j -> subst := (v, j) :: List.remove_assoc v !subst
               | None ->
                 fail a.Ast.loc "%s's .%s is %s here, and this is %s"
                   (tyname loc (Types.Named open_key)) f.Tast.fname
                   (tyname loc b) (tyname loc t)))
         | _ ->
         if open_ty f.Tast.fty
            && not (literal a && subst_ty !subst f.Tast.fty |> open_ty |> not)
         then begin
           let seen = ref None in
           let probe () =
             seen := Some (check ctx a).Tast.ty;
             Loc.fail a.Ast.loc "probe"
           in
           let refusal = match trial ctx probe with Error d -> Some d | Ok _ -> None in
           match !seen with
           (* No type of its own — [None], a bare {.field v} — is no
              evidence; the constructor checks it against the copy the other
              fields decide, and its refusal is the one given if they decide
              nothing. *)
           | None -> Option.iter (fun d -> unsure := d :: !unsure) refusal
           | Some t ->
             let before = !subst in
             if bind_ty subst f.Tast.fty t then
               List.iter
                 (fun (v, _) ->
                    if not (List.mem_assoc v before) then
                      decided_by := (v, (f.Tast.fname, a.Ast.loc)) :: !decided_by)
                 !subst
             else
               fail a.Ast.loc "%s's .%s is %s here, and this is %s"
                 (tyname loc (Types.Named open_key)) f.Tast.fname
                 (tyname loc (subst_ty !subst f.Tast.fty))
                 (tyname loc t)
         end)
      pairs;
    (match given with
     | `Positional args when List.length args <> List.length fields -> open_key
     | _ ->
       let targs =
         List.map
           (fun (p, _) ->
              match List.assoc_opt p !subst with
              | Some t -> t
              | None ->
                (match List.rev !unsure with
                 | d :: _ -> Loc.raise_diag d
                 | [] -> ());
                Loc.failk "check/generic-struct-undetermined" loc
                  ~notes:[ Loc.note g.gloc (name ^ " is declared here") ]
                  "%s's $%s is not decided by the fields given here. Name the \
                   type where the value goes, as in (the (%s %s) ...)"
                  name p name
                  (String.concat " "
                     (List.map
                        (fun (q, is_len) ->
                           if env.tyvars <> [] then "$" ^ q
                           else if is_len then "8"
                           else "i32")
                        g.gparams)))
           g.gparams
       in
       struct_copy env loc name targs)

(* [(Cell 1 2)] — a struct built from its fields in declaration order.

   The parser cannot make this one either, and for a sharper reason than the
   bare literal above: [(Cell 1 2)] is character-for-character an ordinary call
   and only the symbol table tells the two apart. So it is decided here, on the
   last arm of [named_call], which is to say *after* a local of function type,
   after a generic and after the global function table. Nothing can be shadowed
   into a struct constructor by accident, because a name is one declaration:
   [collect]'s [claimed] table spans every declaration kind, so a [defstruct
   Cell] and a [defn Cell] cannot both exist. A [(defclass point [x y])]
   constructor is a real [defn] that [Classes.expand] wrote before checking
   began, so [(point 1 2)] resolves in [env.fns] two arms above this one and
   never reaches here.

   ARITY IS EXACT, and that is the decision worth writing down. ZII is not
   withdrawn — it is what the designated form does, and [(Cell {.row 1})]
   still zeroes [.col]. What positional construction cannot do is *say* which
   field was left out: [(Cell 1)] reads as a Cell with one field given, and
   which one depends on a declaration order that the author is free to change
   later. A trailing field silently zeroed there is the field-reorder hazard
   at its worst, so a short argument list is a refusal that names the first
   field it did not reach, and points at the spelling that does mean "zero the
   rest". Odin's positional literal takes the same line. *)
and positional_struct ctx ~want loc name args =
  if String.equal name "String" then refuse_string_inside loc;
  let s = Hashtbl.find ctx.env.structs name in
  let fields = s.Tast.fields in
  let n = List.length fields in
  let given = List.length args in
  let note = declared_note ctx.env name in
  (* The constructor is written with the template's name for a generic
     struct's copy, and the copy is spoken of as [(Pair i32)]. *)
  let ctor =
    match Hashtbl.find_opt struct_apps name with
    | Some (g, _) when Hashtbl.mem ctx.env.copies name -> g
    | _ -> name
  in
  let shown = tyname loc (Types.Named name) in
  if given < n then begin
    let missing = List.nth fields given in
    Loc.failk "check/positional-too-few" loc ~notes:note
      "%s has %d field%s and %d %s given positionally — .%s has no value. \
       Positional construction gives every field, in declaration order; to \
       give some of them and zero the rest, a struct value is written (%s \
       {.field value ...})"
      shown n (if n = 1 then "" else "s") given
      (if given = 1 then "was" else "were") missing.Tast.fname ctor
  end;
  if given > n then begin
    let extra = List.nth args n in
    Loc.failk "check/positional-too-many" extra.Ast.loc ~notes:note
      "%s has %d field%s, and this is argument %d — a struct value is written \
       (%s {.field value ...}) or (%s %s)"
      shown n (if n = 1 then "" else "s") (n + 1) ctor ctor
      (String.concat " " (List.map (fun (f : Tast.field) -> f.Tast.fname) fields))
  end;
  (* Left to right, each against its own field's type, exactly as the argument
     list of a call is checked against its parameters — same [map2_lr], same
     [~want], so an untyped literal takes the field's type and a nested bare
     literal (feature A above) gets an expectation here as well. The mismatch
     is reported at the argument, by [expect], in the words a call's argument
     already gets; what is added is a note saying which field that argument
     was, because at a positional call site the field name is the one thing
     the source does not show. The note is attached only to a failure raised
     at this argument's own location, and it says nothing about the failure —
     it names the position, which is true whatever went wrong there. *)
  let fields =
    map2_lr
      (fun (f : Tast.field) (a : Ast.expr) ->
         ctx.env.guard_next <- true;
         try check ctx ~want:f.Tast.fty a with
         | Loc.Error d when d.Loc.dloc = a.Ast.loc ->
           refuse_or_poison ctx.env a.Ast.loc
             (Loc.sort_notes
                { d with
                  Loc.notes =
                    d.Loc.notes
                    @ [ Loc.note a.Ast.loc
                          (Printf.sprintf "this is %s's field .%s" shown
                             f.Tast.fname) ]
                    @ note })
         | Loc.Error d -> refuse_or_poison ctx.env a.Ast.loc d)
      fields args
  in
  expect ctx loc ~want (mk loc (Types.Named name) (Tast.Make (name, fields)))

(* [{.f v}] with no type written in front of it, checked against whatever type
   the position it stands in expects.

   The whole of the feature is the one line that hands [kvs] to [check_struct]
   with the expected type's name: from there a bare literal and a named one are
   the same literal, checked by the same code. Duplicate fields, unknown
   fields, their notes and their error kinds, and ZII zero-fill for the fields
   left out are therefore not "the same rules" as the named form's — they are
   the named form's, reached through the same call.

   A named type is the only expectation that says anything. [Dyn] deliberately
   does not: braces at a dyn want are the dyn map literal ({:key value}, and
   [Ast.MapLit]) and always have been, and a [.field]-keyed brace was never
   part of that spelling. So a dyn want is refused here rather than quietly
   given a second meaning, and the message points at the map spelling because
   that is what someone at a dyn want almost certainly wanted.

   With no expectation at all there is nothing to infer from and the refusal
   names both ways out: write the type, or move the literal somewhere a type
   is known. *)
and check_bare ctx ~want loc kvs =
  let written =
    "{" ^ String.concat " " (List.map (fun (k, _) -> "." ^ k) kvs) ^ " ...}"
  in
  match want with
  | Some (Types.Named n) -> check_struct ctx ~want loc n kvs
  | Some Types.Dyn ->
    Loc.failk "check/bare-struct-dyn" loc
      "a dyn is expected here, and %s is a struct field list, not a dyn map — \
       a dyn map's keys are keywords, as {:%s value ...}"
      written
      (match kvs with (k, _) :: _ -> k | [] -> "key")
  | Some other ->
    Loc.failk "check/bare-struct-want" loc
      "%s is a struct field list and %s is expected here, which is not a \
       struct type"
      written (tyname loc other)
  | None ->
    Loc.failk "check/bare-struct-untyped" loc
      "%s does not say which struct it builds — the fields alone do not name \
       a type. Write it, as (Type %s), or put the literal where a type is \
       already known: a function's return position, an argument of a call, a \
       field of another literal, or a typed place being set. A let binding is \
       none of those — a local takes its type from its value, so there is \
       nothing there to read one off"
      written written

(* 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 =
  if String.equal name "String" then refuse_string_inside loc;
  match Hashtbl.find_opt ctx.env.structs name with
  | None when Hashtbl.mem ctx.env.gstructs name ->
    check_struct ctx ~want loc
      (generic_ctor ctx ~want loc name (`Named kvs)) kvs
  | 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 was a listed bug: [(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 — write (%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, so a value of it names a case — write (%s.%s \
            {.field value ...}), for one of %s"
           name name (first_case_name ctx.env name) (case_list ctx.env name)
       (* [is_struct_map] (parse.ml) has two blind spots, not one: [(name
          {})] reads as a struct literal with no fields regardless of what
          [name] turns out to be, and so does [(name {.f v ...})] at ANY
          size — a [.field]-first map is never a dyn map argument, only ever
          this struct-literal shape, whatever [name] is. [(name {:a 1})] is
          the one that keeps [name] an ordinary call, because a
          keyword-keyed map is never mistaken for a struct literal.

          The [.field]-keyed blind spot is no longer a blind spot, and that
          is the argument half of the bare-literal feature. [(g {.row 2})] is
          a call to [g] whose one argument is a bare struct literal — the
          parameter is the expectation that names its type — and the only
          reason it arrives here wearing a struct literal's clothes is that
          the parser had to guess and guessed by shape. So it is handed back
          to [named_call] as the call it was written as, with the fields
          rebuilt into the [Ast.Bare] node the parser would have made had the
          braces stood anywhere else. Only for a name that is actually
          callable: an unknown name keeps the "unknown struct" report below,
          because a misspelled struct name is what that shape usually is.

          The empty braces keep their old refusal, because they are still
          genuinely ambiguous — [{}] is the zero-field struct literal AND the
          empty dyn map, with nothing in the shape to separate them — and
          that one does have the let-binding fix the message names. *)
       else if kvs <> [] && callable ctx name then
         named_call ctx ~want loc name [ { Ast.e = Ast.Bare kvs; loc } ]
       else if Hashtbl.mem ctx.env.fns name then
         (match kvs with
          | [] ->
            fail loc
              "%s is a function, not a struct — {} on its own is read as \
               the zero-field struct literal, so it cannot be passed here \
               as an empty map; bind it first, as (let [m {}] (%s m))"
              name name
          | _ ->
            fail loc
              "%s is a function, not a struct — {.field value ...} only \
               ever builds a struct literal, never a map value, so it \
               cannot be passed here as an argument; a dyn map's keys are \
               keywords, as {:field value ...}"
              name)
       else
         Loc.failk "check/unknown-struct" loc ~notes:(declared_note ctx.env name)
           "unknown struct %s" name)
  | Some s ->
    let seen =
      given_once ~noun:"field" kvs
        ~known:(fun k (v : Ast.expr) ->
          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" (tyname loc (Types.Named name)) k)
    in
    let fields = zii_fill ctx loc seen s.Tast.fields in
    expect ctx 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;
  (* 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 helper, same note and the same [check/duplicate-
     field] kind as the struct path, because it is the same mistake; only the
     noun changes. The unknown-member refusal above stays its own full pass
     rather than being handed to [~known], so that [(U {.i 1 .i 1 .bad 2})] is
     still told about [.bad] first, as it is today. *)
  ignore (given_once ~noun:"member" kvs : (string, Ast.expr) Hashtbl.t);
  (match kvs with
   | (a, _) :: (b, (second : Ast.expr)) :: _ ->
     Loc.failk "check/union-two-members" second.Ast.loc
       "%s is a union, so only one member can be written — give %s or %s, not \
        both"
       name a b
   | _ -> ());
  match kvs with
  (* The two-member case left above, so this sees one or none. *)
  | _ :: _ :: _ -> assert false
  | [] -> expect ctx 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 ctx 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 — literally so: the same [given_once] and [zii_fill], with only
   the index function and the name in the unknown-field message differing — and
   the only other 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 =
    given_once ~noun:"field" kvs
      ~known:(fun k (v : Ast.expr) ->
        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)
  in
  let fields = zii_fill ctx loc seen c.Tast.vfields in
  expect ctx loc ~want
    (mk loc (Types.Named dname) (Tast.MakeCase (dname, c.Tast.vname, fields)))

(* 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. [seen] is what
   [given_once] collected; [fields] is the declaration, and it is the
   declaration that fixes the order. *)
and zii_fill ctx loc seen 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))
    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
  match elem_want, items with
  | None, _ :: _ ->
    (match arr_elem_type ctx items with
     | Some t ->
       let n = Int64.of_int (List.length items) in
       expect ctx loc ~want
         (check_arr ctx ~want:(Some (Types.Array (n, t))) loc items)
     | None ->
       (match
          trial ctx (fun () ->
            dyn_vec ctx loc (map_lr (fun i -> check ctx ~want:Types.Dyn i) items))
        with
        | Ok v -> expect ctx loc ~want v
        | Error d -> mixed_refusal ctx items d))
  | _ ->
  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 — use it where one is expected, \
         or name it, as in (the [0 i32] [])"
  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"
           (tyname loc elem) (tyname loc 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 ctx loc ~want (mk loc (Types.Array (n, elem)) (Tast.Arr items))

(* The element type of an array literal nothing outside it names, or [None]
   for a dyn vector. Every element is looked at on its own terms first, by
   [probe], so nothing here is checked for real — [check_arr] does that once,
   at the answer.

   Elements that agree are a typed array: one type, or numbers that meet at
   the wider of them the way two operands of [+] do. A literal takes the
   others' type if it fits it, so [[(f32 1.0) 2.5]] is an [[2 f32]] and
   [[(u8 1) 300]] an [[2 i32]]. An element that cannot be checked without
   being told what it is — [None], a bare struct — takes the same type.
   Elements that do not agree — [[10 "Hi"]], a dyn beside anything that is
   not one — are a dyn vector, which is what the same brackets are where a
   dyn is expected. Numbers that do not agree are refused instead; see
   [numbers_disagree]. *)
and arr_elem_type ctx (items : Ast.expr list) : Types.t option =
  let natural (i : Ast.expr) =
    match i.Ast.e with
    (* Refused with no want, and only a u64 holds one. *)
    | Ast.UInt _ -> Some (Types.Int Types.U64)
    | _ -> probe ctx i.Ast.loc (fun () -> (check ctx i).Tast.ty)
  in
  let fits t (i : Ast.expr) =
    probe ctx i.Ast.loc (fun () -> ignore (check ctx ~want:t i)) <> None
  in
  let lits, rest = List.partition lone_literal items in
  let typed, needs =
    List.partition_map
      (fun i ->
         match natural i with Some t -> Left (i, t) | None -> Right i)
      rest
  in
  let tys =
    List.filter (fun t -> t <> Types.Never) (List.map snd typed)
  in
  let lit_tys = List.filter_map natural lits in
  let join_with meet = function
    | [] -> None
    | t :: ts ->
      List.fold_left
        (fun acc t -> Option.bind acc (fun a -> meet a t)) (Some t) ts
  in
  let join_all = join_with Types.join in
  let mixed_dyn =
    List.mem Types.Dyn tys
    && (List.exists (fun t -> t <> Types.Dyn) tys || lits <> [])
  in
  let all_fit t = List.for_all (fits t) lits && List.for_all (fits t) needs in
  (* A candidate the literals do not all fit is widened by the ones that do
     not, once: [[x 2.5]] over an i32 [x] meets at f64. *)
  let settle = function
    | None -> None
    | Some t when all_fit t -> Some t
    | Some t ->
      let t' =
        List.fold_left
          (fun acc i ->
             if fits t i then acc
             else
               Option.bind acc (fun a -> Option.bind (natural i) (Types.join a)))
          (Some t) lits
      in
      (match t' with
       | Some t' when not (Types.equal t' t) && all_fit t' -> Some t'
       | _ -> None)
  in
  let candidates =
    if tys <> [] then [ join_all tys ]
    else join_with literal_meet lit_tys :: List.map Option.some lit_tys
  in
  if mixed_dyn then None
  else if tys = [] && lits = [] then
    (match typed, needs with
     | _ :: _, [] -> Some Types.Never
     (* Nothing here says what any of them is. The first one's own refusal is
        the one worth reading. *)
     | _, first :: _ -> ignore (check ctx first); None
     | [], [] -> None)
  else
    match
      List.fold_left
        (fun found c -> match found with Some _ -> found | None -> settle c)
        None candidates
    with
    | Some t -> Some t
    | None ->
      let numeric t = match t with Types.Int _ | Types.Float _ -> true | _ -> false in
      if needs = [] && List.for_all numeric (tys @ lit_tys) then
        numbers_disagree ctx
          (List.filter_map
             (fun i -> Option.map (fun t -> (i, t)) (natural i)) items)
      else None

(* Numbers with no type they all meet at — an i32 beside an f32, an i64 beside
   a u64 — are refused rather than boxed into a dyn vector: the elements are
   all numbers, and which one should move is the program's to say. The fix
   named converts the second of the first disagreeing pair, into the float
   when one of the two is a float and into the first's type otherwise. *)
and numbers_disagree : 'a. ctx -> (Ast.expr * Types.t) list -> 'a =
  fun ctx elems ->
  match elems with
  | [] -> fail Loc.unknown "internal: an array of numbers with no elements"
  | _ :: _ ->
    (* A literal is not one of the disagreeing types when it fits the others:
       each is checked at the type the rest meet at — or, with every element a
       literal, at the u64 a wide one needs — and the first that does not fit
       is the refusal, its own. *)
    let lit (e, _) = lone_literal e in
    let others = List.filter (fun p -> not (lit p)) elems in
    let meet =
      match others with
      | [] ->
        if List.exists (fun (e, _) -> match e.Ast.e with Ast.UInt _ -> true | _ -> false) elems
        then Some (Types.Int Types.U64) else None
      | (_, t) :: ts ->
        List.fold_left (fun acc (_, u) -> Option.bind acc (fun a -> Types.join a u))
          (Some t) ts
    in
    (match meet with
     | Some (Types.Int _ as m) ->
       List.iter
         (fun (e, t) ->
            if lone_literal e && (match t with Types.Int _ -> true | _ -> false)
            then ignore (check ctx ~want:m e))
         elems
     | _ -> ());
    let pool = if others = [] then elems else others in
    let first, t1 = List.hd pool in
    let second, t2 =
      match List.find_opt (fun (_, t) -> Types.join t1 t = None) (List.tl pool) with
      | Some p -> p
      | None ->
        (match List.find_opt (fun (_, t) -> Types.join t1 t = None) elems with
         | Some p -> p
         | None -> List.nth elems (List.length elems - 1))
    in
    let target, moved, moved_ty, other =
      match t1, t2 with
      | Types.Int _, Types.Float _ -> t2, first, t1, second
      | _ -> t1, second, t2, first
    in
    ignore ctx;
    let tn = tyname moved.Ast.loc target in
    Loc.failk "check/array-numbers-disagree" moved.Ast.loc
      ~notes:[ Loc.note other.Ast.loc (Printf.sprintf "this element is %s" tn) ]
      "this array's elements are %s and %s, and neither holds every value of \
       the other — %s"
      (tyname moved.Ast.loc moved_ty) tn
      (match spell_arg "" moved with
       | "" ->
         Printf.sprintf "convert the %s element with the %s cast" (tyname moved.Ast.loc moved_ty) tn
       | x -> Printf.sprintf "convert one, as in (%s %s)" tn x)

(* Elements that do not agree and cannot all become a dyn either: a struct
   beside a number, a type variable beside a literal. The dyn vector's refusal
   would be about dyn, which the program never mentioned, so the elements are
   refused against each other instead — the first one's type is what the rest
   are checked at, and the refusal points back at it. [d] is the answer if
   that finds nothing. *)
and mixed_refusal : 'a. ctx -> Ast.expr list -> Loc.diag -> 'a =
  fun ctx items d ->
  (* Every check here only looks for a better sentence for [d]. *)
  speculate ctx.env @@ fun () ->
  match items with
  | [] -> raise (Loc.Error d)
  | first :: rest ->
    let first = check ctx first in
    let want = match first.Tast.ty with Types.Never -> None | t -> Some t in
    List.iter
      (fun (i : Ast.expr) ->
         match check ctx ?want i with
         | v ->
           (match want with
            | Some t when not (Types.fits ~expected:t ~actual:v.Tast.ty) ->
              fail i.Ast.loc "this array's elements are %s, but this one is %s"
                (tyname i.Ast.loc t) (tyname i.Ast.loc v.Tast.ty)
            | _ -> ())
         | exception Loc.Error e when e.Loc.dloc = i.Ast.loc && want <> None ->
           raise
             (Loc.Error
                { e with
                  Loc.notes =
                    e.Loc.notes
                    @ [ Loc.note first.Tast.loc
                          (Printf.sprintf
                             "this array's first element is %s, so every \
                              element is"
                             (tyname first.Tast.loc first.Tast.ty)) ] }))
      rest;
    raise (Loc.Error d)

(* A dyn vector built where it stands from elements already checked at dyn:
   the runtime's own vec, pushed to in order. *)
and dyn_vec ctx loc (items : Tast.expr list) =
  let v = fresh_slot ctx Types.Dyn in
  let vval = mk loc Types.Dyn (Tast.Local v) in
  let pushes =
    List.map (fun x -> rt loc Types.Unit "flan_dyn_push" [ vval; x; here loc ])
      items
  in
  mk loc Types.Dyn
    (Tast.Let ([ (v, rt loc Types.Dyn "flan_dyn_vec_new" []) ], pushes @ [ vval ]))

(* ── (array-fill [r c] v) and (array-gen [r c] f) ──────────────────────

   TODO.org, "A value-producing array constructor". [(array 4 T)] is
   the zeroed array and [dotimes] is Unit, so between them there was no way to
   write "an array of these" as an *expression* — which is what a defonce
   initialiser has to be. These are that expression, at any rank.

   **The lowering, and why it is not an aggregate value.** [Tast.Arr] is the
   one the backends already have, and both build it element by element from a
   list that is as long as the array: an [insertvalue] chain on LLVM, a store
   per element on x86. A fill of [[600 800 u8]] is half a million elements and
   there is no list to be had. So these lower to a *loop over a slot*: bind the
   array to a slot, zero it, run one loop per dimension writing each element
   through [Tast.Set] of a [Pindex], and answer with the slot. Nothing new
   reaches a backend — it is [While], [Set] and [Pindex], which is the same
   argument [check_loop] makes for [recur] — and both backends get the form
   with no edit, the js one included.

   The value stays value-like for all that: the slot is the form's own, nothing
   else can name it, and the [Local] at the end is copied out exactly as any
   other array-typed expression is. In a [defonce] initialiser the copy is the
   store into the global that the startup function does; in a [let] it is the
   binding's own store. An in-place fill of the *destination*, skipping the
   temporary, would be the faster lowering and is deliberately not what this
   does — the destination is not a thing an expression may know about, and
   [mem2reg] plus the store-to-load forwarding both backends already get is
   where that cost goes.

   The slot is zeroed before the loops rather than left [Uninit]. An element
   type of [dyn] is the reason it has to be: between the binding and the
   store that overwrites it the collector may run, and it would read whatever
   the frame happened to hold as a dyn word. The double write is the price and
   it is one memset.

   **Row-major, pinned.** The first dimension is the outermost loop, so
   [[i][j]] runs with [j] fastest. A generator that prints, or counts, or
   appends, observes that order, so it is a promise: this is the order, not
   the order the nesting happened to come out in.

   **Evaluated once.** The fill value and the generator *value* are each bound
   to a slot before any loop starts, so [(array-fill [n] (next-id))] is one
   call and n copies of its answer — not n calls. A generator's *body*, of
   course, runs once per element; that is what it is for. *)

(* The dimensions, resolved by the same rule the [n T] type spelling uses —
   [array_len] is literally that rule — with the one extra condition this form
   has and the type spelling does not: the fill counts in i32, because every
   index in the language is an i32, so a dimension that does not fit one has no
   loop that could reach its end. *)
and array_dims ctx loc (dims : Ast.len list) =
  List.map
    (fun d ->
       let n = array_len ctx.env loc d in
       if n < 0L || Int64.compare n 2147483647L > 0 then
         fail loc
           "%Ld is not a dimension a fill can count to: an index in this \
            language is an i32, and so is the loop that writes the elements"
           n;
       n)
    dims

(* [r c] and an element type make [r [c T]], outermost first. *)
and array_of_dims ns elem =
  List.fold_right (fun n t -> Types.Array (n, t)) ns elem

(* The element type an annotation asks for, peeled one [Array] per dimension.
   [None] where the annotation is not an array of at least this rank: the
   mismatch is then [expect]'s to report against the whole type, which is the
   message that names both shapes rather than one of their leaves. *)
and array_elem_want rank want =
  if rank = 0 then want
  else
    match want with
    | Some (Types.Array (_, t)) -> array_elem_want (rank - 1) (Some t)
    | _ -> None

(* The shared lowering. [pre] is bound before any loop runs — that is what
   "evaluated once" means — and [element] is handed the index locals, in
   dimension order, to build the value one element takes. *)
and array_build ctx loc ns elem ~pre ~element =
  let aty = array_of_dims ns elem in
  let arr = fresh_slot ctx aty in
  let arrv = mk loc aty (Tast.Local arr) in
  let islots = List.map (fun _ -> fresh_slot ctx index_ty) ns in
  let ivals = List.map (fun s -> mk loc index_ty (Tast.Local s)) islots in
  let zero = mk loc index_ty (Tast.Int (0L, Types.I32)) in
  let one = mk loc index_ty (Tast.Int (1L, Types.I32)) in
  let store =
    mk loc Types.Unit (Tast.Set (Tast.Pindex (arrv, ivals), element ivals))
  in
  (* One [Let] and one [While] per dimension, the first dimension outermost.
     The counter is bound *inside* the enclosing loop's body so that it is
     re-zeroed on every pass of it, and the increment is the latch for the
     reason [check_dotimes] gives. These loops carry no [break] and no
     [continue], which is the condition [tast.ml] puts on a [While] the
     checker invents. *)
  let rec nest ns islots =
    match ns, islots with
    | [], [] -> store
    | n :: ns, i :: islots ->
      let iv = mk loc index_ty (Tast.Local i) in
      let limit = mk loc index_ty (Tast.Int (n, Types.I32)) in
      let cond = mk loc Types.Bool (Tast.Prim (Tast.Lt, [ iv; 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 loop =
        mk loc Types.Unit (Tast.While (cond, [ nest ns islots ], [ step ]))
      in
      mk loc Types.Unit (Tast.Let ([ (i, zero) ], [ loop ]))
    | _, _ -> fail loc "array fill: one counter per dimension"
  in
  mk loc aty
    (Tast.Let (pre @ [ (arr, mk loc aty (Tast.Zero aty)) ],
               [ nest ns islots; arrv ]))

(* (the T e): [e] with [T] as its expectation, which is every conversion an
   annotation would make — a literal built at T, a narrower number widened —
   and nothing more. A dyn operand is the exception: an expectation would
   unbox it and trap at run time on a mismatch, and [the] is a statement about
   the type rather than a conversion, so it is refused and the cast named.

   [(the [T] [...])] asks for the literal's element type and answers the
   [n T] the literal is, since an array literal is never a slice. *)
and check_the ctx ~want loc (t : Ast.texpr) (v : Ast.expr) =
  let ty = resolve ctx.env t in
  (* A typed .fln lambda, [fn(c: C) -> bool => ...], reads as [(the (Fn [C]
     bool) (fn ...))]; where a CFn of the same signature is wanted, the
     literal is that CFn, as an untyped one would be. *)
  let ty =
    match ty, v.Ast.e, want with
    | Types.Fn (ps, r), Ast.Fn _, Some (Types.CFn (ps', r'))
      when List.length ps = List.length ps'
           && fits_shape (Types.Fn (ps', r')) (Types.Fn (ps, r)) ->
      (* A generic's [CFn($t) -> $t] binds [$t] from the literal's own
         types, as it would from any other argument's. *)
      Types.CFn (ps, r)
    | _ -> ty
  in
  let is_nil = match v.Ast.e with Ast.Var "nil" -> true | _ -> false in
  (* Quietly: what [v] is on its own terms is not a use of a literal local
     inside it — [[x]] read with no want would pin x at its guess, and the
     annotation's want below is the use that says what x is. *)
  let own_ty () =
    let was = !lit_quiet in
    lit_quiet := true;
    Fun.protect ~finally:(fun () -> lit_quiet := was) (fun () ->
        probe ctx loc (fun () -> (check ctx v).Tast.ty))
  in
  if ty <> Types.Dyn && not is_nil
     && own_ty () = Some Types.Dyn
     (* A keyword naming one of an enum's members is that member at the
        enum's type, not a dyn: [let d: Dir = :north]. *)
     && not (match ty, v.Ast.e with Types.Enum _, Ast.Kw _ -> true | _ -> false)
     (* An array literal that is a dyn vector only because its elements do
        not agree among themselves — [[1, None]] — is built at the annotation
        when every element fits it, as [x: [2 i32?] = [1, None]] (decision
        138). Nothing is converted: the literal is built at T. *)
     && not (let rec holds_option = function
                | Types.Option _ -> true
                | Types.Array (_, t) | Types.Slice (_, t) -> holds_option t
                | _ -> false
              in
              let rec elems_option = function
                | Types.Array (_, t) | Types.Slice (_, t) -> holds_option t
                | Types.Option t -> elems_option t
                | _ -> false
              in
              match v.Ast.e with
              | Ast.Arr _ when elems_option ty ->
                probe ctx loc (fun () -> ignore (check ctx ~want:ty v)) <> None
              | _ -> false)
  then begin
    let tn = tyname loc ty in
    let numeric = match ty with Types.Int _ | Types.Float _ -> true | _ -> false in
    (* In a .fln file the user wrote [x: T = v], not [the]. *)
    let fln = fln_source loc in
    let the_ = if fln then "a type annotation" else "the" in
    if numeric then
      fail v.Ast.loc
        "%s checks a value as %s and does not convert one, and this is a dyn \
         — %s"
        the_ tn
        (match spell_arg "" v with
         | s when fln && s <> "" && not (String.exists (fun c -> c = ' ' || c = '(') s) ->
           Printf.sprintf "write %s(%s) to convert it" tn s
         | s when s = "" || fln -> Printf.sprintf "convert it with the %s cast instead" tn
         | s -> Printf.sprintf "write (%s %s) to convert it" tn s)
    else
      (* What a dyn does at this type is the boundary's own answer, asked of
         it rather than restated: some types take one where a value is passed,
         returned or stored, and the rest do not take one at all. *)
      let crosses =
        probe ctx loc (fun () ->
          ignore (expect ctx v.Ast.loc ~want:(Some ty) (check ctx v)))
      in
      match crosses with
      | Some () ->
        fail v.Ast.loc
          "%s checks a value as %s and does not convert one, and this is a \
           dyn — a dyn becomes a %s where a %s is passed, returned or stored"
          the_ tn tn tn
      | None ->
        (match speculate ctx.env (fun () -> check ctx ~want:ty v) with
         | _ ->
           fail v.Ast.loc
             "%s checks a value as %s and does not convert one, and this is \
              a dyn" the_ tn
         | exception Loc.Error d ->
           fail v.Ast.loc
             "%s checks a value as %s and does not convert one, and this is \
              a dyn — %s" the_ tn d.Loc.dmsg)
  end;
  let r =
    match ty, v.Ast.e with
    | Types.Slice (_, elem), Ast.Arr items ->
      check_arr ctx
        ~want:(Some (Types.Array (Int64.of_int (List.length items), elem)))
        v.Ast.loc items
    | _ -> expect ctx v.Ast.loc ~want:(Some ty) (check ctx ~want:ty v)
  in
  (* (the dyn nil) is a dyn value that holds nil, not the literal: at a typed
     want it traps at run time as any dyn holding nil does, where a bare nil
     is refused. (the dyn 1) is likewise a dyn, not a literal that brings
     nothing dyn to an operator ([no_bare_nil]). [is_nil_lit] and
     [boxed_literal] see through nothing, so the [Do] hides both. *)
  let r =
    if ty = Types.Dyn && (is_nil_lit r || boxed_literal r <> None) then
      mk loc Types.Dyn (Tast.Do [ r ])
    else r
  in
  expect ctx loc ~want r

(* [f] run for its answer alone: whatever it wrote into the context is put
   back whether it succeeded or not, so a form can be checked once to see what
   it is and then checked again for real. [None] if it was refused. *)
and probe : 'a. ctx -> Loc.t -> (unit -> 'a) -> 'a option = fun ctx loc f ->
  let answer = ref None in
  (match
     trial ctx (fun () ->
       answer := Some (f ());
       raise (Loc.Error (Loc.diag loc "probe")))
   with
   | _ -> ());
  !answer

and check_array_fill ctx ~want loc dims v =
  let ns = array_dims ctx loc dims in
  let elem_want = array_elem_want (List.length ns) want in
  (* The annotation's element type is the [want] the value is checked against,
     so a disagreement is reported at the value, in the ordinary
     expected/found words, rather than as a whole-array mismatch a line up. *)
  let v = check ctx ?want:elem_want v in
  let elem = match elem_want with Some t -> t | None -> v.Tast.ty in
  (* [resolve] refuses a fixed array of function values, because the elements
     this form does not write would be zeroed and a zeroed function value is a
     null pointer. The type is built here without going through [resolve], so
     the same guard has to be asked here. *)
  no_zeroed_fn loc "a fixed array's element" elem;
  let vs = fresh_slot ctx elem in
  let vv = mk loc elem (Tast.Local vs) in
  expect ctx loc ~want
    (array_build ctx loc ns elem ~pre:[ (vs, v) ] ~element:(fun _ -> vv))

and check_array_gen ctx ~want loc dims f =
  let ns = array_dims ctx loc dims in
  let rank = List.length ns in
  let plural n = if n = 1 then "" else "s" in
  let f =
    match f.Ast.e with
    (* The canonical inline form, [(array-gen [3 4] (fn [i j] ...))]. On its
       own [check] would refuse the fn — it takes its types from its position,
       and only an argument position names them — but *this* position knows
       them just as well: one i32 index per dimension, and the annotated
       element type as the return where the annotation reaches this deep.
       With no annotation the return is left for the body to say, which is
       the same inference the fill value gets. Arity is checked here so the
       refusal talks about dimensions and indices, not about parameters some
       (Fn ...) want expected. *)
    | Ast.Fn (ps, fbody) ->
      let got = List.length ps in
      if got <> rank then
        fail f.Ast.loc
          "this array-gen has %d dimension%s, so its generator is called with \
           %d index%s — and this one takes %d argument%s"
          rank (plural rank) rank
          (if rank = 1 then "" else "es") got (plural got);
      check_fn ctx ~want:None
        ~gen:(List.init rank (fun _ -> index_ty), array_elem_want rank want)
        f.Ast.loc ps fbody
    | _ -> check ctx f
  in
  let elem =
    (* Either function type: the generator is called and nothing here cares
       whether an environment rides along. *)
    match fn_sig f.Tast.ty with
    | Some (ps, r) ->
      let got = List.length ps in
      if got <> rank then
        fail f.Tast.loc
          "this array-gen has %d dimension%s, so its generator is called with \
           %d index%s — and this one takes %d argument%s"
          rank (plural rank) rank
          (if rank = 1 then "" else "es") got (plural got);
      List.iteri
        (fun k p ->
           if not (Types.equal p index_ty) then
             fail f.Tast.loc
               "an index is an i32, and this generator's argument %d is %s"
               (k + 1) (tyname loc p))
        ps;
      r
    | None ->
      fail f.Tast.loc
        "array-gen's second element is a function value, called once per \
         element with one i32 index per dimension, and this is %s — for one \
         value repeated, write array-fill"
        (tyname loc f.Tast.ty)
  in
  no_zeroed_fn loc "a fixed array's element" elem;
  let fs = fresh_slot ctx f.Tast.ty in
  let fv = mk loc f.Tast.ty (Tast.Local fs) in
  expect ctx loc ~want
    (array_build ctx loc ns elem ~pre:[ (fs, f) ]
       ~element:(fun idxs -> mk loc elem (Tast.CallPtr (fv, idxs))))

and check_match ctx ?(tail = false) ?(used = false) ?(stmt = false) ?(opt = false)
    ?(flat = false) ?opt_rest ?want loc scrutinee arms =
  (* [stmt] is an [if let] with no else: a statement, Unit whatever its arm
     answers, as a one-armed [if] is when nothing keeps it. [opt] is one that
     is kept: its arm answers [Some], and the arm with no body [None]. *)
  let used = used && not stmt in
  let arms_ast_for_opt = arms in
  let want0 = want in
  let want =
    if stmt then None
    else if opt then
      (match want with
       | Some (Types.Option _) when flat -> want
       | Some (Types.Option i) -> Some i
       | _ -> None)
    else want
  in
  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 an i32 at run time and its members are all known, so the
       arms are a chain of [=] over a temporary, built at the foot of this
       function — a desugaring, not a new IR node. The exhaustiveness check is
       the one a data type gets. *)
    | Types.Enum n -> `Enum (n, Hashtbl.find ctx.env.enums 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 nothing in one records which member was written, \
         so there is nothing to match on. Read the member you mean with \
         (.member u), or use a defdata" n
    (* A number, a string or a dyn: the arms are literals, and each is the
       test (= t lit) over one temporary — the enum's chain, with [=]'s own
       two lowerings for the test, so a match over a dyn means what [=] over
       it means. [is_equatable]'s set minus the enums, which are above, and
       minus bool, below. *)
    | (Types.Int _ | Types.Float _ | Types.Char | Types.String | Types.Dyn) as t -> `Lit t
    (* A bool is a two-member enum spelled true and false: the same chain,
       and exhaustive without a [_] once both are named. *)
    | Types.Bool -> `Bool
    | other ->
      fail loc
        "match works on an Option, a data type, an enum, a bool, a number, a \
         string or a dyn, not on %s"
        (tyname loc other)
  in
  (* A literal arm, spelled as it was written, for the refusals that name one. *)
  let spell (e : Ast.expr) =
    match e.Ast.e with
    | Ast.Int n -> Int64.to_string n
    | Ast.UInt (_, t) -> t
    | Ast.Float x when Float.is_integer x && Float.abs x < 1e15 ->
      Printf.sprintf "%.1f" x
    | Ast.Float x ->
      (* The shortest spelling that reads back as the same float. *)
      let rec go p =
        let t = Printf.sprintf "%.*g" p x in
        if p >= 17 || float_of_string t = x then t else go (p + 1)
      in
      go 1
    | Ast.Byte b -> Form.byte_repr b
    | Ast.Str t -> Printf.sprintf "%S" t
    | Ast.Kw k -> ":" ^ k
    | Ast.Var b -> b
    | _ -> "this literal"
  in
  let what_ty t = match t with Types.Dyn -> "a dyn" | t -> tyname loc t in
  (* A literal match that compiles, over the scrutinee's own name where it
     has one, for the refusals that need to show the shape. *)
  let lit_arms_fix t =
    let name =
      match scrutinee.Ast.e with Ast.Var n -> n | _ -> "t"
    in
    Printf.sprintf "(match %s %s)" name
      (match t with
       | Types.String -> "\"yes\" 1 _ 0"
       | Types.Float _ -> "0.5 1 _ 0"
       | Types.Dyn -> "5 1 :go 2 _ 0"
       | _ -> "5 1 _ 0")
  in
  let bool_fix () =
    let name = match scrutinee.Ast.e with Ast.Var n -> n | _ -> "b" in
    Printf.sprintf "(match %s true 1 false 0)" name
  in
  (* The checked literal of each literal arm, by the key [resolve_pat] gave it. *)
  let lits : (string, Tast.expr) Hashtbl.t = Hashtbl.create 8 in
  let lit_values = ref [] in
  (* A literal arm over [t]: its checked value under a fresh key in [lits],
     refused if [t] cannot hold it or an earlier arm already equals it. *)
  let lit_arm (a : Ast.arm) t (e : Ast.expr) =
    let v =
      (* [=]'s dyn pair checks its literal at dyn, which boxes it. *)
      match trial ctx (fun () -> check ctx ~want:t e) with
      | Ok v -> v
      | Error _ ->
        (* A literal that does not fit is refused, where [=] would widen
           the pair and let the arm quietly never match. The literal's
           own refusal is not repeated: its fixes are casts, and a cast
           is not a pattern. *)
        (match t with
         | Types.Dyn ->
           fail a.Ast.aloc
             "this match is over a dyn, which holds a number as an i64 or \
              an f64, and %s fits in neither. Change the arm to a value an \
              i64 holds, or remove it" (spell e)
         | _ -> ());
        let tn = tyname loc t in
        let an =
          match tn.[0] with
          | 'a' | 'e' | 'f' | 'i' | 'o' -> "an " ^ tn
          | _ -> "a " ^ tn
        in
        let why =
          match e.Ast.e, t with
          | Ast.Str _, _ -> "is a string"
          | _, Types.String -> "is a number"
          | (Ast.Int _ | Ast.UInt _ | Ast.Float _), Types.Char -> "is a number"
          | Ast.Float x, Types.Int _ when not (Float.is_integer x) ->
            "is not a whole number"
          | Ast.Float _, Types.Int _ -> "is a float"
          | _ -> "does not fit in one"
        in
        fail a.Ast.aloc
          "this match is over %s, so each arm has to be %s, and %s %s. \
           Change the arm to a value %s holds, or remove it"
          tn an (spell e) why an
    in
    (* The arm's value at the scrutinee's type, and a second arm [=] could
       not tell from an earlier one is refused, since it can never be
       reached: 97 and \a are one u8, 0.1 and 0.10000000001 are one f32,
       and over a dyn 1 and 1.0 are equal. Compared pairwise rather than
       hashed, because dyn = between an integer and a float goes through
       the float and is not transitive past 2^53. *)
    let value =
      let f32 x = Int32.float_of_bits (Int32.bits_of_float x) in
      let num x =
        match t with Types.Float Types.F32 -> `F (f32 x) | _ -> `F x
      in
      match e.Ast.e, t with
      | Ast.Str s, _ -> `S s
      | (Ast.Int n | Ast.UInt (n, _)), Types.Float _ -> num (Int64.to_float n)
      | Ast.Byte b, Types.Float _ -> num (float_of_int b)
      | (Ast.Int n | Ast.UInt (n, _)), _ -> `I n
      | Ast.Byte b, _ -> `I (Int64.of_int b)
      | Ast.Float x, _ -> num x
      | Ast.Kw k, _ -> `K k
      | Ast.Var b, _ -> `B b
      | _ -> assert false
    in
    let same x y =
      match x, y with
      | `I a, `I b -> Int64.equal a b
      | `F a, `F b -> a = b
      | `I a, `F b | `F b, `I a -> Int64.to_float a = b
      | `S a, `S b | `K a, `K b | `B a, `B b -> String.equal a b
      | _ -> false
    in
    (match List.find_opt (fun (w, _) -> same value w) !lit_values with
     | Some (_, earlier) when earlier = spell e ->
       fail a.Ast.aloc "this match has two %s arms" earlier
     | Some (_, earlier) ->
       fail a.Ast.aloc
         "this match has two %s arms — %s equals it as %s, so this arm is \
          never reached. Remove it"
         earlier (spell e)
         (match t with
          | Types.Dyn -> "a dyn"
          | t ->
            let tn = tyname loc t in
            (match tn.[0] with
             | 'a' | 'e' | 'f' | 'i' | 'o' -> "an " ^ tn
             | _ -> "a " ^ tn))
     | None -> ());
    lit_values := (value, spell e) :: !lit_values;
    let key = string_of_int (Hashtbl.length lits) in
    Hashtbl.replace lits key v;
    Some key, []
  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
    | `Enum (n, members), Ast.Pkw k ->
      if not (List.mem_assoc k members) then begin
        let all =
          String.concat " " (List.map (fun (m, _) -> ":" ^ m) members)
        in
        match member_near_miss members k with
        | Some (m, _) ->
          fail a.Ast.aloc "%s has no member :%s — did you mean :%s? It has %s"
            n k m all
        | None -> fail a.Ast.aloc "%s has no member :%s — it has %s" n k all
      end;
      Some k, []
    (* [Dir.north ->], the member named through its enum. *)
    | `Enum (n, members), Ast.Pctor (c, [])
      when String.length c > String.length n + 1
           && String.sub c 0 (String.length n + 1) = n ^ "." ->
      let k = String.sub c (String.length n + 1) (String.length c - String.length n - 1) in
      if not (List.mem_assoc k members) then
        fail a.Ast.aloc "%s has no member %s — it has %s" n k
          (String.concat " " (List.map (fun (m, _) -> n ^ "." ^ m) members));
      Some k, []
    | `Enum (n, members), Ast.Pctor (c, _) ->
      fail a.Ast.aloc
        "this match is over the enum %s, and %s is not one of its members. An \
         arm names a member as a keyword: %s" n c
        (String.concat " " (List.map (fun (m, _) -> ":" ^ m) members))
    | `Lit t, Ast.Plit e -> lit_arm a t e
    (* Over a dyn a keyword is a value like any other, so :north is the arm
       (= d :north), and true and false are the arms (= d true) and
       (= d false). *)
    | `Lit Types.Dyn, Ast.Pkw k ->
      lit_arm a Types.Dyn { Ast.e = Ast.Kw k; loc = a.Ast.aloc }
    | `Lit Types.Dyn, Ast.Pctor (("true" | "false") as b, []) ->
      lit_arm a Types.Dyn { Ast.e = Ast.Var b; loc = a.Ast.aloc }
    | `Bool, Ast.Pctor (("true" | "false") as b, []) -> Some b, []
    | `Bool, Ast.Pctor (c, _) ->
      fail a.Ast.aloc
        "%s names a case, and this match is over a bool, whose arms are true \
         and false, as in %s" c (bool_fix ())
    | `Bool, Ast.Pkw k ->
      fail a.Ast.aloc
        ":%s is a keyword, and this match is over a bool, whose arms are true \
         and false, as in %s" k (bool_fix ())
    | `Bool, Ast.Plit e ->
      fail a.Ast.aloc
        "%s is a literal, and this match is over a bool, whose arms are true \
         and false, as in %s" (spell e) (bool_fix ())
    | `Lit t, Ast.Pkw k ->
      fail a.Ast.aloc
        ":%s is an enum member, and this match is over %s, whose arms are \
         literals, as in %s" k (what_ty t) (lit_arms_fix t)
    | `Lit t, Ast.Pctor (c, _) ->
      fail a.Ast.aloc
        "%s names a case, and this match is over %s, whose arms are \
         literals, as in %s" c (what_ty t) (lit_arms_fix t)
    | `Option _, Ast.Plit e ->
      fail a.Ast.aloc
        "%s is a literal, and this match is over an Option, whose arms are \
         (Some x) and None" (spell e)
    | `Enum (n, members), Ast.Plit e ->
      fail a.Ast.aloc
        "%s is a literal, and this match is over the enum %s, whose arms \
         name its members as keywords: %s" (spell e) n
        (String.concat " " (List.map (fun (m, _) -> ":" ^ m) members))
    | `Data u, Ast.Plit e ->
      fail a.Ast.aloc
        "%s is a literal, and this match is over the data type %s, whose \
         arms name its cases: %s" (spell e) u.Tast.dname
        (String.concat ", "
           (List.map (fun (v : Tast.variant) -> v.Tast.vname) u.Tast.cases))
    | `Option _, Ast.Pkw k ->
      fail a.Ast.aloc
        ":%s is an enum member, and this match is over an Option, whose arms \
         are (Some x) and None" k
    | `Data u, Ast.Pkw k ->
      fail a.Ast.aloc
        ":%s is an enum member, and this match is over the data type %s, \
         whose arms name its cases: %s" k u.Tast.dname
        (String.concat ", "
           (List.map (fun (v : Tast.variant) -> v.Tast.vname) u.Tast.cases))
    | `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 resolved =
    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"
                (match subject, a.Ast.pat with
                 | `Enum _, _ -> ":" ^ c
                 | _, Ast.Plit e -> spell e
                 | _ -> c);
            Hashtbl.add seen c ());
         (a, ctor, binds))
      arms
  in
  (* With nothing expected of the match, the first arm's type is every arm's —
     unless that arm is a bare literal, which has no type until asked. So the
     arms whose value is a literal are checked last, and take their type from
     the others, as an [if]'s literal arm does. The order is only the order
     they are checked in; they are put back in source order below. *)
  let literal_arm ((a : Ast.arm), _, _) =
    match List.rev a.Ast.body with last :: _ -> adapts last | [] -> false
  in
  (* Every arm a literal: they meet at the wider of their own types, as an
     [if]'s two do. *)
  (if !want = None && resolved <> [] && List.for_all literal_arm resolved then
     let lasts =
       List.map (fun ((a : Ast.arm), _, _) -> List.hd (List.rev a.Ast.body))
         resolved
     in
     match lasts with
     | first :: rest ->
       let j =
         List.fold_left
           (fun acc x ->
              Option.bind acc (fun a ->
                Option.bind (literal_join ctx first x) (literal_meet a)))
           (literal_join ctx first first) rest
       in
       (match j with
        | Some t when not (Types.equal t (Types.Int Types.I32)) -> want := Some t
        | _ -> ())
     | [] -> ());
  (* With nothing expected, the arms meet at [arm_join], as an [if]'s do, in
     whatever order they are written: each typed arm is checked on its own
     terms, the join so far grows with it, and every arm is brought to the
     final join at the end. An arm that needs an expectation — [nil], a bare
     struct — is checked at the join so far, as it was at the first arm's
     type before. *)
  let free = !want = None in
  let order =
    let idx = List.mapi (fun i r -> (i, r)) resolved in
    if !want <> None then idx
    else
      let typed = List.filter (fun (_, r) -> not (literal_arm r)) idx in
      (* A bare [None] that would be checked first has nothing to take its
         type from and was always refused; it goes after the others, so it
         meets their T at T? (decision 138). Only the leading ones move, so
         no order that checked before changes. *)
      let none_arm (_, ((a : Ast.arm), _, _)) =
        match List.rev a.Ast.body with last :: _ -> is_none_lit last | [] -> false
      in
      let rec lead acc = function
        | x :: rest when none_arm x -> lead (x :: acc) rest
        | rest -> (List.rev acc, rest)
      in
      let nones, typed =
        match lead [] typed with
        | _ :: _ as nones, rest when List.length nones < List.length idx -> nones, rest
        | _ -> [], typed
      in
      typed @ List.filter (fun (_, r) -> literal_arm r) idx @ nones
  in
  let checked =
    map_lr
      (fun (i, ((a : Ast.arm), ctor, binds)) ->
         i,
         branch ctx (fun () ->
           (* What each name in this arm is, in words, for the one refusal
              that needs it: a case pattern binds fields positionally, so the
              i'th name is the i'th field of the case the arm named. Derived
              here rather than carried out of [resolve_pat], because the case
              and the subject are both still in hand and the alternative was
              widening that function's result for one message. *)
           let fields =
             match subject, ctor with
             | `Data u, Some c ->
               (match Tast.case_index u c with
                | Some (_, v) ->
                  List.map
                    (fun (fd : Tast.field) ->
                       Printf.sprintf "%s.%s's field %s" u.Tast.dname c
                         fd.Tast.fname)
                    v.Tast.vfields
                | None -> [])
             | `Option _, Some "Some" -> [ "the Option's payload" ]
             | _ -> []
           in
           let binds =
             List.mapi
               (fun i (n, ty) ->
                  let what = List.nth_opt fields i in
                  bind ctx ?what 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;
           ctx.used <- used;
           let arm = (a, ctor, binds) in
           let empty = opt && a.Ast.body = [] in
           let body =
             if empty then unit_at a.Ast.aloc else
             if free && !want <> None && not (literal_arm arm) then
               (* As an [if]'s else arm: at the join so far first, on its
                  own terms only when that is refused as a mismatch. *)
               let at w () = block ctx ?want:w a.Ast.aloc a.Ast.body in
               let w = Option.get !want in
               let head = List.hd a.Ast.body in
               let at_join () =
                 match
                   List.find_opt
                     (fun (n, (sc, r), w', _) ->
                        n == head && r == ctx.ret && Types.equal w' w
                        && same_scope sc ctx.scope)
                     (Hashtbl.find_all arm_failed head.Ast.loc)
                 with
                 | Some (_, _, _, d) -> Error d
                 | None ->
                   (match trial ctx (at (Some w)) with
                    | Ok b -> Ok b
                    | Error d ->
                      if !lit_recording = 0 then Hashtbl.add arm_failed head.Ast.loc
                        (head, (ctx.scope, ctx.ret), w, d);
                      Error d)
               in
               (* Where it would be refused: an arm fine at T? — [None],
                  [Some(1)] — meets a T join at T? (decision 138), and
                  [arm_join] wraps the arms before it. *)
               let refused () =
                 let fallback () = at !want () in
                 match w with
                 | Types.Option _ | Types.Dyn | Types.Unit -> fallback ()
                 | _ ->
                   let oty = Types.Option w in
                   (match trial ctx (at (Some oty)) with
                    | Ok b when Types.equal b.Tast.ty oty -> b
                    | _ -> fallback ())
               in
               match at_join () with
               | Ok b ->
                 (match opened_dyn ~box:(to_dyn ctx) b with
                  | Some box -> want := Some Types.Dyn; box
                  | None -> b)
               | Error d ->
                 (match
                    trial ctx (fun () ->
                        let b = at None () in
                        if is_mismatch d || Types.equal b.Tast.ty Types.Dyn then b
                        else
                          raise (Loc.Error (Loc.diag ~kind:not_kept b.Tast.loc "")))
                  with
                  | Ok b -> b
                  | Error own when String.equal own.Loc.kind not_kept ->
                    refused ()
                  | Error own when is_mismatch d && not (is_mismatch own) ->
                    at None ()
                  | Error _ -> refused ())
             else block ctx ?want:!want a.Ast.aloc a.Ast.body
           in
           let body =
             if stmt && body.Tast.ty <> Types.Unit && body.Tast.ty <> Types.Never
             then mk body.Tast.loc Types.Unit (Tast.Do [ body; unit_at body.Tast.loc ])
             else body
           in
           (if body.Tast.ty <> Types.Never && not stmt && not empty then
              match !want with
              | None -> want := Some body.Tast.ty
              | Some w when free ->
                (match arm_join w body.Tast.ty with
                 | Some j -> want := Some j
                 | None -> ())
              | Some _ -> ());
           { Tast.acase = ctor; binds; abody = [ body ] }))
      order
  in
  let checked =
    match free, !want with
    | true, Some j ->
      (* Said at the arm's value, its last form, as a refusal checked at the
         join would have been — not at its pattern. *)
      let rec value (x : Ast.expr) =
        match x.Ast.e with
        | Ast.Do (_ :: _ as xs) | Ast.Let (_, (_ :: _ as xs)) ->
          value (List.hd (List.rev xs))
        | _ -> x.Ast.loc
      in
      let value_loc i =
        let (a : Ast.arm), _, _ = List.nth resolved i in
        match List.rev a.Ast.body with
        | x :: _ -> value x
        | [] -> a.Ast.aloc
      in
      (* Each arm refused on its own, so every arm that cannot meet the join
         is said, as each would be checked at it. *)
      List.map
        (fun (i, (arm : Tast.arm)) ->
           let empty =
             opt && (let (a : Ast.arm), _, _ = List.nth resolved i in a.Ast.body = [])
           in
           match arm.Tast.abody with
           | [ b ] when not (empty || Types.equal b.Tast.ty j || b.Tast.ty = Types.Never) ->
             let at = value_loc i in
             let b =
               try expect ctx at ~want:(Some j) b
               with Loc.Error d -> refuse_or_poison ctx.env at d
             in
             (i, { arm with Tast.abody = [ b ] })
           | _ -> (i, arm))
        checked
    | _ -> checked
  in
  let arms =
    List.map snd (List.sort (fun (i, _) (j, _) -> compare i j) checked)
  in
  (* [opt]: what the pattern's arm answered decides the whole, as a
     one-armed [if]'s branch does — no value is a statement, Never stays
     Never, a dyn is the value or nil, and anything else is [Some] of it. The
     arm with no body is the rest of the chain, [opt_rest], checked now that
     its want is known, or [None] when the chain ends here. *)
  let opt_result = ref None in
  let arms =
    if not opt then arms
    else
      let raw =
        List.fold_left2
          (fun acc (a : Ast.arm) (arm : Tast.arm) ->
             match a.Ast.body, arm.Tast.abody with
             | _ :: _, [ b ] -> Some b.Tast.ty
             | _ -> acc)
          None arms_ast_for_opt arms
      in
      let rest ~used ?want () =
        match opt_rest with
        | Some f -> Some (f ~used ?want ())
        | None -> None
      in
      let fill body_of wild_of =
        List.map2
          (fun (a : Ast.arm) (arm : Tast.arm) ->
             match a.Ast.body, arm.Tast.abody with
             | [], _ -> { arm with Tast.abody = [ wild_of a ] }
             | _, [ b ] -> { arm with Tast.abody = [ body_of b ] }
             | _ -> arm)
          arms_ast_for_opt arms
      in
      match raw with
      | None | Some Types.Unit ->
        opt_result := Some Types.Unit;
        let r = rest ~used:false () in
        fill Fun.id (fun a ->
            match r with
            | Some e when e.Tast.ty = Types.Unit || e.Tast.ty = Types.Never -> e
            | Some e -> mk e.Tast.loc Types.Unit (Tast.Do [ e; unit_at e.Tast.loc ])
            | None -> unit_at a.Ast.aloc)
      | Some Types.Never ->
        (match rest ~used:true ?want:want0 () with
         | Some e ->
           opt_result := Some e.Tast.ty;
           fill Fun.id (fun _ -> e)
         | None ->
           (match want0 with
            | Some (Types.Option _ as o) ->
              opt_result := Some o;
              fill Fun.id (fun a -> mk a.Ast.aloc o Tast.None_)
            | _ ->
              opt_result := Some Types.Unit;
              fill Fun.id (fun a -> unit_at a.Ast.aloc)))
      | Some Types.Dyn ->
        opt_result := Some Types.Dyn;
        let r = rest ~used:true ~want:Types.Dyn () in
        fill Fun.id (fun a ->
            match r with
            | Some e -> e
            | None -> rt a.Ast.aloc Types.Dyn "flan_dyn_nil" [])
      (* Already an Option: the whole, one level flattened (decision 140). *)
      | Some (Types.Option _ as o) when flat || want0 = None ->
        opt_result := Some o;
        let r = rest ~used:true ~want:o () in
        fill Fun.id (fun a ->
            match r with
            | Some e -> e
            | None -> mk a.Ast.aloc o Tast.None_)
      | Some t ->
        let oty = Types.Option t in
        opt_result := Some oty;
        let r = rest ~used:true ~want:oty () in
        fill (fun b -> mk b.Tast.loc oty (Tast.Some_ b)) (fun a ->
            match r with
            | Some e -> e
            | None -> mk a.Ast.aloc oty Tast.None_)
  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
    | `Enum (_, members) ->
      List.filter_map
        (fun (m, _) -> if Hashtbl.mem seen m then None else Some (":" ^ m))
        members
    | `Bool ->
      List.filter (fun c -> not (Hashtbl.mem seen c)) [ "true"; "false" ]
    | `Lit _ -> []
  in
  (* No list of literals covers a number, a string or a dyn, so a literal
     match always needs its [_]. Refused here, before the chain below, which
     would otherwise run a lone last arm untested as the enum's does. *)
  (match subject with
   | `Lit t when not !saw_wild ->
     Loc.failk "check/non-exhaustive-match" loc
       "this match is not exhaustive — its arms are literals, and no list of \
        them covers every %s. Add a _ arm for the rest, as in %s"
       (match t with Types.Dyn -> "dyn value" | t -> tyname loc t)
       (lit_arms_fix t)
   | _ -> ());
  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
          | `Enum (n, _) -> declared_note ctx.env n
          | `Option _ | `Bool | `Lit _ -> [])
      "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 =
    if stmt then Types.Unit
    else if opt then (match !opt_result with Some t -> t | None -> Types.Never)
    else match !want with Some t -> t | None -> Types.Never
  in
  match subject with
  | `Option _ | `Data _ -> mk loc ty (Tast.Match (s, arms))
  | `Enum _ | `Bool | `Lit _ ->
    (* The scrutinee once, into a temporary, and then an [if] per arm in the
       order written. A [_] arm ends the chain, and so does the last arm of a
       match with none: it is exhaustive by the check above, so the last
       member's test is the only one left and cannot fail on a value the enum
       declares. *)
    let slot = fresh_slot ctx s.Tast.ty in
    let local = mk loc s.Tast.ty (Tast.Local slot) in
    let body (a : Tast.arm) =
      match a.Tast.abody with [ b ] -> b | bs -> mk loc ty (Tast.Do bs)
    in
    let rec chain = function
      | [] -> unit_at loc
      | ({ Tast.acase = None; _ } as a) :: _ -> body a
      | [ a ] -> body a
      | ({ Tast.acase = Some m; _ } as a) :: rest ->
        let test =
          match subject with
          | `Enum (_, members) ->
            let v =
              mk loc s.Tast.ty (Tast.Int (List.assoc m members, Types.I32))
            in
            mk loc Types.Bool (Tast.Prim (Tast.Eq, [ local; v ]))
          | `Bool when String.equal m "true" -> local
          | `Bool -> mk loc Types.Bool (Tast.Prim (Tast.Not, [ local ]))
          | `Lit Types.Dyn -> dyn_eq loc local (Hashtbl.find lits m)
          | _ ->
            mk loc Types.Bool (Tast.Prim (Tast.Eq, [ local; Hashtbl.find lits m ]))
        in
        mk loc ty (Tast.If (test, body a, chain rest))
    in
    mk loc ty (Tast.Let ([ (slot, s) ], [ chain arms ]))

(* [if let P = v] — (if-let [P v] then else) — is the two-arm match
   [(match v P then _ else)]. With no else it is a statement, Unit whatever
   [then] answers, as a one-armed [if] is.

   A pattern that cannot fail — [_], or a plain name, which is a name to bind
   and not a case — tests nothing, and is refused toward [let]. A bare name is
   a case when some data type, Option or bool has a case of that name, or it
   names an enum member through its enum. *)
and check_if_let ctx ~tail ~used ?want loc scrutinee (arm : Ast.arm) els =
  let fln = fln_source loc in
  let is_case n =
    List.mem n [ "None"; "Some"; "true"; "false" ]
    || String.contains n '.'
    || Hashtbl.fold
         (fun _ u acc -> acc || Tast.case_index u n <> None)
         ctx.env.datas false
  in
  let irrefutable name =
    match name with
    | Some n ->
      Loc.failk "check/if-let-irrefutable" arm.Ast.aloc
        "the pattern %s is a plain name, which always matches, so this if let \
         has nothing to test. Bind the value with %s"
        n
        (if fln then Printf.sprintf "let %s = ..." n
         else Printf.sprintf "(let [%s ...] ...)" n)
    | None ->
      Loc.failk "check/if-let-irrefutable" arm.Ast.aloc
        "the pattern _ always matches, so this if let has nothing to test. \
         Use the value directly, or match on it"
  in
  match arm.Ast.pat with
  | Ast.Pwild -> irrefutable None
  | Ast.Pctor (n, []) when not (is_case n) ->
    if_let_name ctx ~tail ~used ?want loc scrutinee n arm els
  | _ ->
  let wild body = { Ast.pat = Ast.Pwild; body; aloc = loc } in
  (* Kept with no else at the end of its chain, it is a [when] over a
     pattern: [Some] of the arm that ran and [None] when none did — or, where
     a dyn is wanted, the value or nil. *)
  let open_end =
    match els with None -> true | Some e -> kept_open ~used:true None e
  in
  let kept =
    match want with
    | Some (Types.Unit | Types.Never) -> false
    | Some _ -> true
    | None -> used
  in
  let at (x : Ast.expr) e = { Ast.e; loc = x.Ast.loc } in
  match els with
  | _ when kept && open_end ->
    let rest = match els with Some e -> e | None -> at scrutinee (Ast.Var "nil") in
    (match want with
     | Some Types.Dyn ->
       check_match ctx ~tail ~used:true ?want loc scrutinee [ arm; wild [ rest ] ]
     | _ ->
       (* The rest of the chain is checked once the arm's own type is
          known, as a one-armed [if]'s else is: see [opt] in [check_match]. *)
       let opt_rest =
         Option.map
           (fun e ~used ?want () ->
              branch ctx (fun () ->
                  ctx.tail <- tail; ctx.used <- used; check ctx ?want e))
           els
       in
       (* The arm at the payload first, as [check_when] asks it; refused
          there, at the Option itself (decision 140). *)
       let go ~flat () =
         check_match ctx ~tail ~used:true ~opt:true ~flat ?opt_rest ?want loc scrutinee
           [ arm; wild [] ]
       in
       expect ctx loc ~want
         (match want with
          | Some (Types.Option _) ->
            (match trial ctx (go ~flat:false) with
             | Ok r -> r
             | Error d ->
               (match trial ctx (go ~flat:true) with
                | Ok r -> r
                | Error _ -> raise (Loc.Error d)))
          | _ -> go ~flat:false ()))
  | Some e ->
    check_match ctx ~tail ~used ?want loc scrutinee [ arm; wild [ e ] ]
  | None ->
    expect ctx loc ~want
      (check_match ctx ~tail ~stmt:true loc scrutinee [ arm; wild [] ])

(* [if let g = x] with a plain name: over an Option it is [if let Some(g) =
   x], and over a dyn it binds [g] when [x] is not nil. [x] is checked once
   and held under a name no reader can produce; the rest is the form it
   stands for, checked as that form is. Anything else always holds a value,
   so there is nothing to test. *)
and if_let_name ctx ~tail ~used ?want loc scrutinee n (arm : Ast.arm) els =
  let sv = check ctx scrutinee in
  let fln = fln_source loc in
  let held f =
    scoped ctx (fun () ->
        incr held_n;
        let h = Printf.sprintf "~if%d" !held_n in
        let s = bind ctx h sv.Tast.ty ~assignable:false in
        let hv = { Ast.e = Ast.Var h; loc = scrutinee.Ast.loc } in
        let r = f hv in
        mk loc r.Tast.ty (Tast.Let ([ (s, sv) ], [ r ])))
  in
  match sv.Tast.ty with
  | Types.Option _ ->
    held (fun hv ->
        check_if_let ctx ~tail ~used ?want loc hv
          { arm with Ast.pat = Ast.Pctor ("Some", [ n ]) } els)
  | Types.Dyn ->
    held (fun hv ->
        let at e = { Ast.e; loc = arm.Ast.aloc } in
        let test = at (Ast.Call (at (Ast.Var "!="), [ hv; at (Ast.Var "nil") ])) in
        let bnd = { Ast.bname = n; bty = None; bval = hv; bloc = arm.Ast.aloc } in
        let body = { Ast.e = Ast.Let ([ bnd ], arm.Ast.body); loc = arm.Ast.aloc } in
        ctx.tail <- tail;
        ctx.used <- used;
        check ctx ?want { Ast.e = Ast.If (test, body, els); loc })
  | t ->
    Loc.failk "check/if-let-irrefutable" arm.Ast.aloc
      "%s is %s, which always holds a value, so this if let has nothing to \
       test. A plain name in an if let binds what an Option or a dyn holds \
       when it holds something. Bind this value with %s"
      (spell_arg "the value" scrutinee) (tyname loc t)
      (if fln then Printf.sprintf "let %s = ..." n
       else Printf.sprintf "(let [%s ...] ...)" n)

(* The locals a condition tests with [x?], through [and]: those it narrows
   in the block it guards (decision 133). Not through [or] or [not], where
   the test holding says nothing about [x]. *)
and narrows (c : Ast.expr) =
  match Ast.unpause c with
  | Some x -> narrows x
  | None ->
  match c.Ast.e with
  | Ast.Call ({ Ast.e = Ast.Var "?"; _ }, [ { Ast.e = Ast.Var x; _ } ]) -> [ x ]
  | Ast.If (p, q, Some { Ast.e = Ast.Var "false"; _ }) -> narrows p @ narrows q
  | Ast.IfLet (_, { Ast.pat = Ast.Pctor (g, []); body = [ q ]; _ },
               Some { Ast.e = Ast.Var "false"; _ }) when as_name g -> narrows q
  | _ -> []

and as_binds c = Ast.as_binds c

and as_name g = Ast.as_name g

(* A condition with [as] in it, as the bool it tests, and each name it binds
   with the hidden name the block reads it through. The chain runs left to
   right and stops at the first test that fails, so each value is found
   once. Each name an [as] binds is one slot, read by the rest of the chain
   and, through [Ast.Alias], by the block. *)
and as_cond ctx (c : Ast.expr) =
  let named = ref [] in
  let no loc = mk loc Types.Bool (Tast.Bool false) in
  let rec go (c : Ast.expr) =
    let loc = c.Ast.loc in
    match Ast.unpause c, c.Ast.e with
    (* A pause mark on a test of the chain stops before it and leaves the
       chain as it was. *)
    | Some x, Ast.Do [ pause; _ ] ->
      let pv = check ctx pause in
      let xv = go x in
      mk loc Types.Bool (Tast.Do [ pv; xv ])
    | _, _ ->
    match c.Ast.e with
    | Ast.If (p, q, Some { Ast.e = Ast.Var "false"; _ }) when as_binds q <> [] ->
      let pv = check_truthy ctx p in
      let qv = with_narrowed ctx (narrows p) (fun () -> go q) in
      mk loc Types.Bool (Tast.If (pv, qv, no loc))
    | Ast.IfLet (e, { Ast.pat = Ast.Pctor (g, []); body = [ q ]; _ },
                 Some { Ast.e = Ast.Var "false"; _ }) when as_name g ->
      let ev = check ctx e in
      let refuse t =
        Loc.failk "check/as-not-optional" e.Ast.loc
          "%s is %s, which always holds a value, so as has nothing to test. \
           as names what an Option or a dyn holds, when it holds something. \
           It is not a conversion: a number is converted with its type's \
           name, as in i32(x)"
          (source_text e) (tyname loc t)
      in
      (* [g] is a slot of its own under its own name, so locals, the stepper,
         the inspector and the watch view show it as the program reads it. A
         dyn is held there directly; an Option is held in a hidden slot and
         its payload copied into [g]'s once the test holds. *)
      let bound ty =
        scoped ctx (fun () ->
            let slot = bind ctx ~what:as_tag g ty ~assignable:false in
            ctx.as_slots <- slot :: ctx.as_slots;
            let b = Option.get (lookup ctx g) in
            incr held_n;
            named := (g, Printf.sprintf "~as%d" !held_n, b) :: !named;
            (slot, go q))
      in
      (match ev.Tast.ty with
       | Types.Option t ->
         let hs = fresh_slot ctx ev.Tast.ty in
         let hv = mk loc ev.Tast.ty (Tast.Local hs) in
         let slot, qv = bound t in
         mk loc Types.Bool
           (Tast.Let ([ (hs, ev) ],
                      [ mk loc Types.Bool
                          (Tast.If (opt_is_some loc hv,
                                    mk loc Types.Bool
                                      (Tast.Let ([ (slot, opt_payload loc t hv) ], [ qv ])),
                                    no loc)) ]))
       | Types.Dyn ->
         let slot, qv = bound Types.Dyn in
         let sv = mk loc Types.Dyn (Tast.Local slot) in
         mk loc Types.Bool
           (Tast.Let ([ (slot, ev) ], [ mk loc Types.Bool (Tast.If (dyn_not_nil loc sv, qv, no loc)) ]))
       | t -> refuse t)
    | _ -> check_truthy ctx c
  in
  let cv = go c in
  let named = List.rev !named in
  List.iter (fun (_, h, b) -> ctx.scope <- (h, b) :: ctx.scope) named;
  (cv, List.map (fun (g, h, _) -> (g, h)) named)

(* [f] with each of [names] that is a local (Option T) read as its payload:
   the same slot, so a field set through it lands in the Option itself. A
   dyn stays as it is; a name that is not a local is not narrowed. Assigning
   the name a T writes the payload and it stays present; assigning it an
   Option is refused ([narrowed_set]). *)
and with_narrowed : 'a. ctx -> string list -> (unit -> 'a) -> 'a = fun ctx names f ->
  if names = [] then f ()
  else
    let held = ref [] in
    let r =
      scoped ctx (fun () ->
          List.iter
            (fun n ->
               match lookup ctx n with
               | Some { bty = Types.Option _; _ } when List.mem n !unnarrowable ->
                 held := n :: !held
               | Some ({ bty = Types.Option t; _ } as b) when b.bwhat <> Some narrowed_tag ->
                 ctx.scope <- (n, { b with bty = t; bwhat = Some narrowed_tag; blit = None })
                              :: ctx.scope
               | _ -> ())
            names;
          (* A name something else can clear stays an Option; a refusal in
             the block about it says why, and how to copy what it holds. *)
          if !held = [] then f ()
          else
            let note (d : Loc.diag) =
              let has s sub =
                let ls = String.length s and lb = String.length sub in
                let rec go i = i + lb <= ls && (String.sub s i lb = sub || go (i + 1)) in
                go 0
              in
              let about = if has d.Loc.dmsg "Option" then !held else [] in
              match about with
              | [] -> d
              | n :: _ ->
                { d with
                  Loc.notes =
                    d.Loc.notes
                    @ [ Loc.note d.Loc.dloc
                          (Printf.sprintf
                             "%s? does not make %s its payload here: %s's address \
                              is taken, or a fn assigns it, in this function, so \
                              something else could clear it. Write if %s as g, \
                              which copies what it holds into g"
                             n n n n) ] }
            in
            (* Raised, or recorded while recovering: noted either way. *)
            let before = ctx.env.recovered in
            let r =
              try f () with
              | Loc.Error d -> raise (Loc.Error (note d))
              | Loc.Errors ds -> raise (Loc.Errors (List.map note ds))
            in
            let rec fresh l =
              if l == before then l
              else match l with d :: t -> note d :: fresh t | [] -> []
            in
            ctx.env.recovered <- fresh ctx.env.recovered;
            r)
    in
    r

(* [x?]: whether x holds a value — an Option that is Some, a dyn that is not
   nil. *)
and check_present ctx ~want loc (args : Ast.expr list) =
  match args with
  | [ x ] ->
    let xv = check ctx x in
    let s = fresh_slot ctx xv.Tast.ty in
    let sv = mk loc xv.Tast.ty (Tast.Local s) in
    let held e = mk loc Types.Bool (Tast.Let ([ (s, xv) ], [ e ])) in
    (match xv.Tast.ty with
     | Types.Option _ -> expect ctx loc ~want (held (opt_is_some loc sv))
     | Types.Dyn -> expect ctx loc ~want (held (dyn_not_nil loc sv))
     | t ->
       let hint =
         match x.Ast.e with
         | Ast.Var n ->
           Printf.sprintf ". A name cannot end in ? either: a yes-or-no name \
                           starts with is- or has-, as in is-%s" n
         | _ -> ""
       in
       fail loc "%s is %s, which always holds a value, so %s? has nothing to \
                 test%s" (source_text x) (tyname loc t) (source_text x) hint)
  | _ -> fail loc "? tests one value: x?"

(* The tag test and the payload of an Option held in a local, and the nil
   test of a dyn: the shapes [box_option] and [unbox_option] build. *)
and opt_is_some loc (sv : Tast.expr) =
  mk loc Types.Bool
    (Tast.Prim (Tast.Ne,
                [ mk loc (Types.Int Types.I8) (Tast.Field (sv, 0));
                  mk loc (Types.Int Types.I8) (Tast.Int (0L, Types.I8)) ]))

and opt_payload loc t (sv : Tast.expr) = mk loc t (Tast.Field (sv, 1))

and dyn_not_nil loc (sv : Tast.expr) =
  mk loc Types.Bool
    (Tast.Prim (Tast.Eq,
                [ rt loc (Types.Int Types.I32) "flan_dyn_is_nil" [ sv ];
                  mk loc (Types.Int Types.I32) (Tast.Int (0L, Types.I32)) ]))

(* [x ?? d]: what [x] holds, or [d] when it holds nothing — [None], or nil
   over a dyn. [d] is evaluated only then. A chain, [(?? a b c)], is read
   from the right, [a ?? (b ?? c)], so a default may itself be an Option and
   the whole is then an Option, as in Swift. *)
and check_coalesce ctx ~want loc (args : Ast.expr list) =
  match args with
  | [] | [ _ ] -> fail loc "?? takes a value and a default: x ?? d"
  | x :: rest ->
    let d =
      match rest with
      | [ d ] -> d
      | d :: _ -> { Ast.e = Ast.Call ({ Ast.e = Ast.Var "??"; loc }, rest); loc = d.Ast.loc }
      | [] -> assert false
    in
    let xv = check ctx x in
    let s = fresh_slot ctx xv.Tast.ty in
    let sv = mk loc xv.Tast.ty (Tast.Local s) in
    let held ty e = mk loc ty (Tast.Let ([ (s, xv) ], [ mk loc ty e ])) in
    (match xv.Tast.ty with
     | Types.Option t ->
       (match trial ctx (fun () -> expect ctx d.Ast.loc ~want:(Some t) (check ctx ~want:t d)) with
        | Ok dv -> expect ctx loc ~want (held t (Tast.If (opt_is_some loc sv, opt_payload loc t sv, dv)))
        | Error first ->
          let o = Types.Option t in
          (match trial ctx (fun () -> expect ctx d.Ast.loc ~want:(Some o) (check ctx ~want:o d)) with
           | Ok dv -> expect ctx loc ~want (held o (Tast.If (opt_is_some loc sv, sv, dv)))
           | Error _ -> raise (Loc.Error first)))
     | Types.Dyn ->
       let dv = check ctx ~want:Types.Dyn d in
       expect ctx loc ~want (held Types.Dyn (Tast.If (dyn_not_nil loc sv, sv, dv)))
     | t ->
       fail x.Ast.loc
         "the left side of ?? is %s, which always holds a value, so there is \
          nothing to fall back from. ?? takes an Option or a dyn"
         (tyname loc t))

(* The source text of [e], for a message the program prints when it runs. *)
and source_text (e : Ast.expr) =
  match Loc.snippet ~lim:48 e.Ast.loc with
  | Some t -> t
  | None -> spell_arg "the value" e

(* [x!]: what [x] holds, and a trap at this site naming [x] when it holds
   nothing. The trap never returns; the zero after it only gives the arm its
   type, so no backend needs a call typed Never. *)
and check_unwrap ctx ~want loc (args : Ast.expr list) =
  match args with
  | [ x ] ->
    let xv = check ctx x in
    let s = fresh_slot ctx xv.Tast.ty in
    let sv = mk loc xv.Tast.ty (Tast.Local s) in
    let text = source_text x in
    let fail_with none zero ty =
      mk loc ty
        (Tast.Do
           [ rt loc Types.Unit "flan_unwrap_fail"
               [ here loc;
                 mk loc Types.String
                   (Tast.Str (Printf.sprintf "%s is %s, so %s! has no value to give"
                                text none text)) ];
             zero ])
    in
    let held ty e = mk loc ty (Tast.Let ([ (s, xv) ], [ mk loc ty e ])) in
    (match xv.Tast.ty with
     | Types.Option t ->
       expect ctx loc ~want
         (held t (Tast.If (opt_is_some loc sv, opt_payload loc t sv,
                           fail_with "None" (mk loc t (Tast.Zero t)) t)))
     | Types.Dyn ->
       expect ctx loc ~want
         (held Types.Dyn
            (Tast.If (dyn_not_nil loc sv, sv,
                      fail_with "nil" (rt loc Types.Dyn "flan_dyn_nil" []) Types.Dyn)))
     | t ->
       fail x.Ast.loc
         "%s is %s, which always holds a value, so ! has nothing to unwrap. \
          Leave the ! out" text (tyname loc t))
  | _ -> fail loc "! unwraps one value: x!"

(* [a?.b]: [(?. [n a] body)] — [body] over what [a] holds, bound to [n], or
   None when it holds nothing (nil over a dyn). [body] already an Option is
   not wrapped again, so [a?.b?.c] is one Option; [body] with no value makes
   the whole a statement. *)
and check_chain ctx ~want loc n (v : Ast.expr) (body : Ast.expr) =
  let hv = check ctx v in
  let s = fresh_slot ctx hv.Tast.ty in
  let sv = mk loc hv.Tast.ty (Tast.Local s) in
  let arm t ~dyn =
    scoped ctx (fun () ->
        let p = bind ctx n t ~assignable:false in
        let bv = if dyn then check ctx ~want:Types.Dyn body else check ctx body in
        (p, bv))
  in
  let held ty e = mk loc ty (Tast.Let ([ (s, hv) ], [ mk loc ty e ])) in
  match hv.Tast.ty with
  | Types.Option t ->
    let p, bv = arm t ~dyn:false in
    let inner ty e = mk loc ty (Tast.Let ([ (p, opt_payload loc t sv) ], [ e ])) in
    (match bv.Tast.ty with
     | Types.Unit | Types.Never ->
       expect ctx loc ~want
         (held Types.Unit
            (Tast.If (opt_is_some loc sv, inner Types.Unit bv, mk loc Types.Unit Tast.Unit)))
     | Types.Option _ as o ->
       expect ctx loc ~want
         (held o (Tast.If (opt_is_some loc sv, inner o bv, mk loc o Tast.None_)))
     | b ->
       let o = Types.Option b in
       expect ctx loc ~want
         (held o (Tast.If (opt_is_some loc sv, inner o (mk loc o (Tast.Some_ bv)),
                           mk loc o Tast.None_))))
  | Types.Dyn ->
    let p, bv = arm Types.Dyn ~dyn:true in
    let ty = match bv.Tast.ty with Types.Unit | Types.Never -> Types.Unit | _ -> Types.Dyn in
    let none = if ty = Types.Unit then mk loc Types.Unit Tast.Unit
      else rt loc Types.Dyn "flan_dyn_nil" [] in
    expect ctx loc ~want
      (held ty (Tast.If (dyn_not_nil loc sv, mk loc ty (Tast.Let ([ (p, sv) ], [ bv ])), none)))
  | t ->
    fail v.Ast.loc
      "%s is %s, which always holds a value, so ?. has nothing to test. \
       Write . instead" (source_text v) (tyname loc t)

(* ── 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. *)
(* Every name a value could be standing under here: what is in scope, the
   globals, the functions — generic ones included, since a call to one is
   written exactly like a call to any other. No type names: a symbol written
   where a value goes was not a mistyped struct, and offering one would send
   the reader to the wrong file. *)
and value_candidates ctx =
  List.map fst ctx.scope
  @ Hashtbl.fold (fun k _ acc -> k :: acc) ctx.env.globals []
  @ Hashtbl.fold (fun k _ acc -> k :: acc) ctx.env.fns []
  @ Hashtbl.fold (fun k _ acc -> k :: acc) ctx.env.gsigs []

(* The name nothing answers to, refused with whatever this position can still
   tell the reader.

   Two readings get in ahead of the bare refusal. The first is the dot: [p.x]
   is how C, Go and Odin spell field access and it is the habit everyone
   arrives with, so a symbol with a dot in it and a lowercase head is almost
   never a name — it is an accessor written the way the last language wrote
   it. The head is looked up, so the sentence can say what [p] actually is
   rather than guess, and the struct's declaration comes along as a note when
   there is one. Capitalised heads are left alone: [Shape.Circle] is a real
   spelling in this language and a typo in one is a mistyped case, not a
   dot-infix habit.

   The second is the near miss, over values only — see [value_candidates]. *)
and unknown_name : 'a. ?setting:bool -> ctx -> Loc.t -> string -> 'a =
  fun ?(setting = false) ctx loc name ->
  (* A retired randomness name gets its own sentence and gets it first. It has
     no dot in it, and the near miss below would answer "did you mean rand?"
     for [rand-f32] — true and not much use, where the line in [no_such_rand]
     names the function and spells the call. Everything else falls through to
     the two readings this was built for. *)
  (match no_such_rand name with
   | Some msg -> Loc.failk "check/unknown-name" loc "%s" msg
   | None -> ());
  (* In the indented syntax a binary operator needs spaces, so [x-1], [i+1]
     and [x/2] are one name each. When the parts either side of an operator
     character are a value in scope and a number or another value, that is
     almost certainly the arithmetic, and the sentence says how to spell it. *)
  (if Source.indented_at loc then begin
     let known s =
       s <> ""
       && (String.for_all (fun c -> (c >= '0' && c <= '9') || c = '.') s
           || lookup ctx s <> None
           || Hashtbl.mem ctx.env.globals s)
     in
     let n = String.length name in
     let rec scan i =
       if i < n - 1 then
         match name.[i] with
         | ('-' | '+' | '*' | '/') as c
           when i > 0 && known (String.sub name 0 i)
                && known (String.sub name (i + 1) (n - i - 1)) ->
           Loc.failk "check/unknown-name" loc
             "unknown name %s — an operator needs a space on each side, so \
              this is one name and not arithmetic. Did you mean %s %c %s?"
             name (String.sub name 0 i) c (String.sub name (i + 1) (n - i - 1))
         | _ -> scan (i + 1)
     in
     scan 0
   end);
  let dot = String.index_opt name '.' in
  let head, field =
    match dot with
    | Some i when i > 0 && i + 1 < String.length name ->
      String.sub name 0 i, String.sub name (i + 1) (String.length name - i - 1)
    | _ -> "", ""
  in
  let lower = head <> "" && head.[0] = Char.lowercase_ascii head.[0]
              && head.[0] <> Char.uppercase_ascii head.[0] in
  if lower then begin
    let ty =
      match lookup ctx head with
      | Some b -> Some b.bty
      | None -> Option.map fst (Hashtbl.find_opt ctx.env.globals head)
    in
    let sname =
      match ty with
      | Some (Types.Named n) when fields_named ctx.env n <> None -> Some n
      | Some (Types.Ptr (_, (Types.Named n))) when fields_named ctx.env n <> None -> Some n
      | _ -> None
    in
    match sname, ty with
    | Some sn, _ ->
      let s = Option.get (fields_named ctx.env sn) in
      let notes = declared_note ctx.env sn in
      (* In a [set] the accessor is the *place*, so the spelling to give is
         [(set (.x p) 1)] and not [(.x p)] on its own. Saying "read" at an
         assignment would be a sentence that does not apply to the form it is
         printed under. *)
      let how =
        if setting then Printf.sprintf "a field is assigned through an \
                                        accessor, so write (set (.%s %s) ...)"
            field head
        else Printf.sprintf "a field is read with an accessor, so write (.%s %s)"
            field head
      in
      if Tast.field_index s field <> None then
        Loc.failk "check/dot-access" loc ~notes "unknown name %s — %s" name how
      else
        Loc.failk "check/dot-access" loc ~notes
          "unknown name %s — %s, and %s has no field %s" name how sn field
    | None, Some Types.Dyn ->
      let how =
        if setting then Printf.sprintf "(set (.%s %s) ...)" field head
        else Printf.sprintf "(.%s %s)" field head
      in
      Loc.failk "check/dot-access" loc
        "unknown name %s — a dot is part of the name here, not field access. \
         %s is dyn, and its :%s is reached with %s"
        name head field how
    | None, Some t ->
      Loc.failk "check/dot-access" loc
        "unknown name %s — a dot is part of the name here, not field access. \
         A field is reached through an accessor, (.%s %s), and %s is %s, \
         which has no fields"
        name field head head (tyname loc t)
    | None, None ->
      Loc.failk "check/unknown-name" loc
        "unknown name %s — nothing named %s is in scope either. A field is \
         reached through an accessor, (.%s %s), not with a dot"
        name head field head
  end
  else
    (* [x++]: a name may end in +, so the increment of another language
       reads as one unknown name. *)
    let n = String.length name in
    let stem = if n > 2 then String.sub name 0 (n - 2) else "" in
    let suffix = if n > 2 then String.sub name (n - 2) 2 else "" in
    if (suffix = "++" || suffix = "--") && List.mem stem (value_candidates ctx) then
      Loc.failk "check/unknown-name" loc
        "unknown name %s — to %s %s, write %s"
        name (if suffix = "++" then "add one to" else "take one from") stem
        (if Source.indented_at loc then
           Printf.sprintf "%s(%s) or %s %s= 1" suffix stem stem (String.make 1 suffix.[0])
         else Printf.sprintf "(%s %s)" suffix stem)
    else
    match nearest (value_candidates ctx) name with
    | Some m ->
      Loc.failk "check/unknown-name" loc "unknown name %s — did you mean %s?" name m
    | None -> Loc.failk "check/unknown-name" loc "unknown name %s" name

(* 1st, 2nd, 3rd, and every other one. *)
and ordinal n =
  let suffix =
    if n mod 100 >= 11 && n mod 100 <= 13 then "th"
    else match n mod 10 with 1 -> "st" | 2 -> "nd" | 3 -> "rd" | _ -> "th"
  in
  string_of_int n ^ suffix

(* Check one argument of a call to [name], and if the refusal is the plain
   type mismatch raised against *this* argument's own span, say the two things
   the caret cannot: which argument of which function this is, and where the
   parameter that wanted the other type is declared.

   The span test is what keeps the claim true. A mismatch deeper inside the
   argument — an element of a vec literal, an argument of a nested call — is
   raised against its own location and is re-raised untouched, because calling
   that "the 2nd argument of add" would be a sentence that reads well and
   points at the wrong form. The rekind is what stops a nested call from being
   named twice: once enriched, it is no longer the kind this looks for. *)
and check_arg ctx name i (want : Types.t) (a : Ast.expr) =
  ctx.env.guard_next <- true;
  match check ctx ~want a with
  | e -> e
  | exception Loc.Error d
    when String.equal d.Loc.kind "check/type-mismatch"
         && d.Loc.dloc == a.Ast.loc ->
    let which = ordinal (i + 1) in
    let notes =
      match Hashtbl.find_opt ctx.env.fparams name with
      | Some ps when List.length ps > i ->
        let p = List.nth ps i in
        [ Loc.note p.Ast.floc
            (Printf.sprintf "%s's %s parameter %s is declared %s"
               (written_name name) which p.Ast.fname (tyname p.Ast.floc want)) ]
      | _ -> []
    in
    refuse_or_poison ctx.env a.Ast.loc
      (Loc.diag ~kind:"check/argument-type" ~notes a.Ast.loc
         (Printf.sprintf "%s — this is the %s argument of %s" d.Loc.dmsg which
            (written_name name)))
  | exception Loc.Error d -> refuse_or_poison ctx.env a.Ast.loc d

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. The target comes checked, because every caller
   looks first for a dyn, whose [.name] is a map entry and not a field. *)
and struct_of ctx (target : Ast.expr) (t : Tast.expr) : Tast.expr * string =
  let has n = fields_named ctx.env n <> None in
  (match t.Tast.ty with
   | Types.Named "String" | Types.Ptr (_, Types.Named "String") ->
     refuse_string_inside target.Ast.loc
   | _ -> ());
  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 its fields belong to a case — reach them with \
       (match ...), whose arms bind the fields of the case they matched"
      n
  | other ->
    (* The pattern bound this, and it looks like a destructuring that did not
       take: [(match s (Circle c) (.r c))] over a one-field case binds [c] to
       the payload itself. "f64 is not a struct" is true and is a type fact
       where the reader needs to be told the value is already in hand. *)
    (match target.Ast.e with
     | Ast.Var n ->
       (match lookup ctx n with
        | Some { bwhat = Some w; _ } when w = narrowed_tag ->
          fail target.Ast.loc
            "%s is tested with %s? above, so here it is what the Option \
             holds, %s, and %s has no fields"
            n n (tyname target.Ast.loc other) (tyname target.Ast.loc other)
        | Some { bwhat = Some w; _ } when w <> as_tag ->
          fail target.Ast.loc
            "%s is %s — the pattern bound it to %s, so the value is already \
             in hand and there is no field left to read"
            n (tyname target.Ast.loc other) w
        | _ -> ())
     | _ -> ());
    fail target.Ast.loc "%s is not a struct, so it has no fields"
      (tyname target.Ast.loc other)

(* (at s i) reads a string's byte, and reading is the whole of what a string
   does here: it is a view of bytes the program does not own — a literal's
   are in constant storage, where a store is dropped on one backend and
   faults on the other — so there is no address of one to hand out either.
   [addr] asks the same question and gets the same answer, so the refusal
   names taking the address rather than only assigning.

   It is a function and not a case inside [check_place] because [check_place]
   is no longer the only way to a [Pindex]: the single-index [set] arm checks
   its target itself and calls [indexed] directly, and [indexed] accepts a
   string. Both call this, so neither can drift away from the other. *)
and refuse_string_place loc (ty : Types.t) =
  if Types.equal ty Types.String then
    fail loc
      "a string is read-only, so (at s i) is a value and not a place. Copy \
       the bytes into a buffer you own and write that"

(* Whether a checked place is read-only storage: reached through a
   [[const T]] or a (Ptr const T), or a byte of a string. Its address is a
   (Ptr const T). *)
and place_const (p : Tast.place) =
  match p with
  | Tast.Plocal _ | Tast.Pglobal _ -> false
  | Tast.Pfield (t, _) -> const_reached t <> None
  | Tast.Pderef t ->
    (match t.Tast.ty with Types.Ptr (Types.Const, _) -> true | _ -> false)
  | Tast.Pindex (t, idx) ->
    let rec through_string ty n =
      n > 0
      && (match ty with
          | Types.String -> true
          | Types.Array (_, e) | Types.Slice (_, e) -> through_string e (n - 1)
          | _ -> false)
    in
    const_steps (const_reached t) t.Tast.ty (List.length idx) <> None
    || through_string t.Tast.ty (List.length idx)

(* Growing, shrinking or freeing a Vec or a Map that is read-only storage.
   The backends hand the runtime the container's address, so this is the
   store [check_place] refuses, made through the header instead of through a
   [set]. Writing into the Vec's own buffer is not refused: the const is
   shallow. *)
and refuse_const_change _ctx loc (target : Tast.expr) =
  match const_reached target with
  | None -> ()
  | Some view ->
    let t = tyname loc target.Tast.ty in
    let holder =
      match view with Types.Slice (_, e) | Types.Ptr (_, e) -> e | t -> t
    in
    Loc.failk "check/store-through-const" loc
      "this changes a %s reached through a %s, which can only be read. Where \
       it has to change, take the %s it lives in as a [%s] or a (Ptr %s) \
       instead"
      t (tyname loc view) (tyname loc holder)
      (tyname loc holder) (tyname loc holder)

and check_place ?(store = true) ctx loc (p : Ast.place) : Tast.place * Types.t =
  match p with
  | Ast.Pvar name ->
    (* Scope first, and the capture refusal only where scope did not settle
       it. A body's *own* [let] may shadow a name the enclosing function also
       has, and a store into that one is an ordinary store — asking about the
       capture before looking would refuse it with a message about a copy that
       is not the thing being written to. *)
    (match lookup ctx name with
     | Some b ->
       if not b.assignable then begin
         (* Not assignable, so it is either a parameter or a captured copy.
            Which one decides the message, and the copy's reason is its
            own. *)
         (match List.assoc_opt name ctx.caught with
          | Some (_, slot) when slot = b.slot -> captured_set ctx loc name
          | _ -> ());
         if b.bwhat = Some as_tag then
           fail loc
             "%s names what an as test found, and it cannot be given a new \
              value. To change it, copy it into a local first: let %s2 = %s"
             name name name;
         fail loc
           "%s is a parameter, and a parameter is not assignable — bind a \
            local with let" name
       end;
       if b.bwhat = Some narrowed_tag then
         (Tast.Pfield (mk loc (Types.Option b.bty) (Tast.Local b.slot), 1), b.bty)
       else
       Tast.Plocal b.slot, b.bty
     | None ->
       (* Not in scope here at all: a name of the enclosing function, which a
          lifted body may read as a copy and may not write to. *)
       captured_set ctx loc name;
       match Hashtbl.find_opt ctx.env.globals name with
       | Some (_, true) ->
         (* Four words, before: the name and the fact, and nothing about what
            to do or where the decision was made. [no_container_defconst] is
            the house's own shape for this and the note is [declared_note]'s.
            A defconst is what the linker writes into the image, so there is
            no assignment to allow — the fix is the other declaration. *)
         let notes =
           match Hashtbl.find_opt ctx.env.global_locs name with
           | Some at -> [ Loc.note at (name ^ " is declared a constant here") ]
           | None -> []
         in
         Loc.failk "check/set-constant" loc ~notes
           "%s is a constant, and a constant is not assignable. Declare it \
            with defonce if it has to change" name
       | Some (ty, false) -> Tast.Pglobal name, ty
       | None -> unknown_name ~setting:true ctx loc name)
  | Ast.Pfield (target, name) ->
    let t = check_target ctx target in
    if t.Tast.ty = Types.Dyn then begin
      let x = match target.Ast.e with Ast.Var x -> x | _ -> "x" in
      if Source.indented_at loc then
        fail loc
          "%s.%s is an entry of a dyn map, and has no address. Read it into \
           a local: let v = %s.%s" x name x name
      else
        fail loc
          "(.%s %s) is an entry of a dyn map, and has no address. Read it \
           into a local: (let [v (.%s %s)] ...)" name x name x
    end;
    field_place ~store ctx loc target t name
  | Ast.Pindex (target, idx) ->
    let target = check_target 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 ~place:loc ~store 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 (Types.Const, _) as view when store ->
       refuse_const_place ctx.env loc view
     | Types.Ptr (_, t) -> Tast.Pderef target, t
     | other ->
       fail loc "deref takes a (Ptr T), found %s" (tyname loc other))
  (* Only [set] writes a class slot, and it has its own arm above. A slot
     lives in a map the collector may move entries of, so it has no address
     to hand out. *)
  | Ast.Pslot _ ->
    fail loc
      "a class slot (get inst :slot) is written with set and has no address. \
       Read it into a local with let"

(* The dyn keyword [:name], for a dyn's [.name]. *)
and dyn_kw ctx loc name = check ctx ~want:Types.Dyn { Ast.e = Ast.Kw name; loc }

(* A struct field as a place, over a target already checked. *)
and field_place ~store ctx loc target t name =
  let target, sname = struct_of ctx target t 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" (tyname loc (Types.Named sname)) name
  | Some i ->
    if store then Option.iter (refuse_const_place ctx.env loc) (const_reached target);
    Tast.Pfield (target, i), (List.nth s.Tast.fields i).Tast.fty

(* 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 …)"
      (Types.ikind_name k)
  | other ->
    fail e.Ast.loc "an index is an integer, found %s" (tyname e.Ast.loc other)

(* [(at a i)] and [(at grid row col)]: one index per dimension.

   [~place] carries the location of the form being assigned into, and is
   given by the two callers that are building somewhere to store. It is asked
   at *every* dimension rather than once about the target: [(at g 0 0)] over a
   [[2 string]] reaches a string at the last step and nowhere before it, so a
   question asked only of [g] would miss it. *)
and indexed ?place ?(store = true) ctx (target : Tast.expr) (idx : Ast.expr list) =
  (match place with
   | Some l when store ->
     Option.iter (refuse_const_place ctx.env l)
       (const_steps (const_reached target) target.Tast.ty (List.length idx))
   | _ -> ());
  let rec go ty = function
    | [] -> [], ty
    | i :: rest ->
      let elem =
        match ty with
        | Types.Array (_, t) | Types.Slice (_, t) -> t
        (* A string indexes to its bytes, and only to read them. *)
        | Types.String ->
          if store then Option.iter (fun l -> refuse_string_place l ty) place;
          Types.Int Types.U8
        | Types.Named "String" ->
          refuse_string_index i.Ast.loc ~store:(store && place <> None)
        | other ->
          fail i.Ast.loc "%s cannot be indexed" (tyname i.Ast.loc 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
  (* The resource notes [Shim] writes into a tracked binding's wrapper; see
     [res_key]. The reader never produces a name beginning with '%'. *)
  | Ast.Var (("%res-acquire" | "%res-release") as which) ->
    (match args with
     | [ v; { Ast.e = Ast.Str owner; _ } ] ->
       let v = check ctx v in
       let sym =
         if which = "%res-acquire" then "flan_dev_reg_note_res_acquire"
         else "flan_dev_reg_note_res_release"
       in
       expect ctx loc ~want
         (rt loc Types.Unit sym
            [ res_key loc ctx.env v;
              mk loc Types.String (Tast.Str (Types.to_string v.Tast.ty));
              mk loc Types.String (Tast.Str owner) ])
     | _ -> fail loc "internal: %s takes a local and a name — a compiler bug" which)
  | Ast.Var "%res-done" ->
    (match args with
     | [ { Ast.e = Ast.Str owner; _ } ] ->
       expect ctx loc ~want
         (rt loc Types.Unit "flan_dev_reg_note_res_done"
            [ mk loc Types.String (Tast.Str owner) ])
     | _ -> fail loc "internal: %%res-done takes a name — a compiler bug")
  (* [i32?] where a value goes: the type, not a value. *)
  | Ast.Var "Option" when fln_source loc
                          && (match args with
                              | [ { Ast.e = Ast.Var n; _ } ] -> lookup ctx n <> None
                              | _ -> false) ->
    let n = match args with [ { Ast.e = Ast.Var n; _ } ] -> n | _ -> "" in
    fail loc
      "%s? reads as the type Option(%s), because a capitalised name before ? \
       is taken for a type. To test the local %s, give it a lowercase name, \
       as in %s?" n n n (String.uncapitalize_ascii n)
  | Ast.Var "Option" when fln_source loc ->
    fail loc
      "%s is an Option type, and a value is wanted here. On a value that may \
       hold nothing, x?.field reads through it, x! unwraps it and x ?? d gives \
       a default"
      (match Loc.snippet loc with Some t -> t | None -> "this")
  | Ast.Var name -> named_call ctx ~want loc name args
  (* ((Ptr Color) p): a pointer cast, spelled the way (i32 x) is — the type
     is the head. It changes what the pointer is said to point at and nothing
     else, and checks nothing: the caller is promising the bytes are that
     type, as with [slice-from]. Both backends already lower a Ptr-to-Ptr
     [Cast] to no instruction. Adding const is allowed; dropping it is not,
     or a cast would undo the const [addr] put there. The rule is about the
     outer pointer only: the cast is unchecked, so ((Ptr (Ptr u8)) q) over a
     (Ptr const (Ptr const u8)) is refused for the outer const but a
     (Ptr (Ptr const u8)) casts to (Ptr (Ptr u8)) — what lies deeper is the
     writer's promise, like everything else the cast asserts. There is no cast
     between a pointer and an integer, and no pointer arithmetic. *)
  | Ast.Call ({ Ast.e = Ast.Var "Ptr"; _ }, _)
    when (match type_of_expr head with Some _ -> true | None -> false) ->
    let target = resolve ctx.env (Option.get (type_of_expr head)) in
    let spelled = tyname loc target in
    (match args with
     | [ a ] ->
       let a_loc = a.Ast.loc in
       let spelled_a = spell_arg "p" a in
       let a = check ctx a in
       (match a.Tast.ty, target with
        | Types.Ptr (Types.Const, _), Types.Ptr (Types.Mut, u) ->
          fail loc
            "%s is a %s, which cannot be written through, and %s would allow \
             writes. Write (%s %s)"
            spelled_a (tyname loc a.Tast.ty) spelled
            (tyname loc (Types.Ptr (Types.Const, u))) spelled_a
        | Types.Ptr _, _ ->
          expect ctx loc ~want
            (mk loc target (Tast.Prim (Tast.Cast target, [ a ])))
        | (Types.Slice _ | Types.Array _ | Types.String), _ ->
          fail a_loc
            "%s converts a pointer, found %s. The address of the first \
             element is (addr (at %s 0)); write (%s (addr (at %s 0)))"
            spelled (tyname loc a.Tast.ty) spelled_a spelled spelled_a
        | Types.Int _, _ ->
          fail a_loc
            "%s converts a pointer, found %s. There is no conversion between \
             an integer and a pointer"
            spelled (tyname loc a.Tast.ty)
        | Types.Dyn, _ ->
          fail a_loc
            "%s converts a pointer, found dyn. A dyn value never holds a \
             pointer; give %s a pointer type"
            spelled spelled_a
        | other, _ ->
          fail a_loc
            "%s converts a pointer, found %s. The address of a place is \
             (addr %s); write (%s (addr %s))"
            spelled (tyname loc other) spelled_a spelled spelled_a)
     | _ ->
       fail loc "%s takes one pointer, given %d" spelled (List.length 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 =
  (* Either function type: calling one is calling the other, and the
     difference — whether an environment rides along — is the backend's to
     lower. Nothing here has to know which. *)
  match fn_sig callee.Tast.ty with
  | Some (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 ctx loc ~want (mk loc ret (Tast.CallPtr (callee, args)))
  | None ->
    fail loc "this is a %s and not a function, so it cannot be called"
      (tyname loc callee.Tast.ty)

(* A builtin's arity. The count is the builtin's and can only be the
   builtin's: a defn of the same name written in the program now takes the
   call over before any builtin arm is reached ([shadows_builtin] at the top
   of [named_call]), so a call measured here is a call to the builtin and
   there is no second signature for the reader to have meant. The note that
   used to say otherwise — "this is the builtin get, which a defn of the same
   name does not replace" — described a resolution order this compiler no
   longer has. *)
and arity _ctx 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 take two operands or more: [+ - * /], [min]/[max], the
   three bitwise combining operators, and the six comparisons. The first ten
   fold left; the ordered comparisons chain and [!=] asks about every pair,
   which [cmp_over] and the two pair-pickers under it explain. [%] 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 is refused for every operator but [-], whose one
   operand form is negation and is [named_call]'s. For [/] it would be the
   reciprocal, and integer division makes that a trap: [(/ 3)] would be 0.

   A one-operand comparison would have to be [true] — there is no pair to
   disagree, and nothing for a lone value to be distinct from — and a test
   that is true whatever it is handed is a typo with a value, which is the
   worst kind. So it is refused here with the rest. *)
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 reciprocal; \
       write (/ 1.0 x)"
  | [ _ ] when String.equal name "!=" ->
    fail loc
      "!= takes two arguments or more, given 1 — a test for distinctness \
       needs something to be distinct from, as in (!= x y)"
  | [ _ ] when is_comparison name ->
    fail loc
      "%s takes two arguments or more, given 1 — a comparison needs a second \
       value to compare against, as in (%s x y)" name name
  | _ ->
    fail loc "%s takes two arguments or more, given %d" name (List.length args)

and is_comparison = function
  | "=" | "!=" | "<" | "<=" | ">" | ">=" -> true
  | _ -> false

(* 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. *)
(* The operand, not the form. "[+] takes numbers, found string" with the caret
   over the whole [(+ "a" "b")] is the exact "whole form vs operand" shape the
   [check_truthy] work already fixed once: the reader has to find which of the
   operands is the one being talked about, and the compiler knew.

   And a text operand gets the extra clause, because [+] on two strings is a
   reach for concatenation and the answer is a function rather than an
   operator here. Named without a call shape on purpose: [concat] and [join]
   take a slice of byte slices and the spelling that builds one from string
   literals is not a clause in a sentence. *)
and not_numeric name what (a : Tast.expr) =
  let text =
    match a.Tast.ty with
    | Types.String -> true
    | Types.Slice (_, (Types.Int Types.U8)) -> true
    | _ -> false
  in
  let where = a.Tast.loc in
  if a.Tast.ty = Types.Bool && String.equal what "integers" then
    bool_bits where name
  else if a.Tast.ty = Types.Char then char_arith where name
  else if text then
    fail where
      "%s takes %s, and this is %s — there is no %s on text. The prelude \
       concatenates with concat and join"
      name what (tyname where a.Tast.ty) name
  else
    fail where "%s takes %s, found %s" name what (tyname where a.Tast.ty)

(* What a char refuses: every operator but [+] and [-] with an integer and
   [-] with a char ([char_step], decision 131). The refusal names the two
   conversions. *)
and char_arith loc name =
  let fln = fln_source loc in
  Loc.failk "check/char-arithmetic" loc
    "%s. Take its code point with %s, and make a char of one with %s"
    (match name with
     | "+" -> "+ adds an integer to a char, and not a char to a char"
     | "-" -> "- takes an integer or a char from a char, and not a char from \
               an integer"
     | _ -> name ^ " does no arithmetic on a char")
    (if fln then "i32(c)" else "(i32 c)")
    (if fln then "char(n)" else "(char n)")

(* One step of char arithmetic (decision 131, Kotlin's rules): a char plus or
   minus an integer is a char, checked to be a scalar value — at compile time
   when both sides are constants, at run time otherwise — and a char minus a
   char is the distance between them, an integer at the width the site wants
   (i32 when it wants none), as any integer expression is. A step with no char
   in it is the ordinary one. Anything else with a char in it is refused. *)
and char_step ~want loc name (a : Tast.expr) (b : Tast.expr) : Tast.expr =
  let i64 e = widen loc dyn_i64 e in
  let const (e : Tast.expr) =
    match e.Tast.e with Tast.Int (n, _) -> Some n | _ -> None
  in
  let op = if String.equal name "+" then Tast.Add else Tast.Sub in
  let scalar n =
    Int64.compare n 0L >= 0 && Int64.compare n 0x10ffffL <= 0
    && not (Int64.compare n 0xd800L >= 0 && Int64.compare n 0xdfffL <= 0)
  in
  let not_scalar n =
    Loc.failk "check/char-range" loc
      "this is %s, which is not a Unicode scalar value, so it is not a \
       char. A char is a code point from 0 to 0x10FFFF, outside 0xD800 \
       to 0xDFFF" n
  in
  let kind = match want with Some (Types.Int k) -> k | _ -> Types.I32 in
  match a.Tast.ty, b.Tast.ty with
  | Types.Char, Types.Char when String.equal name "-" ->
    let t = Types.Int kind in
    (match const a, const b with
     | Some x, Some y -> int_literal loc ~want:(Some t) (Int64.sub x y)
     | _ -> mk loc t (Tast.Prim (Tast.Sub, [ widen loc t a; widen loc t b ])))
  | Types.Char, Types.Int k | Types.Int k, Types.Char
    when not (String.equal name "-" && b.Tast.ty = Types.Char) ->
    let c, n = if a.Tast.ty = Types.Char then a, b else b, a in
    (match const c, const n with
     (* A u64 past the largest i64 is held as a negative i64: no char. *)
     | Some _, Some v when k = Types.U64 && Int64.compare v 0L < 0 ->
       not_scalar (Printf.sprintf "past 0x10FFFF")
     | Some x, Some y ->
       let r = if op = Tast.Add then Int64.add x y else Int64.sub x y in
       if scalar r then mk loc Types.Char (Tast.Int (r, Types.U32))
       else not_scalar (Int64.to_string r)
     (* The runtime takes the integer as itself — a u64 unsigned, anything
        else as an i64 — and checks the sum for overflow, so no large one
        wraps round to a char or to a wrong number in the trap. *)
     | _ ->
       rt loc Types.Char
         (if k = Types.U64 then "flan_char_step_u64" else "flan_char_step_i64")
         [ widen loc (Types.Int Types.I32) c;
           (if k = Types.U64 then n else i64 n);
           mk loc (Types.Int Types.I32)
             (Tast.Int ((if op = Tast.Sub then 1L else 0L), Types.I32));
           here loc ])
  | _ ->
    char_arith (if a.Tast.ty = Types.Char then a.Tast.loc else b.Tast.loc) name;
    assert false

(* Whether [e] may be a char, read off its form without checking it: a name
   bound to one, a (char n), a function returning one, or [+]/[-] over any
   of those. What decides whether a [+] or [-] is checked as char
   arithmetic before the want of its site reaches its operands. A char
   literal is not on the list: beside a number it is that number. *)
and maybe_char ctx (e : Ast.expr) =
  match e.Ast.e with
  | Ast.Var n ->
    (match lookup ctx n with
     | Some b -> b.bty = Types.Char
     | None ->
       match peek_outer ctx n with
       | Some b -> b.bty = Types.Char
       | None ->
         (match Hashtbl.find_opt ctx.env.globals n with
          | Some (t, _) -> t = Types.Char
          | None -> false))
  | Ast.Call ({ Ast.e = Ast.Var "char"; _ }, [ _ ]) -> true
  | Ast.Call ({ Ast.e = Ast.Var ("+" | "-"); _ }, args) ->
    List.exists (maybe_char ctx) args
  | Ast.Call ({ Ast.e = Ast.Var f; _ }, _) ->
    (match Hashtbl.find_opt ctx.env.fns f with
     | Some (_, r) -> r = Types.Char
     | None -> false)
  | _ -> false

(* ── A conversion whose operand is a type variable ─────────────────────
   [(i32 x)] where [x] is a [$t]. The concrete question — is this a number —
   has no answer during the abstract pass, and asking it anyway is what
   refused [(i32 (at xs i))] inside a body bounded [is-integer]. The question
   the bound can answer is the one asked here: does what the [where] clause
   declares about the variable entail the predicate this conversion needs.

   Which predicate that is comes from the *target*, and the rule is the
   concrete arm's rule read off a set rather than a type: a conversion legal
   at every type the bound admits is legal at the variable, and one illegal at
   any of them is refused. A number target needs [is-numeric] — every type it
   admits converts to every numeric target today, truncating or rounding by
   the same rule a written f64 follows. An enum target needs [is-integer],
   because [is-numeric] admits f32 and f64 and a float has no enum reading.

   [is-ordered], [is-equal] and [is-hashable] are refused: they say what can be
   compared, not what is a number, and nothing about a bound that only orders
   says a conversion means anything. That they happen to admit only numbers
   and enums today is a fact about [Types.is_comparable], not about what the
   predicate claims — keying conversions to it would make widening [is-ordered]
   to strings a silent change to what converts.

   The message says what the variable is known to be and what to write. Both
   spellings compile as written, and the clause spelling is [unconstrained]'s
   so that the family says it one way: a body with no clause is given the
   whole clause, and a body that already has one is told which predicate to
   add rather than a clause that would drop the ones it has. *)
and cast_operand ctx loc name ~needs ?also ~what ~is v =
  if declares ctx.env.tvpreds v needs
  || (match also with
      | Some (p, _) -> declares ctx.env.tvpreds v p
      | None -> false)
  then ()
  else
    (* A conversion two bounds license is refused naming both, since which one
       the reader meant is theirs to say. *)
    let is = match also with Some (_, is') -> is ^ " or " ^ is' | None -> is in
    let declared =
      List.filter_map
        (fun (p : Ast.pred) ->
           if String.equal p.Ast.pvar v then Some p.Ast.pname else None)
        ctx.env.tvpreds
    in
    let known =
      match declared with
      | [] -> Printf.sprintf "Nothing here says %s is %s" v is
      | ps ->
        Printf.sprintf
          "The where clause says %s is %s, and that does not make it %s" v
          (String.concat " and " (List.map pred_word ps)) is
    in
    let fix =
      let alt clause =
        match also with
        | Some (p, is') ->
          Printf.sprintf ", or %s for %s"
            (Printf.sprintf clause p v) is'
        | None -> ""
      in
      if ctx.env.tvpreds = [] then
        Printf.sprintf "write %s at the head of the body%s"
          (where_text loc needs ("$" ^ v))
          (if Source.indented_at loc then alt "where %s($%s)" else alt "{:where (%s $%s)}")
      else if Source.indented_at loc then
        Printf.sprintf "add %s($%s) to the where clause%s" needs v (alt "%s($%s)")
      else
        Printf.sprintf "add (%s $%s) to the where clause%s" needs v
          (alt "(%s $%s)")
    in
    Loc.failk "check/unconstrained-type-variable" loc
      "%s converts %s. %s — %s" name what known fix

and fold_left_prim ctx ~want loc name p ~needs ok what args =
  refuse_kept_when ctx name args;
  let x, y, rest =
    match args with x :: y :: rest -> x, y, rest | _ -> assert false
  in
  let charish = String.equal name "+" || String.equal name "-" in
  let nwant = numeric_want want in
  (* A char literal is a char here, not the number, when no number is
     wanted; one that may be a char by its form keeps the want off the pair,
     which a char minus a char answers at the want's width itself. *)
  let int_lit (e : Ast.expr) = match e.Ast.e with Ast.Int _ -> true | _ -> false in
  (* A char literal later in the chain is a char only while everything
     before it is an integer literal too; beside a typed number it is that
     number, as in (+ b c \0) over bytes. *)
  let untyped = ref (int_lit x && int_lit y) in
  let char_lit (e : Ast.expr) =
    match e.Ast.e with Ast.Byte _ -> nwant = None && !untyped | _ -> false
  in
  let a, b =
    try
      (match x.Ast.e, y.Ast.e with
       | Ast.Int _, Ast.Byte _ when charish && nwant = None ->
         raise_notrace (Char_pair (check ctx x, check ctx y))
       | _ -> ());
      let pwant = if charish && (maybe_char ctx x || maybe_char ctx y) then None else nwant in
      char_operands ctx ~charish name [ x; y ] (fun () ->
          binary ctx ~dyn_ok:true ~char_ok:charish name loc ~want:pwant [ x; y ])
    with Char_pair (a, b) -> a, b
  in
  (* One dyn operand makes the whole fold dyn, whichever side it is on. The
     typed side is boxed by [dyn_fold]; a literal was already built at dyn by
     [binary], so [(+ x 1)] over a dyn x folds an i64 one. *)
  let is_char (e : Tast.expr) = e.Tast.ty = Types.Char in
  if charish && a.Tast.ty <> Types.Dyn && b.Tast.ty <> Types.Dyn
     && (is_char a || is_char b
         || List.exists (maybe_char ctx) rest
         || (let rec any = function
               | [] -> false
               | r :: tl -> char_lit r || (untyped := !untyped && int_lit r; any tl)
             in
             let was = !untyped in
             let r = any rest in
             untyped := was; r)) then
    (* Left to right, each step char arithmetic when a char is in it and the
       ordinary join when none is: (- \z \a 1) is 25 - 1, and (+ 1 2 \a) is
       3 + \a. *)
    let rec steps acc = function
      | [] -> expect ctx loc ~want acc
      | (arg : Ast.expr) :: tl ->
        let lit = char_lit arg in
        untyped := !untyped && int_lit arg;
        if is_char acc || maybe_char ctx arg || lit then
          let v = check ctx arg in
          if v.Tast.ty = Types.Dyn then dyn_fold ctx ~want loc name [ acc; v ] tl
          else if is_char acc || is_char v then
            steps (char_step ~want:nwant loc name acc v) tl
          else
            match fold_operand ctx acc.Tast.ty (expect ctx arg.Ast.loc ~want:(Some acc.Tast.ty) v) with
            | `Typed v -> steps (mk loc acc.Tast.ty (Tast.Prim (p, [ acc; v ]))) tl
            | `Dyn d -> dyn_fold ctx ~want loc name [ acc; d ] tl
        else
          match fold_arg ctx acc.Tast.ty arg with
          | `Typed v -> steps (mk loc acc.Tast.ty (Tast.Prim (p, [ acc; v ]))) tl
          | `Dyn d -> dyn_fold ctx ~want loc name [ acc; d ] tl
    in
    let first =
      if is_char a || is_char b then char_step ~want:nwant loc name a b
      else mk loc a.Tast.ty (Tast.Prim (p, [ a; b ]))
    in
    steps first rest
  else if a.Tast.ty = Types.Dyn || b.Tast.ty = Types.Dyn then
    dyn_fold ctx ~want loc name [ a; b ] rest
  else begin
  (* [~needs] is the operator's own bound: [is-numeric] for the arithmetic,
     [is-integer] for the bitwise fold. Asking the tighter question here is what
     keeps a bitwise body's refusal at the *definition* — under [is-numeric] the
     abstract pass admitted [(bit-and x 1)] and the refusal arrived from
     inside the generic's source at whichever call site first instantiated at
     a float, which is the misplaced diagnostic the pass exists to avoid. *)
  unconstrained ctx.env loc name ~needs 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 not_numeric name what a;
  let ty = a.Tast.ty in
  let rec steps acc = function
    | [] -> expect ctx loc ~want acc
    | arg :: tl ->
      match fold_arg ctx ty arg with
      | `Typed v -> steps (mk loc ty (Tast.Prim (p, [ acc; v ]))) tl
      | `Dyn d -> dyn_fold ctx ~want loc name [ acc; d ] tl
  in
  steps (mk loc ty (Tast.Prim (p, [ a; b ]))) rest
  end

(* An operand past a fold's first pair, checked at the type so far. A dyn one
   is taken back as the dyn it was, not opened at that type: a typed operand
   beside a dyn gives dyn (rule 117), so from there on the fold is the dyn
   runtime's, and (+ 1 2 d) is (+ 3 d). *)
and fold_operand ctx ty (v : Tast.expr) =
  if v.Tast.ty = Types.Dyn && not (Types.equal ty Types.Dyn) then `Dyn v
  else
    match opened_dyn ~box:(to_dyn ctx) v with
    | Some d -> `Dyn d
    | None -> `Typed v

(* An operand past a fold's first pair, from the source: at the type so far,
   and on its own terms only when that is refused, as [binary_pair] checks
   the second of the pair. A dyn it turns out to be joins the fold as a dyn,
   so (+ 1 2 (the dyn nil)) traps at run time as (+ (the dyn nil) 1 2) does
   instead of being refused for a nil with no value at i32, and a dyn beside
   a [$t] is not opened at the variable. Anything else is checked at the type
   again, for real, so its refusal is the one it always gave and recovery
   records it. *)
and fold_arg ctx ty (arg : Ast.expr) =
  match trial_at ctx arg ty with
  | Ok v -> fold_operand ctx ty v
  | Error _ ->
    (* Only asked, and asked with the literal locals' uses unrecorded: a
       [trial] does not take back what the session recorded, and the operand
       on its own terms is not how the program reads it unless it is a dyn —
       (+ x y) over an int x and a float y would merge the two and move the
       refusal onto x. A dyn is then checked again, recorded. *)
    let unrecorded f =
      match ctx.lits with
      | Some s when s.recording ->
        s.recording <- false;
        Fun.protect ~finally:(fun () -> s.recording <- true) f
      | _ -> f ()
    in
    let is_dyn =
      probe ctx arg.Ast.loc (fun () -> unrecorded (fun () -> (check ctx arg).Tast.ty))
      = Some Types.Dyn
    in
    if is_dyn then `Dyn (to_dyn ctx (check ctx arg))
    else fold_operand ctx ty (check ctx ~want:ty arg)

(* A pair an arithmetic operator refused, when one operand is a char: that
   is the refusal to give, rather than the mismatch between the two. Asked
   only after the refusal, so a pair that checks costs nothing more. *)
and char_operands ctx ?(charish = false) name (args : Ast.expr list) f =
  try f ()
  with Loc.Error _ as ex ->
    (* [+] and [-] take a char beside an integer (decision 131): the pair is
       read again on its own terms, and [char_step] decides. *)
    let own () =
      List.map (fun a -> trial ctx (fun () -> check ctx a)) args
    in
    (match charish, args with
     | true, [ x; y ] ->
       (match own () with
        | [ Ok a; Ok b ]
          when (a.Tast.ty = Types.Char
                && (Types.is_integer b.Tast.ty || b.Tast.ty = Types.Char))
               || (b.Tast.ty = Types.Char && Types.is_integer a.Tast.ty) ->
          raise_notrace (Char_pair (check ctx x, check ctx y))
        | _ -> ())
     | _ -> ());
    (* A char literal beside a number is that number, so it says nothing
       unless every operand is a literal. *)
    let all_lit = List.for_all is_literal args in
    List.iter
      (fun (a : Ast.expr) ->
         let lit = match a.Ast.e with Ast.Byte _ -> true | _ -> false in
         if all_lit || not lit then
           match trial ctx (fun () -> check ctx a) with
           | Ok e when e.Tast.ty = Types.Char -> char_arith a.Ast.loc name
           | _ -> ())
      args;
    raise ex

(* An operand is kept, so a form with no else at its end — a [when], a
   [cond] or an [if]/[if let] chain with no final else, or a [do] or [let]
   ending in one — answers an Option there. Beside a number that is refused
   at the form itself, before the operands are checked against each other,
   where the number beside it would be blamed instead. One over a dyn answers
   a dyn, and that is left to the operator. *)
and refuse_kept_when ctx name (args : Ast.expr list) =
  (* The form with no else, found at the end of [a]. *)
  let rec else_less (a : Ast.expr) =
    match a.Ast.e with
    | Ast.If (_, _, None) | Ast.IfLet (_, _, None) -> Some a
    | Ast.If (_, _, Some e) | Ast.IfLet (_, _, Some e) ->
      if open_tail e then Some a else None
    | Ast.Do (_ :: _ as xs) | Ast.Let (_, (_ :: _ as xs)) ->
      else_less (List.nth xs (List.length xs - 1))
    | _ -> None
  and open_tail (e : Ast.expr) =
    match e.Ast.e with
    | Ast.Do [] -> true
    | _ -> else_less e <> None
  in
  let ty (a : Ast.expr) = probe ctx a.Ast.loc (fun () -> (check ctx a).Tast.ty) in
  let number (a : Ast.expr) =
    match a.Ast.e with
    | Ast.Int _ | Ast.UInt _ | Ast.Float _ | Ast.Byte _ -> true
    | _ when else_less a <> None -> false
    | _ -> (match ty a with Some t -> Types.is_numeric t | None -> false)
  in
  List.iter
    (fun (a : Ast.expr) ->
       match else_less a with
       | Some form ->
         (match ty a with
          | Some (Types.Option _ as t)
            when List.exists (fun b -> b != a && number b) args ->
            let fln = fln_source form.Ast.loc in
            let what =
              match form.Ast.e with
              | Ast.If (_, _, None) -> if fln then "if without an else" else "when"
              | Ast.IfLet _ -> "if let without an else"
              | _ -> if fln then "if chain without an else" else "chain without an else"
            in
            Loc.failk "check/kept-when" form.Ast.loc
              "this %s is an operand of %s, so its value is kept, and there it \
               gives %s: Some of its value when a test holds, None when none \
               does. The other side is a number. Give it an else, or unwrap \
               what it gives with match"
              what name (tyname form.Ast.loc t)
          | _ -> ())
       | None -> ())
    args

(* The dyn lowering of a fold: one call per operator application, left to
   right, each taking and answering a dyn word. The typed side of a mixed pair
   is boxed on the way in — [box] is the identity on something already dyn, so
   this needs no case analysis of its own. *)
and dyn_fold ctx ~want loc name first rest =
  let sym =
    match name with
    | "+" -> "flan_dyn_add" | "-" -> "flan_dyn_sub"
    | "*" -> "flan_dyn_mul" | "/" -> "flan_dyn_div"
    | "%" -> "flan_dyn_rem"
    | "min" -> "flan_dyn_min" | "max" -> "flan_dyn_max"
    | _ -> dyn_bits_sym name
  in
  (* A bitwise fold takes integers on both sides, and the typed side of a
     mixed pair can be asked now rather than at run time. *)
  let bitwise = not (List.mem name [ "+"; "-"; "*"; "/"; "%"; "min"; "max" ]) in
  if bitwise then
    List.iter
      (fun (v : Tast.expr) ->
         if v.Tast.ty <> Types.Dyn then bits_operand ctx v.Tast.loc name v)
      first;
  (* The site travels with the operands. A dyn arithmetic trap is this
     language's type error, and until now it printed with no file, no line and
     no column — [here loc] is the same string literal [cast_dyn] hands the
     runtime, and the runtime prints it as a GNU prefix. *)
  let apply acc b = rt loc Types.Dyn sym [ acc; box ~ctx loc b; here loc ] in
  let operand arg =
    if bitwise then begin
      let v = check ctx arg in
      if v.Tast.ty <> Types.Dyn then bits_operand ctx v.Tast.loc name v;
      v
    end
    else check ctx ~want:Types.Dyn arg
  in
  let rest = map_lr operand rest in
  no_bare_nil (first @ rest);
  let acc =
    match first with
    | [ a; b ] -> apply (box ~ctx loc a) b
    | _ -> assert false
  in
  let acc = List.fold_left apply acc rest in
  expect ctx loc ~want acc

(* The runtime's entry point for each bit operation on a dyn int. *)
and dyn_bits_sym name =
  match name with
  | "bit-and" -> "flan_dyn_bitand" | "bit-or" -> "flan_dyn_bitor"
  | "bit-xor" -> "flan_dyn_bitxor" | "bit-not" -> "flan_dyn_bitnot"
  | "<<" -> "flan_dyn_shl" | ">>" -> "flan_dyn_shr"
  | "rotate-left" -> "flan_dyn_rotl" | "rotate-right" -> "flan_dyn_rotr"
  | "popcount" -> "flan_dyn_popcount" | "leading-zeros" -> "flan_dyn_clz"
  | "trailing-zeros" -> "flan_dyn_ctz"
  | _ -> invalid_arg ("dyn_bits_sym " ^ name)

(* An operand of a bit operation, once it is known not to be dyn: an integer,
   or a type variable the where clause bounds by [is-integer]. A bool is the
   likeliest thing to arrive here — [a && b] is logical and in C — so it is
   answered with the operator that does what was meant. *)
and bits_operand ctx loc name (v : Tast.expr) =
  match v.Tast.ty with
  | Types.Int _ -> ()
  | t when generic_ty t -> unconstrained ctx.env loc name ~needs:"is-integer" t
  | Types.Bool -> bool_bits v.Tast.loc name
  | Types.Char -> char_arith v.Tast.loc name
  | other -> fail loc "%s takes integers, found %s" name (tyname loc other)

(* A bool operand is refused before the operands are joined, and not left to
   [bits_operand]: the join sees a bool beside an integer as a plain mismatch,
   "expected i32, found bool", which says nothing of [and]. Each operand's own
   type is asked in a trial that is always abandoned, so the check leaves no
   trace — no slot, no lifted lambda, no recorded refusal — and the real check
   below is the only one that counts. A literal is never a bool, and a call to
   an arithmetic or bit operator answers a number or a dyn, so neither is
   asked. Nor is anything asked while a probe is running: the probe wants a
   type, and asking again inside it would check a nest of these once per
   level for every level above it, which doubles with each level. *)
and bool_operands ctx name (args : Ast.expr list) =
  if not !probing then
  let never_bool (a : Ast.expr) =
    match a.Ast.e with
    | Ast.Int _ | Ast.UInt _ | Ast.Float _ | Ast.Byte _ | Ast.Str _ | Ast.Kw _ ->
      true
    | Ast.Call ({ Ast.e = Ast.Var h; _ }, _) ->
      List.mem h
        [ "+"; "-"; "*"; "/"; "%"; "bit-and"; "bit-or"; "bit-xor"; "bit-not";
          "&&"; "||"; "^^"; "~~"; "<<"; ">>"; "rotate-left"; "rotate-right";
          "popcount"; "leading-zeros"; "trailing-zeros" ]
      && not (shadows_builtin ctx a.Ast.loc h)
    | _ -> false
  in
  let is_bool (a : Ast.expr) =
    (not (never_bool a))
    &&
    let ty = ref None in
    probing := true;
    Fun.protect ~finally:(fun () -> probing := false) (fun () ->
        ignore
          (trial ctx (fun () ->
               let v = check ctx a in
               ty := Some v.Tast.ty;
               Loc.failk "check/probe" a.Ast.loc "abandoned")));
    !ty = Some Types.Bool
  in
  List.iter (fun a -> if is_bool a then bool_bits a.Ast.loc name) args

and bool_bits loc name =
  let fln = fln_source loc in
  let shown =
    if not fln then name
    else match name with
      | "bit-and" -> "&&" | "bit-or" -> "||" | "bit-xor" -> "^^"
      | "bit-not" -> "~~" | n -> n
  in
  let logic =
    match name with
    | "bit-and" -> Some (if fln then "a and b" else "(and a b)")
    | "bit-or" -> Some (if fln then "a or b" else "(or a b)")
    | "bit-xor" -> Some (if fln then "a != b" else "(!= a b)")
    | "bit-not" -> Some (if fln then "not a" else "(not a)")
    | _ -> None
  in
  Loc.failk "check/bits-of-bool" loc
    "%s works on the bits of an integer, and this is a bool. %s" shown
    (match logic with
     | Some l -> Printf.sprintf "For true and false, write %s" l
     | None -> "True and false are combined with and, or and not")

(* A comparison over three operands or more asks about more than one pair, and
   every operand is bound to a slot before any pair is looked at. That is what
   makes "left to right, exactly once" true of the lowering and not only of
   the source: an operand two pairs name is written down once. The spelling a
   reader would reach for, [(and (< a b) (< b c))], evaluates b twice, which
   is wrong the moment b is a call — that is the whole reason this is a form
   the compiler builds rather than a macro.

   The pairs are then required to hold, and the conjunction stops at the first
   one that does not. That costs nothing observable, because by the time any
   pair is compared every operand has already been evaluated — stopping skips
   a machine compare, never a call.

   [pairs] says which pairs this operator asks about and [link] builds one
   comparison, so the two readings below and the dyn lowering of each are the
   same code with two arguments changed. *)
and cmp_over ctx loc ty ~pairs ~link ops =
  let binds = List.map (fun (e : Tast.expr) -> fresh_slot ctx ty, e) ops in
  let locals = List.map (fun (s, _) -> mk loc ty (Tast.Local s)) binds in
  let rec conj = function
    | [ t ] -> t
    | t :: rest ->
      mk loc Types.Bool
        (Tast.If (t, conj rest, mk loc Types.Bool (Tast.Bool false)))
    | [] -> assert false
  in
  let tests = List.map (fun (a, b) -> link a b) (pairs locals) in
  mk loc Types.Bool (Tast.Let (binds, [ conj tests ]))

(* The ordered comparisons chain: [(< a b c)] asks whether a is below b and b
   is below c. The other reading, the left fold [(< (< a b) c)], compares a
   bool against a number, and there is no program that meant it. So the pairs
   are the adjacent ones, n-1 of them, and the operand in the middle is the
   one two of them share. *)
and adjacent_pairs xs =
  match xs with
  | a :: (b :: _ as rest) -> (a, b) :: adjacent_pairs rest
  | _ -> []

(* [!=] is the one that does not chain. "Is this sequence increasing" and "are
   these values all different" are different questions, and only the first is
   about adjacent pairs: under chaining [(!= 1 2 1)] would be true, because
   each neighbour differs from the next, while the thing anyone means by it is
   false. So [!=] asks about *every* pair — Common Lisp's [/=] — which is
   n(n-1)/2 comparisons rather than n-1.

   That growth is fine at the sizes anyone writes: four operands is six
   compares of values already in slots. It is also invisible to every program
   there is today, because two operands is one pair either way and does not
   come through here at all. *)
and all_pairs xs =
  match xs with
  | [] -> []
  | x :: rest -> List.map (fun y -> (x, y)) rest @ all_pairs rest

(* ── 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, condition_desc ctx loc "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 ];
      rloc = loc; rreport = "Try the allocation again"; rhidden = false }
  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, condition_desc ctx loc "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 report 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 ];
      rloc = loc; rreport = report; rhidden = false }
  in
  let body =
    mk loc Types.Unit
      (Tast.RestartCase
         ([ clause "retry" "Try the file operation again" [];
            clause "use-value" "Try again with another path"
              [ (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. *)
(* A global value that a bare name in a type position would reach instead of
   a type. A type variable in scope is not shadowed by one: the prelude's
   generics write [(vec-new t)], and a program's [(defonce t ...)] must not
   change what the prelude means. *)
and global_value ctx n =
  Hashtbl.mem ctx.env.globals n && not (tyvar_in_scope ctx.env n)

(* An argument written as a type: a type expression, or a bare name that is a
   type and not a local or a global of the same spelling. *)
and type_arg ctx (a : Ast.expr) =
  type_of_expr ~generic:(Hashtbl.mem ctx.env.gstructs) a <> None
  || (match a.Ast.e with
      | Ast.Var n ->
        lookup ctx n = None && not (global_value ctx n) && type_named ctx n
      | _ -> false)

and type_named ctx n =
  (* A type variable names a type here too, which is what lets [(vec-new t)]
     and [(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. *)
  tyvar_in_scope ctx.env n
  (* A sigil is only ever written where a type goes, so a name carrying one is
     answered here even when nothing binds it: [resolve_name] then says that a
     variable has no binding site outside a defn signature, which is the
     mistake, instead of this form reporting a missing element type. *)
  || n <> tyvar_bare n
  || List.mem n Types.primitive_names
  (* Answered as a type so [resolve_name] says it is spelled [str], rather
     than this form saying no element type was written. *)
  || n = "string"
  || 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

(* A local or global that shares a type's name — [str] is a common name for
   text — is the binding in (vec-new str), and then nothing names the type.
   Said here so the refusal names the binding rather than a missing type. *)
and shadowed_type_arg ctx loc what args =
  match args with
  | { Ast.e = Ast.Var n; _ } :: _
    when type_named ctx n && (lookup ctx n <> None || global_value ctx n) ->
    fail loc
      "%s here is the value named %s and not the type, so nothing says what \
       (%s) makes — rename that binding to write the type" n n what
  (* [vec-new(grain?)] for a lowercase type: where a value is written, ? after
     anything but a capitalised or primitive name is the test [x?]. *)
  | { Ast.e = Ast.Call ({ Ast.e = Ast.Var "?"; _ }, [ { Ast.e = Ast.Var n; _ } ]); _ } :: _
    when type_named ctx n && lookup ctx n = None && not (global_value ctx n) ->
    fail loc
      "%s? here is the test that a value is present, and %s is a type. Where a \
       value is written, the Option of a type is Option(%s): %s(Option(%s))"
      n n n what n
  | _ -> ()

(* The element type for [vec-new]: a leading bare symbol naming a type, a
   leading type expression — [(vec-new [u8])], [(vec-new (Ptr Cell))], which
   Parse has already read as one — 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
    | a :: rest when type_of_expr ~generic:(Hashtbl.mem ctx.env.gstructs) a <> None ->
      Some
        (resolve ctx.env
           (Option.get (type_of_expr ~generic:(Hashtbl.mem ctx.env.gstructs) a)),
         rest)
    | { Ast.e = Ast.Var n; _ } :: rest
      when lookup ctx n = None && not (global_value ctx 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
     | _ ->
       shadowed_type_arg ctx loc "vec-new" args;
       fail loc
         "nothing here says what (vec-new) is a Vec of — write the element \
          type, as (vec-new i32)")

(* A type written as an argument to vec-new or map-new, read back out of the
   expression Parse made of it. Only the shapes that cannot be a value there:
   brackets — an allocator is never an array — or a parenthesised Ptr,
   Option, Vec, Map, Fn or CFn. A bare name is not one of them, because there
   it may be an allocator's name; the callers ask about that themselves. *)
and type_of_expr ?(generic = fun _ -> false) (e : Ast.expr) : Ast.texpr option =
  let mk t = { Ast.t; tloc = e.Ast.loc } in
  let inner (e : Ast.expr) =
    match e.Ast.e with
    | Ast.Var s -> Some { Ast.t = Ast.Tname s; tloc = e.Ast.loc }
    | _ -> type_of_expr ~generic e
  in
  let all es =
    let ts = List.filter_map inner es in
    if List.length ts = List.length es then Some ts else None
  in
  match e.Ast.e with
  | Ast.TypeArg t -> Some t
  (* Before the [[n T]] arm below, which would read [const] as a length. *)
  | Ast.Arr [ { Ast.e = Ast.Var "const"; _ }; x ] ->
    Option.map (fun t -> mk (Ast.Tslice (true, t))) (inner x)
  | Ast.Arr [ x ] -> Option.map (fun t -> mk (Ast.Tslice (false, t))) (inner x)
  | Ast.Arr [ { Ast.e = Ast.Int n; _ }; x ] ->
    Option.map (fun t -> mk (Ast.Tarray (Ast.Lint n, t))) (inner x)
  | Ast.Arr [ { Ast.e = Ast.Var n; _ }; x ] ->
    Option.map (fun t -> mk (Ast.Tarray (Ast.Lname n, t))) (inner x)
  | Ast.Call ({ Ast.e = Ast.Var (("Fn" | "CFn") as which); _ },
              [ { Ast.e = Ast.Arr ps; _ }; r ]) ->
    (match all ps, inner r with
     | Some ps, Some r -> Some (mk (Ast.Tfn (which = "Fn", ps, r)))
     | _ -> None)
  | Ast.Call ({ Ast.e = Ast.Var (("Ptr" | "Option" | "Vec" | "Map") as c); _ },
              (_ :: _ as args)) ->
    Option.map (fun ts -> mk (Ast.Tapp (c, ts))) (all args)
  (* A generic struct applied to its arguments, [(vec-new (Small 8 i32))]:
     the caller says which heads are ones, since only the env knows. An
     integer argument is a length. *)
  | Ast.Call ({ Ast.e = Ast.Var c; _ }, (_ :: _ as args)) when generic c ->
    let arg (a : Ast.expr) =
      match a.Ast.e with
      | Ast.Int n -> Some { Ast.t = Ast.Tlen n; tloc = a.Ast.loc }
      | _ -> inner a
    in
    let ts = List.filter_map arg args in
    if List.length ts = List.length args then Some (mk (Ast.Tapp (c, ts)))
    else None
  | _ -> None

(* 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 (tyname loc 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 str)
   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 (global_value ctx n) && type_named ctx n
  in
  (* A type position holds a bare name or a type expression Parse has read
     as one, as [vec-new]'s does. *)
  let as_type (a : Ast.expr) =
    match a.Ast.e, type_of_expr ~generic:(Hashtbl.mem ctx.env.gstructs) a with
    | _, Some t -> Some (resolve ctx.env t)
    | Ast.Var n, None when is_type n -> Some (resolve_name ctx.env ~seen:[] loc n)
    | _ -> None
  in
  match args with
  | k :: v :: rest when as_type k <> None && as_type v <> None ->
    Option.get (as_type k), Option.get (as_type v), rest
  | a :: _ when type_of_expr ~generic:(Hashtbl.mem ctx.env.gstructs) a <> None ->
    fail loc
      "(map-new) names a key and no value — write both, as (map-new str \
       i32)"
  | { 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)" k k
  | _ ->
    (match want with
     | Some (Types.Map (k, v)) -> k, v, args
     | _ ->
       shadowed_type_arg ctx loc "map-new" args;
       fail loc
         "nothing here says what (map-new) maps — write the key and value \
          types, as (map-new str i32)")

(* 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 (tyname loc 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 raw_alloc "flan_context_use" [ here loc ]
  | [ a ] -> alloc_value ctx loc a
  | _ -> fail loc "at most one allocator may be named here"

(* An Allocator value, checked and opened: the record every runtime call
   takes, after [use_alloc] has compared the incarnation. *)
and alloc_value ctx loc e = use_alloc ctx loc (check ctx ~want:Types.Alloc e)

(* A copy of [src]'s elements — a string's bytes or a slice's elements — into
   a block from [a], answered as a slice over it: (bytes s), (clone xs) and the
   number conversions. The lowering mirrors [vec-new]: a hidden (Vec T) temp
   holds the block so the allocation registry can read its extent, the attempt
   sits under [alloc_guard] so a failure signals StorageExhausted with retry,
   and the answer is the [slice] of the whole of it. The slice carries no
   allocator: (free s) hands the block back to the context allocator or the
   one named, and a dev build's registry — which the note gives the Vec's
   allocator — refuses the wrong one.

   The source is bound before the guard's loop, so a retry re-attempts the
   same copy rather than re-evaluating the expression that produced it. Same
   rule as [push]'s element. No [region_check]: that guard compares a Vec
   header being *stored* against the region it lands in, and the header here
   is a temp nothing stores. *)
and dup_elems ctx loc elem (src : Tast.expr) (a : Tast.expr) =
  let sty = src.Tast.ty in
  let sv = fresh_slot ctx sty in
  let v = fresh_slot ctx (Types.Vec elem) in
  let out = fresh_slot ctx (Types.Slice (Types.Mut, elem)) in
  let attempt =
    rt loc (Types.Int Types.I8) "flan_bytes_dup"
      [ mk loc (Types.Vec elem) (Tast.Local v); a;
        mk loc sty (Tast.Local sv); size_of loc elem; align_of loc elem;
        here loc ]
  in
  let fill =
    rt loc Types.Unit "flan_vec_as_slice"
      [ mk loc (Types.Vec elem) (Tast.Local v);
        addr_of loc (mk loc (Types.Slice (Types.Mut, elem)) (Tast.Local out));
        mk loc index_ty (Tast.Int (0L, Types.I32));
        mk loc index_ty (Tast.Int (-1L, Types.I32));
        size_of loc elem; here loc ]
  in
  mk loc (Types.Slice (Types.Mut, elem))
    (Tast.Let
       ([ (sv, src);
          (v, mk loc (Types.Vec elem) (Tast.Zero (Types.Vec elem)));
          (out, mk loc (Types.Slice (Types.Mut, elem)) (Tast.Zero (Types.Slice (Types.Mut, elem)))) ],
        [ with_note loc (alloc_guard ctx loc attempt)
            (reg_note loc "flan_dev_reg_note_slice"
               (mk loc (Types.Vec elem) (Tast.Local v))
               [ size_of loc elem ] elem);
          fill;
          mk loc (Types.Slice (Types.Mut, elem)) (Tast.Local out) ]))

(* 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. *)
(* A new, empty (Vec elem) from the opened allocator [a]: (vec-new)'s lowering,
   which (string-new) shares for the Vec under a String. *)
and vec_init ?note ctx loc elem (a : Tast.expr) =
  let note = Option.value note ~default:elem 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
  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 ] note);
                 region_check ctx.env loc
                   (mk loc (Types.Vec elem) (Tast.Local v))
                   (mk loc (Types.Vec elem) (Tast.Local v)) ]))

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 (Types.Mut, elem)) "flan_vec_at"
      [ target; i; size_of loc elem; here loc ], elem
  | _ ->
    fail loc
      "a Vec takes exactly one index, as (at v i)"

(* [(get xs i ...)] over an array, a slice, a string or a Vec: the element
   as [(Some e)], or [None] when any index is out of range, negative
   included, where [at] would trap. One index per dimension, as [at] takes.

   The indices are evaluated once, left to right, before any test. An array's
   length is static, so the array itself is read once and is not copied; a
   slice's, a string's or a Vec's is read off the value, so that value is
   put in a slot first unless it is already a name. Each level is tested
   before the next is reached, because a Vec of Vecs has no inner length to
   test until the outer index is known to be in range. The element is then
   read by [at] as usual, whose own check can no longer fail. *)
and checked_get ctx ~want loc (target : Tast.expr) (idx : Ast.expr list) =
  let rec result ty = function
    | [] -> ty
    | (i : Ast.expr) :: rest ->
      (match ty with
       | Types.Array (_, t) | Types.Slice (_, t) | Types.Vec t -> result t rest
       | Types.String -> result (Types.Int Types.U8) rest
       | other ->
         fail i.Ast.loc
           "get takes an array, a slice, a string, a Vec, a Map or a dyn, and \
            %s cannot be indexed" (tyname i.Ast.loc other))
  in
  let oty = Types.Option (result target.Tast.ty idx) in
  let none () = mk loc oty Tast.None_ in
  let is_name (e : Tast.expr) =
    match e.Tast.e with Tast.Local _ | Tast.Global _ -> true | _ -> false
  in
  (* A value a call answered is bound before the indices run, so the target
     is still evaluated first. *)
  let pre = ref [] in
  let target =
    match target.Tast.e with
    | Tast.Call _ | Tast.CallPtr _ ->
      let s = fresh_slot ctx target.Tast.ty in
      pre := [ (s, target) ];
      mk loc target.Tast.ty (Tast.Local s)
    | _ -> target
  in
  let islots =
    map_lr
      (fun (i : Ast.expr) ->
         let v = index_expr ctx i in
         let s = fresh_slot ctx index_ty in
         (s, v))
      idx
  in
  let ivar (s, _) = mk loc index_ty (Tast.Local s) in
  let i32 k = mk loc index_ty (Tast.Int (k, Types.I32)) in
  let within i len =
    let ge = mk loc Types.Bool (Tast.Prim (Tast.Ge, [ i; i32 0L ])) in
    let lt = mk loc Types.Bool (Tast.Prim (Tast.Lt, [ i; len ])) in
    mk loc Types.Bool (Tast.If (ge, lt, mk loc Types.Bool (Tast.Bool false)))
  in
  (* The value reached so far is [base] indexed by [path], innermost last. *)
  let reached base path ty =
    if path = [] then base
    else mk loc ty (Tast.Prim (Tast.At, base :: List.rev path))
  in
  (* A value whose length is read as well as indexed, in a slot unless it is
     a name already. *)
  let named cur k =
    if is_name cur then k cur
    else
      let s = fresh_slot ctx cur.Tast.ty in
      mk loc oty
        (Tast.Let ([ (s, cur) ], [ k (mk loc cur.Tast.ty (Tast.Local s)) ]))
  in
  let rec go base path ty = function
    | [] -> mk loc oty (Tast.Some_ (reached base path ty))
    | i :: rest ->
      let i = ivar i in
      (match ty with
       | Types.Array (n, t) ->
         mk loc oty (Tast.If (within i (i32 n), go base (i :: path) t rest, none ()))
       | Types.Slice _ | Types.String ->
         let t =
           match ty with Types.Slice (_, t) -> t | _ -> Types.Int Types.U8
         in
         named (reached base path ty) (fun cur ->
             let len = mk loc index_ty (Tast.Prim (Tast.Len, [ cur ])) in
             mk loc oty (Tast.If (within i len, go cur [ i ] t rest, none ())))
       | Types.Vec t ->
         named (reached base path ty) (fun cur ->
             let n = rt loc (Types.Int Types.I64) "flan_vec_len" [ cur; here loc ] in
             let len = mk loc index_ty (Tast.Prim (Tast.Cast index_ty, [ n ])) in
             let p =
               rt loc (Types.Ptr (Types.Mut, t)) "flan_vec_at"
                 [ cur; i; size_of loc t; here loc ]
             in
             mk loc oty
               (Tast.If (within i len, go (mk loc t (Tast.Deref p)) [] t rest,
                         none ())))
       | _ -> assert false)
  in
  expect ctx loc ~want
    (mk loc oty (Tast.Let (!pre @ islots, [ go target [] target.Tast.ty islots ])))

(* [(get d k ...)] over a dyn: a map's value at the key, a vec's or a text's
   element at the index, or nil when there is none — dyn has no Option. More
   than one key walks a level per key, and a nil level answers nil. *)
and dyn_get ctx ~want loc (target : Tast.expr) (keys : Ast.expr list) =
  let nil () = rt loc Types.Dyn "flan_dyn_nil" [] in
  let one v k = rt loc Types.Dyn "flan_dyn_get_at" [ v; k; here loc ] in
  (* A slot per key only when there are several: one key goes straight to
     [flan_dyn_get_at]. Over a text or a vec that runs [at]'s own body in the
     runtime, so [get] and [at] count a text the same way whatever [at]
     comes to count. *)
  let slotted = List.length keys > 1 in
  let keys =
    map_lr
      (fun k ->
         let v = check ctx ~want:Types.Dyn k in
         ((if slotted then fresh_slot ctx Types.Dyn else -1), v))
      keys
  in
  let kvar (s, _) = mk loc Types.Dyn (Tast.Local s) in
  let rec go v = function
    | [] -> v
    | k :: rest when rest = [] -> one v (kvar k)
    | k :: rest ->
      let s = fresh_slot ctx Types.Dyn in
      let sv = mk loc Types.Dyn (Tast.Local s) in
      let is_nil =
        mk loc Types.Bool
          (Tast.Prim (Tast.Ne,
                      [ rt loc (Types.Int Types.I32) "flan_dyn_is_nil" [ sv ];
                        mk loc (Types.Int Types.I32) (Tast.Int (0L, Types.I32)) ]))
      in
      mk loc Types.Dyn
        (Tast.Let ([ (s, one v (kvar k)) ],
                   [ mk loc Types.Dyn (Tast.If (is_nil, nil (), go sv rest)) ]))
  in
  match keys with
  | [ (_, k) ] -> expect ctx loc ~want (one target k)
  | _ ->
    let ts = fresh_slot ctx Types.Dyn in
    expect ctx loc ~want
      (mk loc Types.Dyn
         (Tast.Let ((ts, target) :: keys,
                    [ go (mk loc Types.Dyn (Tast.Local ts)) keys ])))

(* [(slice v)], [(slice v lo)] and [(slice v lo hi)] over a Vec — the arm for
   it is in [slice], and this is the half that differs from an array's.

   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. What makes a Vec's view different from an array's is that the
   storage it names can move — a [push], a [put] or a [reserve] may reallocate
   and leave the view addressing the old block. Nothing checks that, which is
   the explicit Zig/Odin contract spec-memory.md chose over a borrow checker,
   and it is written down where a reader meets it: beside [push] in BUILT.md
   and in spec-memory.md's "Borrowing".

   It used to be spelled [as-slice], on the theory that a second name warns
   about that. It does not: the input type already decides which of the two
   things happens, so there was no choice at the call site for the name to
   express — and the moment it warned about was the moment the view is taken,
   while the danger arrives later, at the push.

   No slot and no length read at any arity: -1 is the runtime's "to the end",
   so the short forms pass a constant where an array passes its length, and
   the target appears exactly once in all three.

   A Vec a *call* returned is accepted, where an array a call returned is
   refused a screen down. The array is a dangle — the view outlives a
   temporary the frame reuses — and this is not: the storage a returned Vec
   owns lives to its allocator's free-all or destroy, so the view reads what
   it says it reads. What a returned Vec loses is the owner, and losing the
   owner is a leak, which this language has already decided is defined
   behaviour (spec-memory.md on overwriting a global Vec: "overwrites the
   first block and leaks it; there is no drop"). [(length (mk))] and
   [(at (mk) 0)] lose exactly the same owner and are accepted; refusing the
   third of those three would be a rule about one spelling rather than about
   a hazard, and under a region allocator there is nothing to leak at all. *)
and vec_slice ctx ~want loc (target : Tast.expr) elem (bounds : Ast.expr list) =
  let int k = mk loc index_ty (Tast.Int (k, Types.I32)) in
  (* Every bound the reader wrote goes through here, and the -1 below does
     not: a negative literal is refused exactly as it is on an array, in the
     same words, and that refusal has to happen on the bounds a person wrote
     rather than on the pair that comes out of this — the sentinel *is* a -1,
     and checking afterwards would refuse (slice v) itself. There is no static
     length to check the other direction against. *)
  let bound (b : Ast.expr) =
    let v = index_expr ctx b in
    (match literal v with
     | Some k ->
       static_index b.Ast.loc (Types.Vec elem) ~past_end:true "slice bound" k
     | None -> ());
    v
  in
  (* -1 is the runtime's "to the end". A Vec's length is not static, so unlike
     an array there is no constant to fold and the runtime reads the length
     word the header is carrying anyway. *)
  let to_end () = int (-1L) in
  let lo, hi =
    match bounds with
    | [] -> int 0L, to_end ()
    | [ lo ] -> bound lo, to_end ()
    | [ lo; hi ] ->
      let lo = bound lo and hi = bound hi in
      (* The same refusal the other targets get, and it is asked only here,
         where both ends are bounds somebody wrote. *)
      (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
       | _ -> ());
      lo, hi
    | _ -> assert false
  in
  let out = fresh_slot ctx (Types.Slice (Types.Mut, elem)) in
  let fill =
    rt loc Types.Unit "flan_vec_as_slice"
      [ target; addr_of loc (mk loc (Types.Slice (Types.Mut, elem)) (Tast.Local out));
        lo; hi; size_of loc elem; here loc ]
  in
  expect ctx loc ~want
    (mk loc (Types.Slice (Types.Mut, elem))
       (Tast.Let ([ (out, mk loc (Types.Slice (Types.Mut, elem))
                            (Tast.Zero (Types.Slice (Types.Mut, elem)))) ],
                  [ fill; mk loc (Types.Slice (Types.Mut, elem)) (Tast.Local out) ])))

(* ── String ───────────────────────────────────────────────────────────
   The prelude's (defstruct String [bytes (Vec u8)]) is valid UTF-8 because
   nothing outside the prelude can reach the Vec: its field cannot be named
   and the struct cannot be built ([refuse_string_inside]), and it is not
   indexed ([refuse_string_index]). Every byte arrives through an arm below.

   Text the checker cannot prove valid is checked at run time, at the site
   that stores it, and a bad byte stops the program there (flan_utf8_check,
   flan_rune_check) — a str may hold any bytes, since (str b) does not check.
   A string literal and an integer literal are checked here instead, so text
   written in the source costs nothing at run time. A [const u8] is refused
   rather than checked: bytes become text through (str b) or (bytes->string
   v), which says at the call that a check is wanted.

   Positions are characters and lengths are bytes, the rule str has. The
   character index is found by a walk (flan_string_index), which signals
   BoundsError with the character count as the length. *)
and refuse_string_inside loc =
  if not (String.equal loc.Loc.file Prelude.file) then begin
    let fln = fln_source loc in
    Loc.failk "check/string-private" loc
      "a String keeps its bytes to itself, which is how they stay valid \
       UTF-8. Make one with %s, read it with %s or %s, and change it with \
       append, insert and remove"
      (if fln then "string-new(text)" else "(string-new text)")
      (if fln then "str(s)" else "(str s)")
      (if fln then "bytes-view(s)" else "(bytes-view s)")
  end

and refuse_string_index loc ~store =
  let fln = fln_source loc in
  if store then
    Loc.failk "check/string-set-index" loc
      "a String cannot be changed one byte at a time. A character in UTF-8 \
       is one to four bytes, so writing a single byte can leave text that is \
       not valid. Change it by character position instead: %s, then %s"
      (if fln then "remove(s, i)" else "(remove s i)")
      (if fln then "insert(s, i, c)" else "(insert s i c)")
  else
    Loc.failk "check/string-index" loc
      "a String is not indexed, because in UTF-8 a byte position and a \
       character position are different numbers. Read byte i with %s, or \
       walk the characters with %s"
      (if fln then "str(s)[i]" else "(at (str s) i)")
      (if fln then "runes(s)" else "(runes s)")

(* An argument that may be a String: checked with no expectation when its
   type does not depend on one — a name, a call, a field — and against
   [otherwise] when it does, as the builtin always checked it. *)
and maybe_string ctx ~otherwise (x : Ast.expr) =
  match x.Ast.e with
  | Ast.Var _ | Ast.Call _ | Ast.Field _ ->
    let e = check ctx x in
    if string_or_ptr e.Tast.ty then e
    else expect ctx x.Ast.loc ~want:(Some otherwise) e
  | _ -> check ctx ~want:otherwise x

(* A String's bytes as a [const u8]: a view of the Vec, costing nothing, and
   good until the String next grows — (slice v)'s contract. *)
and string_bytes ctx loc (s : Tast.expr) =
  let v = vec_slice ctx ~want:None loc (string_vec loc s) u8_ty [] in
  { v with Tast.ty = Types.Slice (Types.Const, u8_ty) }

(* A str, a String or a [const u8], as a [const u8]: what rune-count and
   runes read. *)
and text_bytes ctx what (x : Ast.expr) =
  let e =
    match x.Ast.e with
    | Ast.Str _ -> check ctx ~want:Types.String x
    | _ -> check ctx x
  in
  let loc = x.Ast.loc in
  match e.Tast.ty with
  | Types.String ->
    mk loc (Types.Slice (Types.Const, u8_ty)) (Tast.Prim (Tast.Bytes, [ e ]))
  | t when string_or_ptr t -> string_bytes ctx loc e
  | Types.Slice (_, Types.Int Types.U8) ->
    { e with Tast.ty = Types.Slice (Types.Const, u8_ty) }
  | other ->
    fail loc "%s takes a str, a String or a [const u8], found %s" what
      (tyname loc other)

(* The String an operation changes, written as the String or a pointer to
   one, and refused when it is reached through something read-only. *)
and string_target ctx loc what (t : Tast.expr) =
  let t =
    match t.Tast.ty with
    | Types.Ptr (_, ty) when is_string_ty ty -> mk loc ty (Tast.Deref t)
    | ty when is_string_ty ty -> t
    | other ->
      fail loc "%s takes a String to change, found %s" what (tyname loc other)
  in
  refuse_const_change ctx loc t;
  t

(* What append and insert were given to store: text, as a [const u8] and
   whether it is known valid, or a code point. *)
and string_piece ctx what (x : Ast.expr) =
  let loc = x.Ast.loc in
  let rune e =
    (match literal e with
     | Some c when c < 0L || c > 0x10ffffL || (c >= 0xd800L && c <= 0xdfffL) ->
       fail loc
         "%Ld is not a Unicode scalar value, so it has no UTF-8 encoding and \
          a String cannot hold it" c
     | _ -> ());
    `Rune e
  in
  match x.Ast.e with
  | Ast.Str lit ->
    if not (String.is_valid_utf_8 lit) then
      fail loc
        "this text is not valid UTF-8, and a String holds only valid UTF-8";
    let e = check ctx ~want:Types.String x in
    `Text (mk loc (Types.Slice (Types.Const, u8_ty)) (Tast.Prim (Tast.Bytes, [ e ])),
           true)
  | Ast.Int _ | Ast.Byte _ -> rune (check ctx ~want:(Types.Int Types.I32) x)
  | _ ->
    let e = check ctx x in
    match e.Tast.ty with
    | Types.String ->
      `Text (mk loc (Types.Slice (Types.Const, u8_ty)) (Tast.Prim (Tast.Bytes, [ e ])),
             false)
    | t when string_or_ptr t -> `Text (string_bytes ctx loc e, true)
    | Types.Int Types.I32 -> rune e
    | Types.Char -> rune (widen loc (Types.Int Types.I32) e)
    | Types.Int k when Types.widens_to ~from:(Types.Int k) ~into:(Types.Int Types.I32) ->
      rune (widen loc (Types.Int Types.I32) e)
    | Types.Int _ ->
      fail loc
        "a code point is an i32, and this is %s. Write %s"
        (tyname loc e.Tast.ty)
        (if fln_source loc then "i32(c)" else "(i32 c)")
    | Types.Slice (_, Types.Int Types.U8) ->
      fail loc
        "%s takes text, and bytes are not text until they are checked. \
         Write %s, which is checked when it is stored"
        what (if fln_source loc then "str(b)" else "(str b)")
    | other ->
      fail loc "%s takes a str, a String, a char or a code point, found %s" what
        (tyname loc other)

(* One allocating store into a String's Vec, under the retry guard, with the
   dev registry told of the block it ends up in — push's shape. Every argument
   is bound to a slot before the loop, so a retry re-attempts only the call. *)
and string_store ctx loc (v : Tast.expr) (binds : (int * Tast.expr) list)
    (checks : Tast.expr list) (attempt : Tast.expr) =
  mk loc Types.Unit
    (Tast.Let
       (binds,
        checks
        @ [ region_check ctx.env loc v
              (with_note loc (alloc_guard ctx loc attempt)
                 (reg_note loc "flan_dev_reg_note_vec" v [ size_of loc u8_ty ]
                    string_ty)) ]))

(* A text piece or a code point stored at byte offset [off] of the String's
   Vec [v], -1 for the end. *)
and string_put ctx loc (v : Tast.expr) (off : Tast.expr) piece =
  let i64 = Types.Int Types.I64 in
  let o = fresh_slot ctx i64 in
  let ov = mk loc i64 (Tast.Local o) in
  let at_end = match off.Tast.e with Tast.Int (-1L, _) -> true | _ -> false in
  match piece with
  | `Rune c ->
    let r = fresh_slot ctx (Types.Int Types.I32) in
    string_store ctx loc v [ (r, c); (o, off) ] []
      (rt loc (Types.Int Types.I8) "flan_string_put_rune"
         [ v; ov; mk loc (Types.Int Types.I32) (Tast.Local r); here loc ])
  | `Text (b, valid) ->
    let bty = Types.Slice (Types.Const, u8_ty) in
    let bs = fresh_slot ctx bty in
    let bv = mk loc bty (Tast.Local bs) in
    let checks =
      if valid then [] else [ rt loc Types.Unit "flan_utf8_check" [ bv; here loc ] ]
    in
    string_store ctx loc v [ (bs, b); (o, off) ] checks
      (if at_end then
         rt loc (Types.Int Types.I8) "flan_vec_append"
           [ v; bv; size_of loc u8_ty; align_of loc u8_ty; here loc ]
       else
         rt loc (Types.Int Types.I8) "flan_vec_insert"
           [ v; ov; bv; size_of loc u8_ty; align_of loc u8_ty; here loc ])

(* A character position as a byte offset, signalling BoundsError when it is
   not one. [past_end] admits the position after the last character. *)
and string_index ctx loc (v : Tast.expr) (i : Ast.expr) ~past_end =
  let i = index_expr ctx i in
  rt loc (Types.Int Types.I64) "flan_string_index"
    [ v; i; mk loc (Types.Int Types.I32)
         (Tast.Int ((if past_end then 1L else 0L), Types.I32));
      here loc ]

(* A prelude function by the name it was written under, which a program's
   own function of that name moves aside (see [shadow_prelude]). *)
and prelude_fn ctx name =
  let moved = "prelude~/" ^ name in
  if Hashtbl.mem ctx.env.fns moved then moved else name

(* Whether [name] is the prelude's own function. *)
and prelude_defined ctx name =
  match Hashtbl.find_opt ctx.env.fn_locs name with
  | Some at -> String.equal at.Loc.file Prelude.file
  | None -> false

(* A call to a prelude function that answers a String, its text arguments
   checked here, at the call the program wrote, before the call is made. The
   builders — (to-lower b), (join parts sep) — take bytes, and their answer is
   valid exactly when every piece of text they were given is (UTF-8 is
   self-synchronising, so a valid [from] matches a valid [s] only on
   character boundaries). Each builder also checks its own answer, the
   backstop for a builder reached through a function value; on this path that
   check has nothing left to find, and stops nobody at the prelude's line. *)
and prechecked_call ctx loc name ret (args : Tast.expr list) =
  let bytes = function
    | Types.Slice (_, Types.Int Types.U8) | Types.String -> true
    | _ -> false
  in
  let binds, checks, uses =
    List.fold_right
      (fun (a : Tast.expr) (bs, cs, us) ->
         let check =
           match a.Tast.ty with
           | t when bytes t -> Some "flan_utf8_check"
           | Types.Slice (_, t) when bytes t -> Some "flan_utf8_check_parts"
           | _ -> None
         in
         match check with
         | None -> (bs, cs, a :: us)
         | Some sym ->
           let sl = fresh_slot ctx a.Tast.ty in
           let v = mk a.Tast.loc a.Tast.ty (Tast.Local sl) in
           ((sl, a) :: bs, rt loc Types.Unit sym [ v; here loc ] :: cs, v :: us))
      args ([], [], [])
  in
  let call = mk loc ret (Tast.Call (name, uses)) in
  if checks = [] then call
  else mk loc ret (Tast.Let (binds, checks @ [ call ]))

(* Whether an operand is a String, read off what the operand is without
   checking it: a local or a global of that type, a call to a function that
   answers one, a field of that type, or one of the builtins that make one. A
   comparison asks this of every operand, so it must not walk them. *)
and peeks_string ctx (a : Ast.expr) =
  let rec ty (a : Ast.expr) =
    match a.Ast.e with
    | Ast.Var n ->
      (match lookup ctx n with
       | Some b -> Some b.bty
       | None ->
         (match Hashtbl.find_opt ctx.env.globals n with
          | Some (t, _) -> Some t
          | None -> None))
    | Ast.Call ({ Ast.e = Ast.Var ("string-new" | "bytes->string"); _ }, _) ->
      Some string_ty
    | Ast.Call ({ Ast.e = Ast.Var "deref"; _ }, [ p ]) ->
      (match ty p with Some (Types.Ptr (_, t)) -> Some t | _ -> None)
    | Ast.Call ({ Ast.e = Ast.Var f; _ }, _) ->
      (match Hashtbl.find_opt ctx.env.fns f with
       | Some (_, ret) -> Some ret
       | None -> None)
    | Ast.Field (t, name) ->
      (match ty t with
       | Some (Types.Named n | Types.Ptr (_, Types.Named n)) ->
         (match fields_named ctx.env n with
          | Some st ->
            (match Tast.field_index st name with
             | Some i -> Some (List.nth st.Tast.fields i).Tast.fty
             | None -> None)
          | None -> None)
       | _ -> None)
    | _ -> None
  in
  match ty a with Some t -> string_or_ptr t | None -> false

(* = and != over a String and a String or a str: the texts' bytes compared,
   through the str view each has, which is the comparison str already has.
   The orderings are refused as they are on a str, naming is-bytes-less. *)
and string_compare ctx ~want loc name p args =
  (match name with
   | "=" | "!=" -> ()
   | _ ->
     fail loc
       "%s orders machine numbers and enums, and a String is neither. Text is \
        ordered by its bytes with %s"
       name
       (if fln_source loc then "is-bytes-less(bytes-view(a), bytes-view(b))"
        else "(is-bytes-less (bytes-view a) (bytes-view b))"));
  let as_str (x : Ast.expr) =
    let e =
      match x.Ast.e with
      | Ast.Str _ -> check ctx ~want:Types.String x
      | _ -> check ctx x
    in
    match e.Tast.ty with
    | Types.String -> e
    | t when string_or_ptr t ->
      mk x.Ast.loc Types.String
        (Tast.Prim (Tast.StrOfBytes, [ string_bytes ctx x.Ast.loc e ]))
    | other ->
      fail x.Ast.loc "%s compares a String with a String or a str, found %s"
        name (tyname x.Ast.loc other)
  in
  let ops = List.map as_str args in
  let link u v = mk loc Types.Bool (Tast.Prim (p, [ u; v ])) in
  match ops with
  | [ a; b ] -> expect ctx loc ~want (link a b)
  | _ ->
    let pairs = if String.equal name "!=" then all_pairs else adjacent_pairs in
    expect ctx loc ~want (cmp_over ctx loc Types.String ~pairs ~link ops)

and string_call ctx ~want loc name args =
  let i64 n = mk loc (Types.Int Types.I64) (Tast.Int (n, Types.I64)) in
  match name, args with
  (* (string-new), (string-new text), (string-new a), (string-new text a):
     vec-new's shape, the text copied in — checked at run time when it is a
     str, since a str may hold any bytes. *)
  | "string-new", ([] | [ _ ] | [ _; _ ]) ->
    let text, a =
      match args with
      | [] -> None, allocator_arg ctx loc []
      | [ x ] ->
        (match x.Ast.e with
         | Ast.Str _ -> Some (string_piece ctx name x), allocator_arg ctx loc []
         | _ ->
           let e = check ctx x in
           if Types.equal e.Tast.ty Types.Alloc then None, use_alloc ctx loc e
           else
             (* Checked already, so classified from what it turned out to be
                and never checked a second time. *)
             let piece =
               match e.Tast.ty with
               | Types.String ->
                 `Text (mk loc (Types.Slice (Types.Const, u8_ty))
                          (Tast.Prim (Tast.Bytes, [ e ])), false)
               | t when string_or_ptr t -> `Text (string_bytes ctx loc e, true)
               | other ->
                 fail x.Ast.loc
                   "string-new takes a str or a String to copy, an allocator, \
                    or both, found %s" (tyname loc other)
             in
             Some piece, allocator_arg ctx loc [])
      | [ x; a ] ->
        let piece =
          match string_piece ctx name x with
          | `Rune _ ->
            fail x.Ast.loc "string-new copies a str or a String, not a code point"
          | p -> p
        in
        Some piece, allocator_arg ctx loc [ a ]
      | _ -> assert false
    in
    let sl = fresh_slot ctx string_ty in
    let s = mk loc string_ty (Tast.Local sl) in
    let v = vec_init ~note:string_ty ctx loc u8_ty a in
    let fill =
      match text with
      | None -> []
      | Some p -> [ string_put ctx loc (string_vec loc s) (i64 (-1L)) p ]
    in
    expect ctx loc ~want
      (mk loc string_ty
         (Tast.Let ([ (sl, mk loc string_ty (Tast.Make ("String", [ v ]))) ],
                    fill @ [ s ])))
  | "string-new", _ ->
    fail loc "string-new is (string-new), (string-new text), (string-new a) \
              or (string-new text a)"
  (* (bytes->string v) and (bytes->string v a): the bytes of a (Vec u8) copied
     into a new String once they are checked, here. A copy, because v — and
     any slice taken of it — could otherwise go on writing into the String's
     block; v is untouched and still the caller's to free.

     The prelude's builders are the one exception: each hands over a Vec
     nothing else can reach, so there the Vec becomes the String with no copy,
     still checked, and re-noted so a dev build's registry calls the block a
     String. *)
  | "bytes->string", (x :: rest) when List.length rest <= 1 ->
    let v = check ctx ~want:string_vec_ty x in
    if String.equal loc.Loc.file Prelude.file && rest = [] then begin
      let sl = fresh_slot ctx string_vec_ty in
      let vv = mk loc string_vec_ty (Tast.Local sl) in
      let view = vec_slice ctx ~want:None loc vv u8_ty [] in
      expect ctx loc ~want
        (mk loc string_ty
           (Tast.Let ([ (sl, v) ],
                      [ rt loc Types.Unit "flan_utf8_check" [ view; here loc ];
                        reg_note loc "flan_dev_reg_note_vec" vv
                          [ size_of loc u8_ty ] string_ty;
                        mk loc string_ty (Tast.Make ("String", [ vv ])) ])))
    end else begin
      let a = allocator_arg ctx loc rest in
      let src = fresh_slot ctx string_vec_ty in
      let view =
        vec_slice ctx ~want:None loc (mk loc string_vec_ty (Tast.Local src)) u8_ty []
      in
      let sl = fresh_slot ctx string_ty in
      let s = mk loc string_ty (Tast.Local sl) in
      let bytes = { view with Tast.ty = Types.Slice (Types.Const, u8_ty) } in
      expect ctx loc ~want
        (mk loc string_ty
           (Tast.Let
              ([ (src, v);
                 (sl, mk loc string_ty
                        (Tast.Make ("String", [ vec_init ~note:string_ty ctx loc u8_ty a ]))) ],
               [ string_put ctx loc (string_vec loc s) (i64 (-1L)) (`Text (bytes, false));
                 s ])))
    end
  | "bytes->string", _ ->
    fail loc "bytes->string is (bytes->string v) or (bytes->string v a), over a (Vec u8)"
  | "append", [ target; x ] ->
    let t = check_target ctx target in
    (match t.Tast.ty with
     (* A run of bytes onto a (Vec u8), or through a pointer to one: the
        prelude's builders' tool, and raw bytes, so nothing is checked. The
        runtime finds a run that lies inside the Vec's own block before it
        grows it, so (append (addr b) (slice b)) reads what it meant to. *)
     | Types.Vec (Types.Int Types.U8)
     | Types.Ptr (_, Types.Vec (Types.Int Types.U8)) ->
       let v =
         match t.Tast.ty with
         | Types.Ptr (_, ty) -> mk loc ty (Tast.Deref t)
         | _ -> t
       in
       refuse_const_change ctx loc v;
       note_grown ctx "append" loc v;
       let bty = Types.Slice (Types.Const, u8_ty) in
       let b = check ctx ~want:bty x in
       let bs = fresh_slot ctx bty in
       let attempt =
         rt loc (Types.Int Types.I8) "flan_vec_append"
           [ v; mk loc bty (Tast.Local bs); size_of loc u8_ty;
             align_of loc u8_ty; here loc ]
       in
       expect ctx loc ~want
         (mk loc Types.Unit
            (Tast.Let
               ([ (bs, b) ],
                [ region_check ctx.env loc v
                    (with_note loc (alloc_guard ctx loc attempt)
                       (reg_note loc "flan_dev_reg_note_vec" v
                          [ size_of loc u8_ty ] u8_ty)) ])))
     | ty when string_or_ptr ty ->
       let s = string_target ctx loc name t in
       let piece = string_piece ctx name x in
       expect ctx loc ~want (string_put ctx loc (string_vec loc s) (i64 (-1L)) piece)
     | other ->
       fail loc "append takes a String, or a (Vec u8) to add bytes to, found %s"
         (tyname loc other))
  | "insert", [ target; i; x ] ->
    let s = string_target ctx loc name (check_target ctx target) in
    let v = string_vec loc s in
    let piece = string_piece ctx name x in
    let off = string_index ctx loc v i ~past_end:true in
    expect ctx loc ~want (string_put ctx loc v off piece)
  | "remove", [ target; i ] ->
    let s = string_target ctx loc name (check_target ctx target) in
    let v = string_vec loc s in
    let off = string_index ctx loc v i ~past_end:false in
    expect ctx loc ~want
      (rt loc (Types.Int Types.I32) "flan_string_remove" [ v; off; here loc ])
  | "runes", [ x ] ->
    let b = text_bytes ctx name x in
    expect ctx loc ~want
      (mk loc (Types.Named "Runes") (Tast.Make ("Runes", [ b ])))
  | "rune-count", [ x ] ->
    let b = text_bytes ctx name x in
    expect ctx loc ~want
      (mk loc (Types.Int Types.I32) (Tast.Call (prelude_fn ctx "rune-count", [ b ])))
  | ("append" | "insert" | "remove" | "runes" | "rune-count"), _ ->
    let shape =
      match name with
      | "append" -> "(append s x)"
      | "insert" -> "(insert s i x)"
      | "remove" -> "(remove s i)"
      | "runes" -> "(runes s)"
      | _ -> "(rune-count s)"
    in
    fail loc "%s is %s" name shape
  | _ -> assert false

(* 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 ?(qualified = false) ctx ~want loc name args =
  let prim p ty args = expect ctx loc ~want (mk loc ty (Tast.Prim (p, args))) in
  match name with
  (* [builtin/length], before anything else including the shadowing guard below.
     The prefix is stripped and the same dispatch runs again with [qualified],
     which is the one thing the guard consults: a qualified call has said
     which of the two it means, so there is nothing left for shadowing to
     decide. Everything after this point sees the bare name, so an arity or a
     type refusal on [(builtin/length 1 2)] reads exactly as it does on
     [(length 1 2)] — which is the point of the spelling, not a loss of detail.

     Recursion rather than a flag threaded through the arms because there is
     only one thing to skip. It cannot loop: the stripped name has no second
     [builtin/] on it unless somebody wrote [builtin/builtin/length], which is
     stripped once and then refused by name. *)
  | _ when not qualified && qualified_builtin name <> None ->
    let bare = Option.get (qualified_builtin name) in
    if not (Hashtbl.mem builtin_set bare) then not_a_builtin loc bare;
    named_call ~qualified:true ctx ~want loc bare args
  (* The user's own definition, ahead of every builtin arm below — and behind
     the qualifier above, which is the one spelling it does not take over.
     Clojure's rule: a [(defn get ...)] takes the name over, and a call
     written in the program that defines it reaches that definition rather
     than the builtin it is named after. The defn site is warned about once
     (see [shadowed_builtins]); the call sites say nothing, because at a call
     site there is nothing surprising left — the name means what the file
     says it means.

     What this arm does NOT do is let one file's definition reach into
     another's: [shadows_builtin] answers false for a call in the prelude and
     for a call in imported package code, which is the same visibility rule a
     defn has everywhere else. *)
  | _ when (not qualified) && shadows_builtin ctx loc name ->
    ordinary_call ctx ~want loc name args
  (* .fln's [x ?? d] and [x!]; no .fln name can take them over. *)
  | "??" -> check_coalesce ctx ~want loc args
  | "?" -> check_present ctx ~want loc args
  | "!!" -> check_unwrap ctx ~want loc args
  (* ── arithmetic and comparison ─────────────────────────────────── *)
  (* (- x) negates, Clojure's rule. A literal operand is the negative literal,
     so it takes its type from the site as any literal does. A float is
     subtracted from -0.0, which is exact negation — 0.0 - 0.0 would answer
     +0.0 — and an integer from 0, which wraps as (- 0 x) does. *)
  | "-" when List.length args = 1 ->
    let x = List.hd args in
    (match x.Ast.e, literal_arith x with
     (* Integer arithmetic over literals alone negates to a literal, so
        [(- (- 1))] is the literal 1 and fits a u8. *)
     | _, Some n when n <> Int64.min_int ->
       check ctx ?want { Ast.e = Ast.Int (Int64.neg n); loc }
     | Ast.Float v, _ -> check ctx ?want { Ast.e = Ast.Float (-.v); loc }
     | _ ->
       let v = check ctx ?want:(numeric_want want) x in
       if v.Tast.ty = Types.Char then
         Loc.failk "check/char-arithmetic" x.Ast.loc
           "- does not negate a char. Take its code point with %s, and make a \
            char of one with %s"
           (if fln_source loc then "i32(c)" else "(i32 c)")
           (if fln_source loc then "char(n)" else "(char n)");
       if v.Tast.ty = Types.Dyn then
         expect ctx loc ~want (rt loc Types.Dyn "flan_dyn_neg" [ v; here loc ])
       else begin
         unconstrained ctx.env loc name ~needs:"is-numeric" v.Tast.ty;
         if not (Types.is_numeric v.Tast.ty || generic_ty v.Tast.ty) then
           not_numeric name "numbers" v;
         let zero =
           match v.Tast.ty with
           | Types.Float k -> mk loc v.Tast.ty (Tast.Float (-0.0, k))
           | ty -> int_literal loc ~want:(Some ty) ~preds:ctx.env.tvpreds 0L
         in
         expect ctx loc ~want (mk loc v.Tast.ty (Tast.Prim (Tast.Sub, [ zero; v ])))
       end)
  | "+" | "-" | "*" | "/" ->
    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 ~needs:"is-numeric" 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 ctx loc name 2 args;
    refuse_kept_when ctx name args;
    let a, b =
      char_operands ctx name args (fun () ->
          binary ctx ~dyn_ok:true name loc ~want:(numeric_want want) args)
    in
    if a.Tast.ty = Types.Dyn || b.Tast.ty = Types.Dyn then
      dyn_fold ctx ~want loc name [ a; b ] []
    else begin
    unconstrained ctx.env loc name ~needs:"is-numeric" a.Tast.ty;
    if not (Types.is_numeric a.Tast.ty || generic_ty a.Tast.ty) then
      not_numeric name "numbers" a;
    prim Tast.Rem a.Tast.ty [ a; b ]
    end
  | "=" | "!=" | "<" | "<=" | ">" | ">=" ->
    let p = match name with
      | "=" -> Tast.Eq | "!=" -> Tast.Ne | "<" -> Tast.Lt
      | "<=" -> Tast.Le | ">" -> Tast.Gt | _ -> Tast.Ge
    in
    fold_arity loc name args;
    let x, y, rest =
      match args with x :: y :: rest -> x, y, rest | _ -> assert false
    in
    refuse_kept_when ctx name args;
    if List.exists (fun a -> peeks_string ctx a) args then
      string_compare ctx ~want loc name p args
    else
    (* The first pair decides the type, and whether this is a dyn comparison
       at all, exactly as it does for the folding operators: [binary] joins
       the two, and every operand after them is checked against the answer.
       Past the first pair nothing widens, which is [fold_left_prim]'s rule
       and not a second one. *)
    let a, b =
      try binary ctx ~dyn_ok:true name loc ~want:None [ x; y ]
      with Loc.Error _ as ex ->
        (* A char beside an integer: said as the char's rule, not as the
           mismatch (decision 131). *)
        (* Neither a literal, whose own refusal already says what it is. *)
        (match
           if is_literal x || is_literal y then []
           else List.map (fun a -> trial ctx (fun () -> check ctx a)) [ x; y ]
         with
         | [ Ok a; Ok b ]
           when (a.Tast.ty = Types.Char && Types.is_integer b.Tast.ty)
                || (b.Tast.ty = Types.Char && Types.is_integer a.Tast.ty) ->
           let fln = fln_source loc in
           Loc.failk "check/char-compare" loc
             "%s compares a char only with a char, and this is %s beside it. \
              Take its code point with %s, or make a char with %s" name
             (tyname loc (if a.Tast.ty = Types.Char then b.Tast.ty else a.Tast.ty))
             (if fln then "i32(c)" else "(i32 c)")
             (if fln then "char(n)" else "(char n)")
         | _ -> raise ex)
    in
    (* Which pairs this operator asks about. Every one but [!=] chains, and
       [!=] asks about all of them — see [all_pairs]. At two operands the two
       readings are one pair and the same answer, which is why the two-operand
       path below is the same code it always was. *)
    let pairs = if String.equal name "!=" then all_pairs else adjacent_pairs in
    (* A comparison with a dyn operand answers a *bool*, not a dyn, even though
       the runtime's own entry point answers a dyn holding one. The reason is
       where the result goes: a comparison is overwhelmingly the test of an
       [if] or a [while], and those want an i1. So the need_bool is applied
       here, once, and a program that really wants the comparison as a dyn
       value boxes it again on the way into wherever it is going — which [box]
       does for free at that boundary.

       [=] and [!=] are the pair that never traps: the runtime compares
       structurally and answers false for values of unrelated types, because
       two things being unalike is the answer to "are these equal", not an
       error. The orderings do trap, and rightly — there is no true answer to
       whether a string is less than a vector. *)
    (* [ops] are every operand, not yet boxed. *)
    let dyn_chain ops =
      let sym =
        match name with
        | "=" | "!=" -> "flan_dyn_eq"
        | "<" -> "flan_dyn_lt" | "<=" -> "flan_dyn_le"
        | ">" -> "flan_dyn_gt" | _ -> "flan_dyn_ge"
      in
      (* [eq] traps only on a view whose storage is gone, and [dyn_eq] gives
         it the site for that; the four orderings trap on a mismatch, and get
         one, for the reason [dyn_fold] gives. Every pair of a chain gets the
         same site — the whole comparison is written at one place, and a trap
         from any of its pairs happened there. *)
      let site = if String.equal sym "flan_dyn_eq" then [] else [ here loc ] in
      (* [!=] has no entry point of its own: there is one structural equality
         and the negation is an [i1] flip the backend folds away. *)
      let link u v =
        let cmp =
          if String.equal sym "flan_dyn_eq" then dyn_eq loc u v
          else unbox loc Types.Bool (rt loc Types.Dyn sym ([ u; v ] @ site))
        in
        if String.equal name "!=" then
          mk loc Types.Bool (Tast.Prim (Tast.Not, [ cmp ]))
        else cmp
      in
      let ops =
        match rest with
        | [] -> [ a; b ]
        | _ -> ops ()
      in
      if not (String.equal sym "flan_dyn_eq") then no_bare_nil ops;
      let r =
        match List.map (box ~ctx loc) ops with
        | [ a; b ] -> link a b
        | ops -> cmp_over ctx loc Types.Dyn ~pairs ~link ops
      in
      expect ctx loc ~want r
    in
    if a.Tast.ty = Types.Dyn || b.Tast.ty = Types.Dyn then
      dyn_chain (fun () ->
          a :: b :: map_lr (fun e -> check ctx ~want:Types.Dyn e) rest)
    else begin
    (* [=] and [!=] admit types [<] does not. A handle is one: a pair of
       numbers in one word and where being 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. A string is the other,
       and for the opposite reason: being the same entity is not the question
       at all, being the same bytes is, and that has a true answer with no
       ordering attached — plan.org, Types calls out an ordering as a
       collation the language has not picked. Backend codegen (emit.ml,
       x86.ml) has a [Types.String] case in the [Eq]/[Ne] arm and nowhere
       else. A bool is the third: two values and no order between them. *)
    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 "=" | "!=" -> "is-equal" | _ -> "is-ordered")
      a.Tast.ty;
    if not (ok || generic_ty a.Tast.ty) then
      (match name with
       | "=" | "!=" ->
         fail loc
           "%s compares numbers, chars, enums, strings and bools, and %s \
            is none of those" name (tyname loc a.Tast.ty)
       | _ ->
         fail loc
           "%s orders machine numbers, chars and enums, and %s is none of \
            those" name
             (tyname loc a.Tast.ty));
    match rest with
    | [] -> prim p Types.Bool [ a; b ]
    | _ ->
      let ty = a.Tast.ty in
      let link u v = mk loc Types.Bool (Tast.Prim (p, [ u; v ])) in
      let rest = map_lr (fold_arg ctx ty) rest in
      (* A dyn past the first pair makes the whole chain the dyn runtime's,
         for [fold_operand]'s reason: a chain is its pairs, and a pair with a
         dyn in it is a dyn comparison. *)
      if List.exists (function `Dyn _ -> true | `Typed _ -> false) rest then
        dyn_chain (fun () ->
            a :: b :: List.map (function `Dyn d -> d | `Typed v -> v) rest)
      else
        let ops =
          a :: b :: List.map (function `Typed v -> v | `Dyn d -> d) rest in
        expect ctx loc ~want (cmp_over ctx loc ty ~pairs ~link ops)
    end
  | "not" ->
    arity ctx loc name 1 args;
    (* Same truthiness as [if]: a dyn argument is negated on nil/false vs.
       everything else, not narrowed to a strict bool first. *)
    prim Tast.Not Types.Bool [ check_truthy ctx (List.hd args) ]
  (* Bitwise operators are integers-only. They take the ordinary join — an
     operand that widens into the other does, so (bit-and u8-flags u32-mask) is
     a u32 and — and the shifts below do not, which is the one carve-out
     widening has (TODO.org, "Implicit numeric widening is legal;
     narrowing stays a hard error"). *)
  | "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;
    bool_operands ctx name args;
    fold_left_prim ctx ~want loc name p ~needs:"is-integer" Types.is_integer
      "integers" args
  (* The .fln operators, which the indented reader already spells as the words
     above; a form built some other way may still carry them. [~qualified]
     skips the shadowing arm, because a program that means its own [&&] has
     been answered by that arm already under this name. *)
  | "&&" | "||" | "^^" | "~~" ->
    let canon = match name with
      | "&&" -> "bit-and" | "||" -> "bit-or" | "^^" -> "bit-xor"
      | _ -> "bit-not"
    in
    named_call ~qualified:true ctx ~want loc canon args
  | "bit-not" | "popcount" | "leading-zeros" | "trailing-zeros" ->
    arity ctx loc name 1 args;
    bool_operands ctx name args;
    let v = check ctx ?want:(numeric_want want) (List.hd args) in
    if v.Tast.ty = Types.Dyn then
      expect ctx loc ~want (rt loc Types.Dyn (dyn_bits_sym name) [ v; here loc ])
    else begin
      bits_operand ctx loc name v;
      let p = match name with
        | "bit-not" -> Tast.BitNot | "popcount" -> Tast.Popcount
        | "leading-zeros" -> Tast.Clz | _ -> Tast.Ctz
      in
      prim p v.Tast.ty [ v ]
    end
  (* 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.

     [~join:false] is the one place widening is deliberately not symmetric.
     The count still widens *to* the value's type — (<< i64-x u8-n) is fine —
     but the value never widens to the count's, which the general rule would do
     for (<< u8-x i32-n). It would be the wrong answer twice over: the result's
     type and the width the shift wraps at would be taken from a number that is
     only saying how far, and the range check just below, along with [emit]'s
     mask, is keyed to the *value's* width. A count wider than the value is
     refused and is told to write the cast.

     The rotations share the rule and not the range check: a rotation by the
     width is the value unchanged, so every count means something and is taken
     modulo the width. *)
  | "<<" | ">>" | "rotate-left" | "rotate-right" ->
    let p = match name with
      | "<<" -> Tast.Shl | ">>" -> Tast.Shr | "rotate-left" -> Tast.Rotl
      | _ -> Tast.Rotr
    in
    arity ctx loc name 2 args;
    bool_operands ctx name args;
    let a, b =
      binary ctx ~dyn_ok:true ~join:false name loc ~want:(numeric_want want) args
    in
    if a.Tast.ty = Types.Dyn || b.Tast.ty = Types.Dyn then begin
      (* The typed side of a mixed pair still has to be an integer: the dyn
         half is asked at run time, and this half can be asked now. *)
      List.iter
        (fun (v : Tast.expr) ->
           if v.Tast.ty <> Types.Dyn then bits_operand ctx v.Tast.loc name v)
        [ a; b ];
      no_bare_nil [ a; b ];
      expect ctx loc ~want
        (rt loc Types.Dyn (dyn_bits_sym name) [ box ~ctx loc a; box ~ctx loc b; here loc ])
    end else begin
    bits_operand ctx loc name a;
    (* 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
           (tyname loc a.Tast.ty) (Types.bits k)
     | _ -> ());
    prim p a.Tast.ty [ a; b ]
    end
  (* (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 ~dyn_ok:true name loc ~want:(numeric_want want) [ x; y ] in
    if a.Tast.ty = Types.Dyn || b.Tast.ty = Types.Dyn then
      dyn_fold ctx ~want loc name [ a; b ] rest
    else begin
    (* [min] and [max] are [<] with a pick, so [is-ordered] is what they want —
       not [is-numeric]. A generic that declares [is-ordered] gets both.

       They stay builtins now that generics could express them, and the reason
       is the two lines above rather than the type system: they are variadic,
       and each step puts both of its sides in slots so that every operand is
       evaluated exactly once. A prelude [(defn min [a $t b $t] $t ...)] would
       be binary and would have to be nested at the call site, which is where
       the double evaluation this arm exists to prevent would come back. The
       generic half is already theirs — [is-ordered] admits them inside any
       body that declares it — so collapsing them would cost the arity and
       the evaluation rule and buy nothing. *)
    unconstrained ctx.env loc name ~needs:"is-ordered" a.Tast.ty;
    (* A char orders, so it has a least and a greatest too. *)
    if not (Types.is_numeric a.Tast.ty || a.Tast.ty = Types.Char
            || generic_ty a.Tast.ty) then
      not_numeric name "numbers" a;
    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
    let rec steps acc = function
      | [] -> expect ctx loc ~want acc
      | arg :: tl ->
        match fold_arg ctx ty arg with
        | `Typed v -> steps (pick acc v) tl
        | `Dyn d -> dyn_fold ctx ~want loc name [ acc; d ] tl
    in
    steps (pick a b) rest
    end
  (* A type handed to the prelude's slice reductions: the reach for the
     type-limit constants under the name of the reduction beside them. *)
  | ("max-of" | "min-of")
    when (not (shadows_builtin ctx loc name))
         && (match args with [ a ] -> type_arg ctx a | _ -> false) ->
    let which = if String.equal name "max-of" then "max-value" else "min-value" in
    fail loc
      "%s reduces a slice to its %s element, and this is a type — the %s value \
       of a type is (%s %s)"
      name (if which = "max-value" then "largest" else "least")
      (if which = "max-value" then "largest" else "least") which
      (spell_arg "i32" (List.hd args))
  (* (max-value T) and (min-value T): the type-limit constants, by type, so a
     generic body can name its own type's. Odin's max(T) and min(T), and the
     same answer for a float: the largest finite value and its negation, not
     the smallest positive one. *)
  | "max-value" | "min-value" ->
    arity ctx loc name 1 args;
    if not (type_arg ctx (List.hd args)) then
      fail (List.hd args).Ast.loc "%s takes a type, as in (%s i32)" name name;
    let a = List.hd args in
    let ty =
      match type_of_expr ~generic:(Hashtbl.mem ctx.env.gstructs) a, a.Ast.e with
      | Some t, _ -> resolve ctx.env t
      | _, Ast.Var n -> resolve_name ctx.env ~seen:[] a.Ast.loc n
      | _ -> fail a.Ast.loc "internal: %s's type argument is not a type" name
    in
    let max = String.equal name "max-value" in
    let v =
      match ty with
      | Types.Int k ->
        let b = Types.bits k in
        let n =
          if Types.signed k then
            let top = Int64.shift_left 1L (b - 1) in
            if max then Int64.sub top 1L else Int64.neg top
          else if not max then 0L
          else if b = 64 then -1L
          else Int64.sub (Int64.shift_left 1L b) 1L
        in
        mk loc ty (Tast.Int (n, k))
      | Types.Float k ->
        let m =
          match k with
          | Types.F32 -> Int32.float_of_bits 0x7f7fffffl
          | Types.F64 -> Float.max_float
        in
        mk loc ty (Tast.Float ((if max then m else -.m), k))
      | Types.Var v ->
        if not (declares ctx.env.tvpreds v "is-numeric") then
          Loc.failk "check/unconstrained-type-variable" a.Ast.loc
            "%s is a limit of a numeric type, and nothing declares $%s \
             numeric — write {:where (is-numeric $%s)} at the head of the body"
            name v v;
        int_literal loc ~want:(Some ty) ~preds:ctx.env.tvpreds 0L
      | _ ->
        fail a.Ast.loc
          "%s takes a numeric type (is-numeric), and %s is not one — as in (%s i32)" name
          (tyname loc ty) name
    in
    expect ctx loc ~want v
  (* (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 ctx 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, or name it, as in (the [4 i32] (zeroed))")

  (* [zeroed]'s two siblings, and the same shape exactly: a value of whatever
     type is expected of it, so [(set grid (filled 0xFF))] is how a place is
     filled and there is no second spelling to learn. What they add over
     [zeroed] is the bytes — [(filled b)] repeats one the program picks, and
     [(dead-beef)] repeats four — and with them the question [zeroed] never
     has to ask: zero is a value every type can have, and 0xDE is not.
     [unfillable] above is the whole of the answer.

     [dead-beef] takes the pattern or leaves it out, and leaving it out is
     defined as writing the default: the [None] arm below builds the same
     literal the source would have, so [(dead-beef)] and
     [(dead-beef 0xDEADBEEF)] are the same node by construction and no
     backend has a second path for the bare form.

     The pattern is an ordinary u32 expression, which is the byte arm's rule
     at four times the width — a literal out of range meets [in_range]'s
     located "does not fit in u32", and anything computed is guaranteed by
     its type instead. Both builtins take a value rather than only a literal
     for the same reason: refusing one would be a restriction with no
     mechanism behind it, since neither backend needs the number early. *)
  | "filled" | "dead-beef" ->
    let is_byte = String.equal name "filled" in
    if is_byte then arity ctx loc name 1 args
    else if List.length args > 1 then
      fail loc "%s takes the pattern or nothing at all, given %d arguments"
        name (List.length args);
    (match want with
     | Some ty when ty <> Types.Never ->
       (match unfillable ctx.env [] ty with
        | Some bad ->
          Loc.failk "check/fill-not-plain-data" loc
            "%s writes raw bytes over %s, and %s is not plain data — %s. \
             Fill only numbers and pointers, and structs, unions and fixed \
             arrays built out of them"
            name (tyname loc ty)
            (if Types.equal bad ty then "it" else tyname loc bad)
            (match bad with
             | Types.Dyn ->
               "a dyn is one word the collector walks by descriptor, and a \
                filled one is a root pointing at nothing"
             | Types.Vec _ | Types.Map _ | Types.Alloc ->
               "it owns its storage through a pointer and an allocator, and \
                a filled header frees a wild address"
             | Types.String | Types.Slice _ ->
               "it is a pointer and a length every bounds check believes"
             | Types.Bool ->
               "a bool is an i1 to LLVM and a whole byte to the x86 backend, \
                so a filled one would not even agree with itself across the \
                two"
             | Types.Option _ ->
               "it carries a tag saying whether the value is there, and a \
                filled one says yes over a payload nobody wrote"
             | Types.Fn _ | Types.CFn _ ->
               "it is a code address, and a call through a filled one jumps \
                into whatever 0xDE bytes happen to address"
             | Types.Named n when Hashtbl.mem ctx.env.datas n ->
               "it carries a tag that names a case, and no byte pattern \
                names a real one"
             | Types.Enum _ ->
               "an enum's values are the members it declared, and no byte \
                pattern is one of them"
             | _ ->
               "it is not one of the types this rule admits")
        | None -> ());
       if is_byte then
         let b = check ctx ~want:(Types.Int Types.U8) (List.hd args) in
         mk loc ty (Tast.Fill (ty, b))
       else
         let pat =
           match args with
           | [ a ] -> check ctx ~want:(Types.Int Types.U32) a
           (* The bare form, written out. Not a default a backend applies:
              the node that leaves here is the one the spelled-out call would
              have left, which is what makes the equivalence a fact about the
              IR rather than a promise two emitters keep separately.

              Masked to 32 bits, and that is the whole of why this is not
              [Int64.of_int32] on its own: [dead_beef_default] is an [int32]
              whose top bit is set, so widening it signed would put
              -559038737 on a node tagged [u32] — where the same pattern
              *written out* arrives as 3735928559, because [in_range] admits
              it as the unsigned value it is. Two spellings of one builtin
              would then carry two different payloads, and "the same node by
              construction" would be false for anything that reads one. *)
           | _ ->
             mk loc (Types.Int Types.U32)
               (Tast.Int
                  (Int64.logand
                     (Int64.of_int32 Tast.dead_beef_default) 0xFFFFFFFFL,
                   Types.U32))
         in
         mk loc ty (Tast.DeadBeef (ty, pat))
     | _ ->
       fail loc
         "%s needs to know the type it is filling — use it where one is \
          expected, or name it, as in (the [4 u32] (%s))"
         name (if is_byte then "filled 0xFF" else name))

  (* 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
       lit_typed_use ctx target;
       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) (tyname loc 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) (tyname loc 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 not known \
             until the program runs, so nothing here can check it has %Ld \
             element%s. Use %s and test %s yourself"
            (tyname loc target.Tast.ty) n (plural n)
            (if fln_source loc then "s[i]" else "(at s i)")
            (if fln_source loc then "length(s)" else "(length s)")
        | other ->
          fail loc
            "%s is not a fixed array, so [a b ...] cannot destructure it"
            (tyname loc 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 TODO.org's "The escape was real: a value the compiler builds trips
     no function-value refusal" 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. It was diagnosed as needing "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 — use (arena-new ...) \
       with a backing buffer"
  | "heap-allocator" ->
    arity ctx loc name 0 args;
    expect ctx loc ~want
      (seal_alloc ctx loc (rt loc raw_alloc "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 ctx loc name 1 args;
    let cap = check ctx ~want:(Types.Int Types.I64) (List.hd args) in
    expect ctx loc ~want
      (seal_alloc ctx loc (rt loc raw_alloc "flan_arena_new" [ cap ]))
  (* Hands the pages back, which [free-all] deliberately does not — see
     TODO.org, "Allocators, (Vec T) and StorageExhausted". *)
  | "arena-destroy" ->
    arity ctx loc name 1 args;
    let a = alloc_value ctx loc (List.hd args) in
    expect ctx 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-temp" ->
    arity ctx loc name 0 args;
    expect ctx loc ~want (rt loc Types.Unit "flan_free_temp" [])
  | "free-all" ->
    arity ctx loc name 1 args;
    let a = alloc_value ctx loc (List.hd args) in
    expect ctx 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 the call this made. *)
  | "can-free" ->
    arity ctx loc name 1 args;
    let a = alloc_value ctx loc (List.hd args) in
    expect ctx 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 ctx loc name 1 args;
    let a = alloc_value ctx loc (List.hd args) in
    expect ctx 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 ctx loc name 1 args;
    let a = alloc_value ctx loc (List.hd args) in
    expect ctx 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 ctx loc name 1 args;
    let a = alloc_value ctx loc (List.hd args) in
    expect ctx 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 ctx loc name 1 args;
    let a = alloc_value ctx loc (List.hd args) in
    expect ctx loc ~want
      (mk loc (Types.Int Types.I64)
         (Tast.Prim (Tast.Rt "flan_alloc_budget", [ a ])))
  | "set-alloc-budget" ->
    arity ctx loc name 2 args;
    (match args with
     | [ a; n ] ->
       let a = alloc_value ctx loc a in
       let n = check ctx ~want:(Types.Int Types.I64) n in
       expect ctx 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 ctx loc name 1 args;
    let a = alloc_value ctx loc (List.hd args) in
    expect ctx 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 ->
       (* Two values in this frame, handed to the runtime by address: the one
          to install, checked here so a stale one traps at this site, and the
          room for the one it displaces, so the restore puts that back with
          its incarnation (flan_rt.c, flan_context_set). *)
       let a =
         let pair = Types.Array (2L, Types.Alloc) in
         let s = fresh_slot ctx pair in
         let first = addr_of loc (mk loc pair (Tast.Local s)) in
         mk loc raw_alloc
           (Tast.Let
              ([ (s, mk loc pair
                        (Tast.Arr [ check ctx ~want:Types.Alloc a;
                                    mk loc Types.Alloc (Tast.Zero Types.Alloc) ])) ],
               [ rt loc raw_alloc "flan_alloc_use" [ first; here loc ];
                 addr_of loc (mk loc pair (Tast.Local s)) ]))
       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 ctx 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 defonce'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
    (* [(vec-new dyn)] is not a [(Vec dyn)]. At milestone 1 the heterogeneous
       container is the dyn runtime's own object, and its type is [dyn] like
       everything else the runtime hands back — which is what lets [push], [at]
       and [length] on it go through the dyn operations rather than through a
       type-erased Vec over eight-byte elements.

       The two could be made to coincide later, and the reason not to now is
       the collector: a Flan Vec's storage comes from an allocator the program
       named, and the words in it would be roots the collector has to find
       inside a block it does not own. The runtime's own vector is storage the
       collector already knows about. *)
    if elem = Types.Dyn then begin
      if args <> [] then
        fail loc
          "(vec-new dyn) takes no allocator — its storage is the dyn \
           runtime's";
      expect ctx loc ~want (rt loc Types.Dyn "flan_dyn_vec_new" [])
    end else
      expect ctx loc ~want (vec_init ctx loc elem (allocator_arg ctx loc args))
  (* Unit, not a Result and not an ignorable error code: see [alloc_guard]. *)
  | "push" ->
    arity ctx loc name 2 args;
    (match args with
     | [ target; x ] ->
       let target = check_target ctx target in
       refuse_const_change ctx loc target;
       (* A push into a dyn container is a call and nothing else: no allocation
          guard, no restart, no region check. The dyn runtime owns the storage
          and answers a failure to grow it on its own terms — the guard and the
          retry restart exist for an allocator the *program* named, and here
          there is none to name. *)
       if target.Tast.ty = Types.Dyn then
         expect ctx loc ~want
           (rt loc Types.Unit "flan_dyn_push"
              [ target; check ctx ~want:Types.Dyn x; here loc ])
       else begin
       let elem = vec_elem loc "push" target.Tast.ty in
       note_grown ctx "push" loc target;
       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 TODO.org's "The
          allocation registry" settles on, and
          the settled answer to what it costs is "measure a real program". *)
       expect ctx 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)) ])))
       end
     | _ -> assert false)
  | "reserve" ->
    arity ctx loc name 2 args;
    (match args with
     | [ target; n ] ->
       let target = check_target ctx target in
       refuse_const_change ctx loc target;
       let n = check ctx ~want:index_ty n in
       note_grown ctx "reserve" loc target;
       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 ctx 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 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 ctx loc ~want
         (region_check ctx.env loc target
            (with_note loc (alloc_guard ctx loc attempt) note))
     | _ -> assert false)
  (* 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" ->
    (match args with
     | [ _ ] | [ _; _ ] -> ()
     | _ -> fail loc "free is (free v), or (free s allocator) for a slice");
    let target = check_target ctx (List.hd args) in
    refuse_const_change ctx loc target;
    (match target.Tast.ty, args with
     | (Types.Vec _ | Types.Map _), [ _; _ ] ->
       fail loc
         "a %s knows the allocator it came from, so free takes only the \
          container. Write (free %s)"
         (tyname loc target.Tast.ty) (spell_arg "v" (List.hd args))
     | _ -> ());
    (* 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
     | t when is_string_ty t ->
       (match args with
        | [ _; _ ] ->
          fail loc
            "a String knows the allocator it came from, so free takes only \
             the String. Write %s"
            (if fln_source loc then "free(" ^ spell_arg "s" (List.hd args) ^ ")"
             else "(free " ^ spell_arg "s" (List.hd args) ^ ")")
        | _ -> ());
       expect ctx loc ~want
         (rt loc Types.Unit "flan_vec_free"
            [ string_vec loc target; size_of loc u8_ty; align_of loc u8_ty;
              here loc ])
     | (Types.Vec _ | Types.Map _)
       when region_only ctx.env target.Tast.ty ->
       fail loc
         "%s holds elements that own storage, and free releases only the \
          block those elements sit in. Write (free-all a) on the region it \
          was built against"
         (tyname loc target.Tast.ty)
     | Types.Vec elem ->
       expect ctx 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 ctx loc ~want
         (rt loc Types.Unit "flan_map_free"
            [ target; size_of loc k; size_of loc v; here loc ])
     (* A slice (bytes s) or (clone xs) answered: its block goes back to the
        allocator it came from, which a slice does not carry — so it is the
        context allocator, as Odin's delete defaults to, or the one named. A
        dev build checks the block against the allocation registry and traps
        on a slice that is not the start of a block, or on the wrong
        allocator, instead of handing one allocator another's block. *)
     | Types.Slice (Types.Const, _) ->
       fail loc
         "%s can only be read, so it cannot be freed. Free the [%s] it was \
          copied into"
         (tyname loc target.Tast.ty)
         (match target.Tast.ty with
          | Types.Slice (_, e) -> tyname loc e
          | t -> tyname loc t)
     (* A view written right here — (slice ...) or (slice-from ...) —
        is storage something else owns, known without running anything. *)
     | Types.Slice (Types.Mut, _)
       when (match (List.hd args).Ast.e with
             | Ast.Call ({ Ast.e = Ast.Var ("slice" | "slice-from"); _ }, _) ->
               true
             | _ -> false) ->
       fail loc
         "this is a view of storage something else owns, so it cannot be \
          freed. Only a slice (bytes s) or (clone xs) made can be"
     | Types.Slice (Types.Mut, elem) ->
       let a = allocator_arg ctx loc (List.tl args) in
       expect ctx loc ~want
         (rt loc Types.Unit "flan_slice_free"
            [ target; size_of loc elem; align_of loc elem; a; 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 a Vec, a Map, or a slice (bytes s) or (clone xs) made — \
          found %s"
         (tyname loc other))
  (* Emitted by the prelude's [into] when no (map f) is in the chain, so that
     every element pushed is a source element as it stands. A push copies an
     element's header, and for an element that owns storage the copy and the
     source then share one block: growing an element through either side
     reallocates it and frees the block the other still points at. That is a
     use after free the program never wrote, under a name that promised a
     copy, so it is refused here. A bare (push w (at v 0)) is not: it copies a
     header in plain sight, the Odin contract every container follows.
     Arguments are the source, then the destination and the transforms as
     written — those two only to be spelled back in the fix, never checked. *)
  | "into-copies-elements" ->
    (match args with
     | src :: dst :: transforms ->
       let s = check ctx src in
       let elem =
         match s.Tast.ty with
         | Types.Vec e | Types.Slice (_, e) | Types.Array (_, e) -> Some e
         | _ -> None
       in
       (match elem with
        | Some e when owning ctx.env e ->
          let v = spell_arg "v" src in
          let et = tyname loc e in
          let fix =
            if clone_accepts ctx.env e then
              match spell_form dst, List.map spell_form transforms with
              | Some d, ts when not (List.mem None ts) ->
                Printf.sprintf
                  "Add (map clone) to the chain, which copies what each \
                   element owns: (into %s)"
                  (String.concat " "
                     ((v :: d :: List.filter_map Fun.id ts) @ [ "(map clone)" ]))
              | _ ->
                "Add (map clone) to the chain, which copies what each element \
                 owns"
            else
              Printf.sprintf
                "Nothing copies what a %s owns, so no copy of %s can stand on \
                 its own: read the elements where they are, or build each new \
                 element and push that"
                et v
          in
          Loc.failk "check/into-shares-elements" src.Ast.loc
            "into copies each element of %s as it stands, and an element of \
             %s is a %s, which owns storage — the copy would share each \
             element's block with %s, and growing either one frees the block \
             the other points at. %s"
            v v et v fix
        | _ -> ());
       expect ctx loc ~want (mk loc Types.Unit Tast.Unit)
     | _ -> expect ctx loc ~want (mk loc Types.Unit Tast.Unit))
  (* (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 ->
       lit_typed_use ctx target;
       (* 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_target ctx target in
       let a = allocator_arg ctx loc rest in
       (match target.Tast.ty with
        (* A String's copy is a copy of its bytes, which are valid already. *)
        | t when is_string_ty t ->
          let v = string_vec loc target in
          let d = fresh_slot ctx string_vec_ty in
          let attempt =
            rt loc (Types.Int Types.I8) "flan_vec_clone"
              [ mk loc string_vec_ty (Tast.Local d); v; a;
                size_of loc u8_ty; align_of loc u8_ty; here loc ]
          in
          expect ctx loc ~want
            (mk loc string_ty
               (Tast.Make
                  ("String",
                   [ mk loc string_vec_ty
                       (Tast.Let ([ (d, mk loc string_vec_ty (Tast.Zero string_vec_ty)) ],
                                  [ with_note loc (alloc_guard ctx loc attempt)
                                      (reg_note loc "flan_dev_reg_note_vec"
                                         (mk loc string_vec_ty (Tast.Local d))
                                         [ size_of loc u8_ty ] string_ty);
                                    mk loc string_vec_ty (Tast.Local d) ])) ])))
        (* 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 — its elements own storage, and nothing here \
             can walk one to copy what it owns. %s"
            (tyname loc target.Tast.ty)
            (insert_copies ~loc:target.Tast.loc ctx.env target.Tast.ty)
        (* A slice's elements, copied into a block from the allocator and
           answered as a slice over it — what (bytes s) does for a string's
           bytes, and the same lowering. The same refusal as a Vec's, for the
           same reason: a copy of owning elements is a copy of their headers. *)
        | Types.Slice (_, elem) when owning ctx.env elem ->
          fail loc
            "%s cannot be cloned — its elements own storage, and nothing here \
             can walk one to copy what it owns. %s"
            (tyname loc target.Tast.ty)
            (insert_copies ~loc:target.Tast.loc ctx.env target.Tast.ty)
        (* The copy is a block from an allocator, which the collector does not
           walk, so a dyn in it would be a root nothing marks. *)
        | Types.Slice (_, elem) when holds_dyn ctx.env elem ->
          fail loc
            "%s cannot be cloned — its elements hold a dyn, and the copy would \
             live in allocator storage the collector does not look in. Build \
             a dyn vector from the elements instead"
            (tyname loc target.Tast.ty)
        | Types.Slice (_, elem) ->
          expect ctx loc ~want (dup_elems ctx loc elem target a)
        (* 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 ctx 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 ctx 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 ctx 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)")

  (* ── String, the prelude's owned text ─────────────────────────────
     Each is [string_call]'s, which says what each one checks. *)
  | "string-new" | "bytes->string" | "append" | "insert" | "remove" ->
    string_call ctx ~want loc name args
  | "runes" | "rune-count" ->
    string_call ctx ~want loc name args

  (* ── (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 defonce'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 ctx 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 ctx loc name 3 args;
    (match args with
     | [ target; k; v ] ->
       let target = check_target ctx target in
       refuse_const_change ctx loc target;
       (* A put into a dyn map is a call and nothing else, the way a push into
          a dyn vec is: the runtime owns the storage, so there is no guard, no
          restart and no region check. An equal key's value is replaced. The
          site rides along for the one refusal a put can meet, a class
          instance's typed slot. *)
       if target.Tast.ty = Types.Dyn then
         expect ctx loc ~want
           (rt loc Types.Unit "flan_dyn_map_put"
              [ target; check ctx ~want:Types.Dyn k;
                check ctx ~want:Types.Dyn v; here loc ])
       else begin
       let kt, vt = map_kv loc "put" target.Tast.ty in
       note_grown ctx "put" loc target;
       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 ctx 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 ctx 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)) ])))
       end
     | _ -> 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" ->
    (match args with
     | target :: (_ :: _ :: _ as idx) ->
       (* Two indices or more: an array, a slice or a Vec, one per
          dimension, or a dyn walked a level per index. A map takes one key. *)
       let target = check_target ctx target in
       (match target.Tast.ty with
        | Types.Map _ ->
          fail loc "a map's get takes one key, as (get m k), and this has %d"
            (List.length idx)
        | Types.Named "String" ->
          (ignore (refuse_string_index (List.hd idx).Ast.loc ~store:false); assert false)
        | Types.Dyn -> dyn_get ctx ~want loc target idx
        | _ -> checked_get ctx ~want loc target idx)
     | [ target; k ] ->
       let target = check_target ctx target in
       (match target.Tast.ty with
        | Types.Array _ | Types.Slice _ | Types.String | Types.Vec _ ->
          checked_get ctx ~want loc target [ k ]
        (* The same refusal [at] gives: a String is not indexed. *)
        | Types.Named "String" -> (ignore (refuse_string_index k.Ast.loc ~store:false); assert false)
        | Types.Dyn -> dyn_get ctx ~want loc target [ k ]
        | _ ->
       (* A dyn map's absence is nil, not None: the typed map can promise an
          (Option V) because V was written down, and a dyn map has nothing to
          write. nil is an ordinary dyn value the caller compares against —
          and (contains? m k) is the question to ask when nil might also be
          stored under the key. *)
       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 ctx loc ~want (mk loc (Types.Option vt) Tast.None_)
       else
       map_lookup ctx ~want loc "flan_map_get" target kt vt k)
     | _ -> arity ctx loc name 2 args; assert false)

  (* (keyword s) -> the interned dyn keyword named by the bytes, for a name
     that only exists at run time — a reader building :texture-path out of a
     token's text. A literal :foo never comes through here. *)
  | "keyword" ->
    arity ctx loc name 1 args;
    (match args with
     | [ s ] ->
       let s = check ctx s in
       (match s.Tast.ty with
        | Types.String | Types.Slice (_, (Types.Int Types.U8)) ->
          expect ctx loc ~want (rt loc Types.Dyn "flan_dyn_kw" [ s ])
        | other ->
          fail loc "keyword takes a string or a [u8], found %s"
            (tyname loc other))
     | _ -> assert false)

  (* (class-of v) -> the class's name as a keyword, or nil. It is the dyn
     side's one question about shape, and the dispatch a (defgeneric ...)
     compiles to is this call and a comparison — so what a class dispatcher
     is, exactly, is the shape tag of the first argument as the dispatch
     function, which is what makes the CLOS half and the Clojure half one
     mechanism rather than two.

     Anything that is not an instance answers nil rather than trapping: an
     ordinary map, a number, nil itself. Asking is not a claim, and the
     question is askable of every value — the same line [get] takes about an
     absent key. *)
  | "class-of" ->
    arity ctx loc name 1 args;
    (match args with
     | [ v ] ->
       expect ctx loc ~want
         (rt loc Types.Dyn "flan_dyn_class_of" [ check ctx ~want:Types.Dyn v ])
     | _ -> assert false)

  (* (type-of v) -> the value's kind as a keyword, or a class instance's
     class name. A typed argument crosses into dyn first, as it does for
     class-of and every other dyn builtin, so it answers the kind the crossing
     makes of it: a typed i32 is :int and an f32 is :float. That keeps one
     answer per value whichever side of the program holds it. *)
  | "type-of" ->
    arity ctx loc name 1 args;
    (match args with
     | [ v ] ->
       expect ctx loc ~want
         (rt loc Types.Dyn "flan_dyn_type_of" [ check ctx ~want:Types.Dyn v ])
     | _ -> assert false)

  (* (chars t) and (text x): a dyn text as a vec of its chars, and back. A
     dyn text is immutable, so a vec of chars is how one is edited. *)
  | "chars" | "text" ->
    arity ctx loc name 1 args;
    let sym = if name = "chars" then "flan_dyn_chars" else "flan_dyn_text" in
    expect ctx loc ~want
      (rt loc Types.Dyn sym
         [ check ctx ~want:Types.Dyn (List.hd args); here loc ])

  (* (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 ctx loc name 2 args;
    (match args with
     | [ target; k ] ->
       let target = check_target ctx target in
       refuse_const_change ctx loc target;
       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 ctx loc ~want (mk loc (Types.Option vt) Tast.None_)
       else
       map_lookup ctx ~want loc "flan_map_remove" target kt vt k
     | _ -> 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))
           ...))

     The prelude's map-keys and map-values are this loop over a generic key.

     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 m cur k) walks the keys alone. It is what lets a walk need no
     place for a value, which matters when the value is a function value: one
     cannot be zeroed to make the place, and a key never is one. *)
  | "map-next" ->
    (match args with
     | [ _; _; _ ] | [ _; _; _; _ ] -> ()
     | _ ->
       fail loc
         "map-next is (map-next m (addr cursor) (addr k) (addr v)) or, for \
          the keys alone, (map-next m (addr cursor) (addr k)) — given %d \
          arguments" (List.length args));
    (match args with
     | target :: cur :: k :: rest ->
       let target = check_target ctx target in
       let kt, vt = map_kv loc "map-next" target.Tast.ty in
       let cur = check ctx ~want:(Types.Ptr (Types.Mut, (Types.Int Types.I64))) cur in
       let k = check ctx ~want:(Types.Ptr (Types.Mut, kt)) k in
       let vp = Types.Ptr (Types.Mut, vt) in
       let v = match rest with
         | [ v ] -> check ctx ~want:vp v
         | _ -> mk loc vp (Tast.Zero vp)
       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 ctx 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 ctx loc name 2 args;
    (match args with
     | [ target; k ] ->
       let target = check_target ctx target in
       (* The dyn map's question, one word with the typed one. It exists on
          the dyn side because absence there is nil, and a map can also store
          nil under a key — (get m k) answering nil cannot tell the two
          apart, and this can. The bool comes back unboxed the way a dyn
          comparison does, because a presence test is overwhelmingly an if's
          condition. *)
       if target.Tast.ty = Types.Dyn then
         expect ctx loc ~want
           (unbox loc Types.Bool
              (rt loc Types.Dyn "flan_dyn_map_contains_at"
                 [ target; check ctx ~want:Types.Dyn k; here loc ]))
       else begin
       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 ctx 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 ctx 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)) ])) ])))
       end
     | _ -> 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 TODO.org's "Assets are embedded at compile time":
     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 slice this hands back points into .rodata, so it is a [const u8]: a
     store through it would segfault at -O0 and be deleted at -O2, and the
     type refuses it at compile time instead. Copy the bytes for a writable
     buffer. *)
  | "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 "str"; _ } ] | [ _ ] -> ()
        | [ _; t ] ->
          fail t.Ast.loc
            "embed's second argument is str, or nothing for a [const 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 [const 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.Const, 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 a
          container that never converts to another container -- implicit
          widening is numbers only -- 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 "str"; _ } ] ->
          expect ctx loc ~want (as_string ())
        | _ ->
          (match want with
           | Some Types.String -> as_string ()
           | _ -> expect ctx loc ~want (as_bytes ())))
     | _ ->
       fail loc
         "embed is (embed \"path\") for a [const u8], or (embed \"path\" str)")
  (* ── What a macro says when it has to refuse ───────────────────
     The one thing a macro could not do, written down in the prelude where
     [unless] settles for it: "a macro has no error facility: it runs inside
     the compiler and anything it signals aborts the compile with no location.
     So a malformed (unless) answers a name nothing defines, and the report is
     'unknown name unless-takes-a-test-and-a-body' at the call site, which is
     the right place and the wrong sentence."

     A name nothing defines carries a name. It cannot carry a sentence, and a
     type provider's refusals are all sentence: the third element of this
     vector is a string where the first two were integers; there is no file at
     assets/x.edn; :size is a map with keys of two kinds. Those name a position
     in a *data* file, which no symbol the expansion could invent will hold.

     So a macro that has to refuse expands to a call to this, and the string is
     the report. The string is a form the macro built, so it has no line of its
     own and takes the call site's — the [defedn] the author wrote. The
     location is theirs and the sentence is the macro's, which is the two
     halves the prelude's note says are never both right at once.

     A builtin and not a declaration, because it has to fail *here*: a declared
     function would compile, link and run, and the compile it was meant to stop
     would have succeeded. The whole of it is one arm, and the argument is a
     literal for the same reason [embed]'s path is one — there is nothing at
     this point in a compile to compute a string from. *)
  | "compile-error" ->
    arity ctx loc name 1 args;
    (match (List.hd args).Ast.e with
     | Ast.Str s -> fail loc "%s" s
     | _ ->
       fail (List.hd args).Ast.loc
         "compile-error takes a literal string")
  | "embed-dir" ->
    arity ctx 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";
    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.Const, Types.Int Types.U8)) (Tast.Str data) ])))
        entries
    in
    expect ctx 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 ctx 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 ctx 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.Const, 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.Const, 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 ctx 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 ctx 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 ctx 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 ctx 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 ctx 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 [length] 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. *)
  | "length" ->
    arity ctx loc name 1 args;
    let target = List.hd args in
    let a = check_target 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 ctx loc ~want (mk loc index_ty (Tast.Prim (Tast.Cast index_ty, [ n ])))
     (* Bytes, as on a str (decision 107); rune-count counts characters. *)
     | t when is_string_ty t ->
       let n =
         rt loc (Types.Int Types.I64) "flan_vec_len" [ string_vec loc a; here loc ]
       in
       expect ctx 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
        [length] 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 ctx loc ~want (mk loc index_ty (Tast.Prim (Tast.Cast index_ty, [ n ])))
     (* A dyn length is an i32 like every other length here, not a dyn holding
        one. [length] is what an index loop compares against, and handing back a
        boxed number would make [(< i (length xs))] a dyn comparison and a
        pair of allocations per iteration. The runtime answers a dyn; it is unboxed at
        once and narrowed the way the Vec's i64 above is. *)
     | Types.Dyn ->
       let n = unbox loc (Types.Int Types.I64) (rt loc Types.Dyn "flan_dyn_len_at" [ a; here loc ]) in
       expect ctx loc ~want (mk loc index_ty (Tast.Prim (Tast.Cast index_ty, [ n ])))
     | other ->
       fail loc
         "length takes an array, a slice, a str, a String, a Vec or a Map, \
          found %s"
         (tyname loc other))
  | "at" ->
    (match args with
     | target :: idx when idx <> [] ->
       let target = check_target ctx target in
       (match target.Tast.ty with
        | Types.Vec _ ->
          let p, elem = vec_at ctx loc target idx in
          expect ctx loc ~want (mk loc elem (Tast.Deref p))
        (* One index, because a dyn container is one dimension: the nested
           [(at grid r c)] spelling walks a type the compiler can see through,
           and here it cannot. [(at (at g r) c)] is the spelling that works and
           is what the refusal names. *)
        | Types.Dyn ->
          (match idx with
           | [ i ] ->
             expect ctx loc ~want
               (rt loc Types.Dyn "flan_dyn_at"
                  [ target; check ctx ~want:Types.Dyn i; here loc ])
           | _ ->
             fail loc
               "(at ...) over a dyn takes one index — write (at (at x i) j)")
        | _ ->
          let idx, ty = indexed ctx target idx in
          prim Tast.At ty (target :: idx))
     | _ -> fail loc "%s is (%s collection index ...)" name name)
  (* (slice a), (slice a lo) and (slice a lo hi). The two short forms are
     written out here into the three-argument one and are that form after
     this line: same node, same checks, same code. Nothing is added at run
     time, because neither missing argument needs anything computed —
     [lo] is 0, and [hi] is the length, which on a fixed array is the
     constant [length] already folds to and on a slice or a string is the
     length word the value is carrying anyway.

     The target is read twice when [hi] is the implicit length, so a target
     that is not already a name goes into a slot first: [(slice (f x))] must
     call [f] once. An array target never needs the slot, because its length
     is a constant and the target appears exactly once.

     One name over every target that has elements, a Vec included. There used
     to be a second, [as-slice], for the Vec alone; the input type already
     decides which semantics apply — a Vec can only be borrowed, an array can
     only be viewed, and no call site chooses — so the second name expressed
     nothing and is gone. [vec_slice] above is the Vec's half. *)
  | "slice" ->
    (match args with
     | [] | _ :: _ :: _ :: _ :: _ ->
       fail loc
         "slice is (slice a), (slice a lo) or (slice a lo hi) — given %d \
          arguments" (List.length args)
     | target :: bounds ->
       lit_typed_use ctx target;
       let target = check_target ctx target in
       let ty = target.Tast.ty in
       match ty with
       (* A Vec leaves here: everything below is written around a length the
          compiler can see, and a Vec's is a word the runtime reads. *)
       | Types.Vec elem -> vec_slice ctx ~want loc target elem bounds
       (* A dyn leaves too, as [at] over one does: the bounds are dyn, like
          [at]'s index, and a missing [hi] is nil, which the runtime reads as
          the length. *)
       | Types.Dyn ->
         let bound b = check ctx ~want:Types.Dyn b in
         let nil () = rt loc Types.Dyn "flan_dyn_nil" [] in
         let lo, hi = match bounds with
           | [] -> box loc (mk loc dyn_i64 (Tast.Int (0L, Types.I64))), nil ()
           | [ lo ] -> bound lo, nil ()
           | [ lo; hi ] -> bound lo, bound hi
           | _ -> assert false
         in
         expect ctx loc ~want
           (rt loc Types.Dyn "flan_dyn_slice" [ target; lo; hi; here loc ])
       | _ ->
       (* A string slices to a string, not to a [u8]: the result views the
          same bytes and is read-only for the same reason the source is, and
          calling it a byte slice would hand out a writable-looking view of
          storage the program does not own. *)
       let result = match ty with
         (* An array reached through a [[const T]] or a (Ptr const T) is
            read-only storage, and so is a view of it. *)
         | Types.Array (_, t) when const_reached target <> None ->
           Types.Slice (Types.Const, t)
         | Types.Array (_, t) -> Types.Slice (Types.Mut, t)
         | Types.Slice (m, t) -> Types.Slice (m, t)
         | Types.String -> Types.String
         | other ->
           fail loc
             "slice takes an array, a slice, a string or a Vec, found %s"
             (tyname loc other)
       in
       (* An array that came back from a call is a value in a temporary this
          expression does not own: the slice would outlive it and view
          whatever the frame reused those bytes for, with nothing to trap on.
          A [let] gives it a name and a lifetime, so that is what the refusal
          names. An array *literal* is not this case — it is written here and
          the frame holds it for as long as the form it is written in. *)
       (match ty, target.Tast.e with
        | Types.Array _, (Tast.Call _ | Tast.CallPtr _) ->
          fail loc
            "this slices an array a call returned, which is a temporary the \
             slice would outlive. Bind it first: (let [a (…)] (slice a …))"
        | _ -> ());
       let int k = mk loc index_ty (Tast.Int (k, Types.I32)) in
       (* [hi] is wanted twice only when it is the implicit length of
          something whose length is not static. *)
       (* An array literal is also given a slot, so that what the slice views
          lives for the whole function in both backends: the x86 backend
          otherwise holds it in an expression temporary, reclaimed as soon as
          the slice has been made, and a later temporary — (clone ...)'s own,
          say — was written over it. *)
       let needs_slot =
         (match ty, target.Tast.e with
          | Types.Array _, Tast.Arr _ -> true
          | _ -> false)
         || List.length bounds < 2
            && (match ty with Types.Array _ -> false | _ -> true)
            && (match target.Tast.e with
                | Tast.Local _ | Tast.Global _ -> false
                | _ -> true)
       in
       let slot = if needs_slot then Some (fresh_slot ctx ty) else None in
       let src () = match slot with
         | Some s -> mk loc ty (Tast.Local s)
         | None -> target
       in
       let whole_len () = match ty with
         | Types.Array (n, _) -> int n
         | _ -> mk loc index_ty (Tast.Prim (Tast.Len, [ src () ]))
       in
       (* [index_expr] and not an [i32] expectation, which is what this used
          to be. One builtin cannot answer two ways about the same bound, and
          the question is settled by what every *other* subscript in the
          language already does: [indexed] and [vec_at] both take their index
          through here, so [(at a c)] over a [u32] compiles and [(slice a c)]
          used to not. A bound is a subscript; it takes the subscript rule.
          Nothing is loosened by it that a bounds check does not still catch —
          [index_expr] admits an integer narrower than 32 bits and a u32,
          whose out-of-range values truncate to a negative i32 the unsigned
          comparison rejects, and refuses i64 and u64 by name. *)
       let lo_loc, lo, hi_loc, hi =
         match bounds with
         | [] -> loc, int 0L, loc, whole_len ()
         | [ lo ] -> lo.Ast.loc, index_expr ctx lo, loc, whole_len ()
         | [ lo; hi ] ->
           lo.Ast.loc, index_expr ctx lo, hi.Ast.loc, index_expr ctx hi
         | _ -> assert false
       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
        | _ -> ());
       let body = mk loc result (Tast.Prim (Tast.Slice, [ src (); lo; hi ])) in
       (match slot with
        | None -> expect ctx loc ~want body
        | Some s ->
          expect ctx loc ~want
            (mk loc result (Tast.Let ([ (s, target) ], [ body ])))))

  (* (slice-from p n) — TODO.org, "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*
     ([is-font-valid]), and this does not ask; [zeroed], the nearest
     neighbour — a value conjured rather than derived — carries no marker
     either. The argument's type is the marker: only a (Ptr T) is accepted,
     and a (Ptr T) only ever arrives from a [declare-c], an [addr] or a
     pointer cast, so the site already says where the promise comes from.

     **The count is any integer.** It is widened to i64 here, sign- or
     zero-extended by its own kind, so both backends see one i64 and the
     length word is what the caller wrote. The [n >= 0] test the backends
     plant runs in every build, release included and [--no-bounds-checks]
     included: it is not a bounds check against a known length (there is
     none), it is the claim that the word being stored is a count at all. A
     u64 above 2^63 fails it too, and should — no pointer has that many
     elements behind it.

     **It owns nothing.** The result is a [Types.Slice], the same non-owning
     view (slice v) answers; (free s) on it is the program's error, which a
     dev build's registry traps as a slice no allocator handed out. It carries
     no allocator epoch either — a slice is two words, see TODO.org "A stale
     slice reads poison in a dev build" — so a view made over arena memory
     that is later freed reads the dev build's poison and does not trap. *)
  | "slice-from" ->
    arity ctx loc name 2 args;
    (match args with
     | [ target; n ] ->
       let target_loc = target.Ast.loc in
       let spelled_target = spell_arg "p" target in
       let target = check ctx target in
       let elem =
         match target.Tast.ty with
         | Types.Ptr (_, t) -> t
         | other ->
           fail target_loc
             "slice-from takes a (Ptr T) and the number of elements behind \
              it, found %s. A slice or an array already has a length; \
              (slice v lo hi) views part of one"
             (tyname loc other)
       in
       let n_loc = n.Ast.loc in
       let spelled_n = spell_arg "n" n in
       let n = check ctx n in
       (match n.Tast.ty with
        | Types.Int _ -> ()
        | Types.Var v ->
          cast_operand ctx n_loc name ~needs:"is-integer"
            ~what:"an element count" ~is:"an integer" v
        | other ->
          fail n_loc
            "slice-from counts elements with an integer, found %s. Write \
             (slice-from %s (i64 %s))"
            (tyname loc other) spelled_target spelled_n);
       (* 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 length %Ld is negative" k
        | _ -> ());
       let i64 = Types.Int Types.I64 in
       let n =
         if Types.equal n.Tast.ty i64 then n
         else mk n.Tast.loc i64 (Tast.Prim (Tast.Cast i64, [ n ]))
       in
       (* A read-only pointer gives a read-only slice, or [slice-from]
          would undo the const [addr] put there. *)
       let m = match target.Tast.ty with Types.Ptr (m, _) -> m | _ -> Types.Mut in
       prim Tast.SliceFrom (Types.Slice (m, elem)) [ target; n ]
     | _ -> assert false)

  (* ── pointers ──────────────────────────────────────────────────── *)
  | "addr" ->
    arity ctx loc name 1 args;
    let a = List.hd args in
    lit_typed_use ctx a;
    (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 ~store:false ctx a.Ast.loc p in
       let m = if place_const p then Types.Const else Types.Mut in
       expect ctx loc ~want (mk loc (Types.Ptr (m, ty)) (Tast.Addr p)))
  | "deref" ->
    arity ctx loc name 1 args;
    let a = check ctx (List.hd args) in
    (match a.Tast.ty with
     | Types.Ptr (_, t) -> expect ctx loc ~want (mk loc t (Tast.Deref a))
     | other -> fail loc "deref takes a (Ptr T), found %s"
                  (tyname loc other))

  (* ── Option ────────────────────────────────────────────────────── *)
  (* (Some nil) cannot be built. Some marks a value present; nil is dyn's own
     way of saying absent; a present absence is what would make nil and None
     the same case of an (Option dyn) and break nil <-> None at the boundary
     in both directions. Refused here at the literal, which the checker can
     see the same way it sees any other [nil]; a dyn value that only turns
     out to be nil once the program runs is caught by the runtime guard on
     the value instead, named for what it refuses rather than just that it
     does. *)
  | "Some" ->
    arity ctx loc name 1 args;
    let arg = List.hd args in
    let inner = match want with Some (Types.Option t) -> Some t | _ -> None in
    (* A literal [nil] is refused by this form's own message below, not by
       [expect]'s bare-T refusal — checking it against [inner] here would
       let a bare T's "wrap the type in Option" reach the reader even though
       the type here is already wrapped in one. Checked with no want instead,
       which is exactly what a bare [nil] resolves against on its own (see
       [var]'s "nil" arm), so it arrives below still dyn and still nil. *)
    let ast_nil = match arg.Ast.e with Ast.Var "nil" -> true | _ -> false in
    let a = check ctx ?want:(if ast_nil then None else inner) arg in
    let a =
      if not (Types.equal a.Tast.ty Types.Dyn) then a
      else if is_nil_lit a then
        Loc.failk "check/some-nil" loc
          "(Some nil) cannot be built — Some marks a value present, and nil \
           is dyn's absence. Use None instead"
      else rt loc Types.Dyn "flan_dyn_need_not_nil" [ a ]
    in
    expect ctx loc ~want (mk loc (Types.Option a.Tast.ty) (Tast.Some_ a))

  (* ── the milestone-2 host primitives (plan.org) ────────────────── *)
  (* (bytes-view s): the string's own storage seen as a [const u8], costing
     nothing. The slice aliases the string, and a literal's bytes are in
     read-only memory — a store through them would trap at -O0 and be deleted
     as undefined at -O2 — so the view is one that can only be read, and a
     store through it is refused here rather than at run time. (bytes s) is
     the writable copy.
     Reading through it is the whole use: is-bytes-equal, split, index-of-bytes and
     every other comparison walks a string's bytes without copying them. *)
  | "bytes-view" ->
    arity ctx loc name 1 args;
    let a = maybe_string ctx ~otherwise:Types.String (List.hd args) in
    if string_or_ptr a.Tast.ty then expect ctx loc ~want (string_bytes ctx loc a)
    else prim Tast.Bytes (Types.Slice (Types.Const, Types.Int Types.U8)) [ a ]

  (* (bytes s) / (bytes s a): a *writable copy* of the string's bytes, from
     the context allocator or one named — never a hidden malloc, which is
     spec-memory.md's frozen rule over every allocating operation. It used to
     be the zero-cost reinterpret above, and the author's in-place sort over
     (bytes "INSERTIONSORT") wrote into the string constant; "I would expect
     bytes to copy" is the ruling this implements. The lowering is
     [dup_elems], which (clone xs) shares for any slice. *)
  | "bytes" ->
    (match args with
     | s :: rest when List.length rest <= 1 ->
       let s = check ctx ~want:Types.String s in
       let a = allocator_arg ctx loc rest in
       expect ctx loc ~want (dup_elems ctx loc (Types.Int Types.U8) s a)
     | _ -> fail loc "bytes is (bytes s) or (bytes s allocator)")

  (* (str b): a [u8] seen as a str. The mirror of (bytes-view 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 `str` does not claim UTF-8. The
        prelude settles this: is-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 takes a [const u8], so a [u8] and a (bytes-view s) are both
        accepted. This direction only loses the ability to write — a string
        is read-only everywhere — so the result of (str b) can reach
        strictly fewer stores than b could.

     The text i64->bytes and f64->bytes answer lives in the temp allocator
     until the next (free-temp); calling it a string does not copy it, so text
     kept past the frame is cloned first. *)
  | "str" ->
    arity ctx loc name 1 args;
    (* A String's str is a view of its bytes, as (str (slice v)) is of a
       Vec's: it costs nothing and lasts until the String next grows. *)
    let a =
      maybe_string ctx ~otherwise:(Types.Slice (Types.Const, Types.Int Types.U8))
        (List.hd args)
    in
    if string_or_ptr a.Tast.ty then
      prim Tast.StrOfBytes Types.String [ string_bytes ctx loc a ]
    else prim Tast.StrOfBytes Types.String [ a ]
  | "bytes->f64" ->
    arity ctx loc name 1 args;
    prim Tast.BytesToF64 (Types.Float Types.F64) [ byte_slice ctx (List.hd args) ]
  | "bytes->i64" ->
    arity ctx loc name 1 args;
    prim Tast.BytesToI64 (Types.Int Types.I64) [ byte_slice ctx (List.hd args) ]
  (* The number's text in the temp allocator: flan_i64_temp and flan_f64_temp
     render it and bump-allocate the bytes there in one call, so the slice
     outlives the frame — a function may return one and a Vec may hold one —
     until the next (free-temp). A number drawn every frame is reclaimed every
     frame; text kept longer is cloned. The number is bound before the guard's
     loop, so a retry does not evaluate it twice.

     The prelude's calls — append-i64, append-f64, format-f64, gensym — are
     answered with a frame slot instead ([to_bytes]): each copies the bytes
     into a Vec before the next conversion, so the temp copy would be work
     thrown away. *)
  | "f64->bytes" | "i64->bytes" ->
    arity ctx loc name 1 args;
    let f64 = name = "f64->bytes" in
    let nty = if f64 then Types.Float Types.F64 else Types.Int Types.I64 in
    let x = check ctx ~want:nty (List.hd args) in
    let bslice = Types.Slice (Types.Mut, Types.Int Types.U8) in
    expect ctx loc ~want
      (if String.equal loc.Loc.file Prelude.file then
         to_bytes ctx loc (if f64 then Tast.F64ToBytes else Tast.I64ToBytes) x
       else
         let xs = fresh_slot ctx nty and out = fresh_slot ctx bslice in
         let attempt () =
           rt loc (Types.Int Types.I8)
             (if f64 then "flan_f64_temp" else "flan_i64_temp")
             [ mk loc nty (Tast.Local xs);
               addr_of loc (mk loc bslice (Tast.Local out)) ]
         in
         (* The guard — a retry restart around the attempt — is entered only
            once a first attempt has failed, so the common case pays one call
            and a compare. A failure then re-attempts under the guard exactly
            as it would have. *)
         let failed =
           mk loc Types.Bool
             (Tast.Prim (Tast.Eq,
                         [ attempt ();
                           mk loc (Types.Int Types.I8) (Tast.Int (0L, Types.I8)) ]))
         in
         mk loc bslice
           (Tast.Let
              ([ (xs, x); (out, mk loc bslice (Tast.Zero bslice)) ],
               [ mk loc Types.Unit
                   (Tast.If (failed, alloc_guard ctx loc (attempt ()),
                             unit_at loc));
                 mk loc bslice (Tast.Local out) ])))
  | "write-stdout" ->
    arity ctx 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" ->
    (* Variadic, with Clojure's spacing: every argument prints in order with a
       single space between each pair, and [println] ends the line. No arity
       check — (println) is the newline alone and (print) is nothing, which is
       also Clojure's answer. Each argument gets the same walk it would get
       alone, so one call mixes typed and dyn values freely, and a bad argument
       is refused at its own location: the arguments are checked one by one
       below, each carrying its own loc, and render.ml fails on the
       expression's loc rather than the form's. *)
    (* 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 checked = List.map (fun target -> check ctx target) args 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 (is-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. One generic argument defers the whole call:
       the printers for its neighbours would be re-selected at instantiation
       anyway, so building them here would be work thrown away twice. *)
    if List.exists (fun a -> open_ty a.Tast.ty) checked then
      mk loc Types.Unit Tast.Unit
    else
    let bslice = Types.Slice (Types.Mut, (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));
        edyn = (fun x -> mk loc Types.Unit (Tast.Prim (Tast.Rt "flan_dyn_print_at", [ x; here loc ])));
        enested = (fun x -> mk loc Types.Unit (Tast.Prim (Tast.Rt "flan_dyn_print_nested_at", [ x; here loc ]))) }
    in
    let rc = render_ctx ctx emitter in
    let c_top = emitter.Render.edyn in
    let render_one a =
      match a.Tast.ty with
      | Types.String | Types.Slice (_, (Types.Int Types.U8)) ->
        [ write (mk loc bslice (Tast.Prim (Tast.Bytes, [ a ]))) ]
      (* A char at the top prints as the character itself (129a), through the
         runtime's dyn printer so the two sides agree. *)
      | Types.Char ->
        [ c_top (box loc a) ]
      (* A String prints as its text, raw at the top as a str does. *)
      | t when is_string_ty t ->
        [ write (mk loc bslice (Tast.Prim (Tast.Bytes, [ string_bytes ctx loc a ]))) ]
      (* The walk names the value once per piece it reads — an option's tag
         and then its payload, each field of a struct — so anything but a
         plain variable is bound to a slot first, or [(println (small-pop s))]
         pops once per piece. *)
      | _ ->
        (match a.Tast.e with
         | Tast.Local _ | Tast.Global _ -> Render.render rc 0 a
         | _ ->
           let s = fresh_slot ctx a.Tast.ty in
           [ mk loc Types.Unit
               (Tast.Let
                  ([ (s, a) ],
                   Render.render rc 0 (mk a.Tast.loc a.Tast.ty (Tast.Local s))))
           ])
    in
    (* Built fresh per use rather than shared: nothing else in this file puts
       one node in two places of a tree, and a pass that hangs state off a
       node would be entitled to assume it appears once. *)
    let space () =
      write (mk loc bslice
               (Tast.Prim (Tast.Bytes, [ mk loc Types.String (Tast.Str " ") ])))
    in
    let parts =
      match checked with
      | [] -> []
      | first :: rest ->
        render_one first
        @ List.concat_map (fun a -> space () :: render_one a) rest
    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 ctx loc ~want (mk loc Types.Unit (Tast.Do (parts @ nl)))
  (* (watch "name" v) — v rendered into the dev watch table under the name.

     The same walk as [print], with the pieces aimed at flan_dev.c's watch
     slot instead of stdout, so a struct, a slice, an option or a dyn value
     watches the way it prints.

     The value is evaluated once, before the table is asked whether anyone is
     looking, so a side effect in it happens whether or not a watch buffer is
     open. The walk runs only when one is: [flan_dev_watch_begin_n] answers 0
     when the table is not armed or is full, and the render is skipped.

     Outside a dev build the backends drop the guarded [If] whole — see
     [Tast.is_watch_guard] — so a release build evaluates the value and makes
     no call at all. *)
  | "watch" ->
    arity ctx loc name 2 args;
    let label = check ctx ~want:Types.String (List.hd args) in
    let v = check ctx (List.nth args 1) in
    if open_ty v.Tast.ty then mk loc Types.Unit Tast.Unit
    else begin
      let unit_rt sym args = mk loc Types.Unit (Tast.Prim (Tast.Rt sym, args)) in
      let bslice = Types.Slice (Types.Mut, (Types.Int Types.U8)) in
      let emitter : Render.emitter =
        { Render.ebytes = (fun x -> unit_rt "flan_dev_watch_emit" [ x ]);
          estr = (fun x -> unit_rt "flan_dev_watch_emit_str" [ x ]);
          ei64 = (fun x -> unit_rt "flan_dev_watch_emit_i64" [ x ]);
          eu64 = (fun x -> unit_rt "flan_dev_watch_emit_u64" [ x ]);
          ef64 = (fun x -> unit_rt "flan_dev_watch_emit_f64" [ x ]);
          edyn = (fun x -> unit_rt "flan_dyn_emit_watch" [ x ]);
          enested = (fun x -> unit_rt "flan_dyn_emit_watch" [ x ]) }
      in
      (* A place is read where it stands; anything else is bound to a slot of
         this frame first, so the walk — which names its argument once per
         field — does not run it once per field. *)
      let bind, value =
        match v.Tast.e with
        | Tast.Local _ | Tast.Global _ -> [], v
        | _ ->
          let s = fresh_slot ctx v.Tast.ty in
          [ (s, v) ], mk loc v.Tast.ty (Tast.Local s)
      in
      let body =
        match value.Tast.ty with
        (* A string watches quoted, as it renders inside a structure: the
           table's rows are values, and an unquoted one could not be told from
           a number. *)
        | Types.String ->
          [ emitter.Render.estr (mk loc bslice (Tast.Prim (Tast.Bytes, [ value ]))) ]
        | _ ->
          Render.render
            ~refuse:(fun _loc t ->
              Printf.sprintf
                "%s has no rendering, so it cannot be watched — watch the \
                 values you want out of it instead"
                (tyname loc t))
            (render_ctx ctx emitter) 0 value
      in
      let begin_ =
        mk loc (Types.Int Types.I32)
          (Tast.Prim (Tast.Rt Tast.watch_begin, [ label ]))
      in
      let zero = mk loc (Types.Int Types.I32) (Tast.Int (0L, Types.I32)) in
      let open_ = mk loc Types.Bool (Tast.Prim (Tast.Ne, [ begin_; zero ])) in
      let guarded =
        mk loc Types.Unit
          (Tast.If
             ( open_,
               mk loc Types.Unit
                 (Tast.Do (body @ [ unit_rt "flan_dev_watch_end" [] ])),
               mk loc Types.Unit Tast.Unit ))
      in
      expect ctx loc ~want
        (match bind with
         | [] -> guarded
         | _ -> mk loc Types.Unit (Tast.Let (bind, [ guarded ])))
    end
  | "exit" ->
    arity ctx loc name 1 args;
    prim Tast.Exit Types.Never [ check ctx ~want:index_ty (List.hd args) ]
  | "argv" ->
    arity ctx loc name 0 args;
    prim Tast.Argv (Types.Slice (Types.Mut, 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 ctx 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 _ -> ()
     (* A type variable, answered by its bound rather than by a type it does
        not have yet: [is-integer] admits exactly the integer kinds, which is
        what sub-decision 3 above asks for, and [is-numeric] is a bound too wide
        because it admits the floats that decision refuses. *)
     | Types.Var v ->
       cast_operand ctx loc name ~needs:"is-integer" ~what:"an integer to an enum"
         ~is:"an integer" v
     | other ->
       fail loc "%s converts an integer to an enum, found %s — an enum or a \
                 float goes through (i32 x) first" name
         (tyname loc other));
    prim (Tast.Cast target) target [ a ]
  (* A cast to a *type variable*: [(t x)] or [($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 [is-numeric] is what admits it.

     A sigil on a name nothing binds comes here too, for the reason
     [type_named] takes one: the character is only ever written where a type
     goes, so [resolve_name] gets to say that a variable has no binding site
     outside a defn signature. Otherwise [($u x)] would be an unknown function
     in the same body where [(vec-new $u)] is an unbound variable — one
     mistake told two ways.

     Only where nothing else claims the name, though. Nothing stops a defn, a
     struct or a binding from carrying the character, and a call to one is a
     call and not a type: this arm sits above the arms that would have found
     it — [ordinary_call] and, last of all, [positional_struct] — so it has to
     decline first, once per table a name can be declared in. *)
  | _ when (tyvar_in_scope ctx.env name
            || (name <> tyvar_bare name
                && lookup ctx name = None
                && not (Hashtbl.mem ctx.env.structs name)
                && not (Hashtbl.mem ctx.env.fns name)
                && not (Hashtbl.mem ctx.env.gsigs name)))
           && List.length args = 1 ->
    let target = resolve_name ctx.env ~seen:[] loc name in
    unconstrained ctx.env loc ("a cast to " ^ name) ~needs:"is-numeric" target;
    let a = check ctx (List.hd args) in
    (match a.Tast.ty with
     | Types.Enum _ -> ()
     | t when Types.is_numeric t -> ()
     (* The operand's own bound, asked the same way the target's was one line
        up. Accepting every [generic_ty] here took the target's [is-numeric] as
        if it said something about the operand, so a second variable declared
        only [is-ordered] passed the abstract pass. Nothing wrong was ever
        emitted — [is-ordered] admits numbers and enums and both convert at the
        instantiation — which is the point: the hole is only reachable the day
        [is-ordered] admits a type that does not, and that day is why the
        question is asked of the predicate and not of the set it denotes. *)
     | Types.Var v ->
       cast_operand ctx loc name ~needs:"is-numeric" ~also:("is-enum", "an enum")
         ~what:"a number or an enum" ~is:"a number" v
     | t -> fail loc "%s converts a number, found %s" name (tyname loc t));
    prim (Tast.Cast target) target [ a ]
  (* (char n): a code point made a char. Only a Unicode scalar value is one,
     so a literal is checked here and anything else at run time. *)
  | "char" when List.length args = 1 ->
    let x = List.hd args in
    let char_lit n = mk loc Types.Char (Tast.Int (n, Types.U32)) in
    let fln = fln_source loc in
    let not_scalar n =
      Loc.failk literal_at_want loc
        "%Ld is not a Unicode scalar value, so it is not a char. A char is a \
         code point from 0 to 0x10FFFF, outside 0xD800 to 0xDFFF" n
    in
    (match x.Ast.e, literal_arith x with
     | Ast.Byte b, _ -> expect ctx loc ~want (char_lit (Int64.of_int b))
     | _, Some n ->
       if Int64.compare n 0L >= 0 && Int64.compare n 0x10ffffL <= 0
          && not (Int64.compare n 0xd800L >= 0 && Int64.compare n 0xdfffL <= 0)
       then expect ctx loc ~want (char_lit n)
       else not_scalar n
     | _ ->
       let a = check ctx x in
       let checked i64 =
         rt loc Types.Char "flan_char_of" [ i64; here loc ]
       in
       (match a.Tast.ty with
        | Types.Char -> expect ctx loc ~want a
        (* A u64 goes as itself, so one past 2^63 is named as the number
           it is and not as the negative i64 with its bits. *)
        | Types.Int Types.U64 ->
          expect ctx loc ~want
            (rt loc Types.Char "flan_char_of_u64" [ a; here loc ])
        | Types.Int _ -> expect ctx loc ~want (checked (widen loc dyn_i64 a))
        (* Explicit, so a dyn int converts as a typed one does. *)
        | Types.Dyn ->
          expect ctx loc ~want
            (checked (rt loc dyn_i64 "flan_dyn_int_of" [ a ]))
        | t ->
          fail loc "char makes a char from an integer code point, found %s%s"
            (tyname loc t)
            (match t with
             | Types.Float _ ->
               if fln then " — convert it with i32(x) first"
               else " — convert it with (i32 x) first"
             | _ -> "")))
  | _ when is_cast name && List.length args = 1 ->
    let target = resolve_name ctx.env ~seen:[] loc name in
    (* An integer literal too wide for the i32 it would default to is checked
       at the target instead, so (u64 2935910691) and (i64 5000000000) are the
       constants they say. One that fits i32 keeps the default and the cast,
       which is what (u32 -1) has always meant. *)
    let operand_want =
      match (List.hd args).Ast.e, target with
      | Ast.Int n, (Types.Int _ | Types.Float _)
        when Int64.compare n (-2147483648L) < 0
             || Int64.compare n 2147483647L > 0 -> Some target
      | Ast.UInt _, (Types.Int _ | Types.Float _) -> Some target
      (* A char literal is the number at the target, so (u8 \é) is refused
         as a u8 literal is. *)
      | Ast.Byte _, (Types.Int _ | Types.Float _) -> Some target
      (* A float literal likewise: (f64 0.1) is the f64 nearest 0.1 and not
         the f32 one widened, and (u64 1.8e19) converts the f64 it says. *)
      | _, Types.Float _ when lit_kind (List.hd args) = Some `Float -> Some target
      | _, Types.Int _ when lit_kind (List.hd args) = Some `Float ->
        Some (Types.Float Types.F64)
      | _ -> None
    in
    let a = check ctx ?want:operand_want (List.hd args) in
    (match a.Tast.ty with
     | Types.Enum _ -> ()
     (* A dyn opens here — [cast_dyn], TODO.org, "A numeric cast opens a dyn
        box". Only on this arm:
        the generic one above casts to a type *variable*, whose [where] clause
        says the operand is numeric, and a dyn is not what a [is-numeric] bound
        admits. *)
     | Types.Dyn -> ()
     | t when Types.is_numeric t -> ()
     (* A char's code point, into any integer width. *)
     | Types.Char when Types.is_integer target -> ()
     | Types.Char ->
       fail loc "%s converts a number, and a char converts only to an integer, \
                 as %s" name
         (if fln_source loc then "i32(c)" else "(i32 c)")
     (* The operand of a conversion inside a generic body. The target is a
        machine type, so what is in question is only the operand, and the
        [where] clause is what answers it. *)
     | Types.Var v ->
       cast_operand ctx loc name ~needs:"is-numeric" ~also:("is-enum", "an enum")
         ~what:"a number or an enum" ~is:"a number" v
     | t -> fail loc "%s converts a number, found %s" name (tyname loc t));
    (match a.Tast.ty with
     | Types.Dyn -> expect ctx loc ~want (cast_dyn ctx loc target a)
     | _ -> prim (Tast.Cast target) target [ a ])

  (* ── ordinary calls ────────────────────────────────────────────── *)
  | _ -> ordinary_call ctx ~want loc name args

(* Everything that is not a builtin arm: a local of function type, a generic
   signature, the function table, and the refusals for a name that is none of
   them. Reached two ways — by falling past every arm above, and by the
   shadowing guard at the very top of [named_call], which sends a call whose
   name the program has defined straight here. One function so that both
   routes resolve a name by exactly the same rules. *)
and ordinary_call ctx ~want loc name args =
  match () with
  (* 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: a binding shadows a defn of the same
     name (one namespace, ordinary lexical scoping). 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.

     A local of the *enclosing* function holding one is the same case: a
     lifted body captures it by value and then calls the copy. [peek_outer]
     rather than [capture] in the guard, because a guard must not take a copy
     on its way to deciding what a form means. *)
  (* A [_] function whose body failed has no return type to give; its own
     errors are reported with its body, so a call to it stands in. *)
  | _ when ctx.env.recovering && Hashtbl.mem ctx.env.infer_failed name
           && lookup ctx name = None ->
    List.iter (fun a -> ignore (check ctx a)) args;
    ctx.env.poison <- ctx.env.poison + 1;
    poison loc
  (* A local bound to a refused initialiser's stand-in, called: the refusal
     is already reported, so the call stands in too, its arguments still
     checked. *)
  | _ when ctx.env.recovering
           && (match lookup ctx name with
               | Some b -> Types.equal b.bty Types.Never
               | None -> false) ->
    List.iter (fun a -> ignore (check ctx a)) args;
    ctx.env.poison <- ctx.env.poison + 1;
    poison loc
  | _ when (match lookup ctx name with
            | Some b -> callable_ty b.bty
            | None ->
              match peek_outer ctx name with
              | Some b -> callable_ty b.bty
              | None -> false) ->
    (* The binding the guard already found, read directly. Going back through
       [check] would repeat the lookup. *)
    (match lookup ctx name with
     | Some b -> call_value ctx ~want loc (local_of loc b) args
     | None ->
       match capture ctx loc name with
       | Some b -> call_value ctx ~want loc (mk loc b.bty (Tast.Local b.slot)) args
       | None -> assert false)
  (* A global holding a function value — a (CFn ...) table entry's cousin,
     since a global is one of the zeroed positions a CFn may sit in. Called
     by its name the way a local one is. *)
  | _ when (match Hashtbl.find_opt ctx.env.globals name with
            | Some (ty, _) -> callable_ty ty
            | None -> false) ->
    let ty, _ = Hashtbl.find ctx.env.globals name in
    call_value ctx ~want loc (mk loc ty (Tast.Global name)) args
  (* A name with several versions: the number of arguments picks one, and
     the call is then a call to that version by its own name. *)
  | _ when Hashtbl.mem ctx.env.versions name ->
    let vs = Hashtbl.find ctx.env.versions name in
    (match List.assoc_opt (List.length args) vs with
     | Some v -> ordinary_call ctx ~want loc v args
     | None ->
       let n = List.length args in
       Loc.failk "check/no-version" loc
         "%s has no arity that takes %d argument%s. It has these:\n%s"
         name n (if n = 1 then "" else "s")
         (String.concat "\n"
            (List.map (fun (_, v) -> "  " ^ version_text ctx.env loc v) vs)))
  | _ when Hashtbl.mem ctx.env.gsigs name ->
    private_ref ctx loc 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) ->
      private_ref ctx loc name;
      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 i = ref (-1) in
      let args =
        map2_lr (fun p a -> incr i; check_arg ctx name !i p a) params args
      in
      let args = c_literals ctx name params args in
      (match Hashtbl.find_opt ctx.env.tracks name with
       | Some tr -> expect ctx loc ~want (tracked_call loc ctx.env name tr ret args)
       | None when Hashtbl.mem ctx.env.classes name ->
         (* A class's constructor, told where it was called from so that a
            slot it refuses names this call and not only the defclass. The
            arguments go into temps first: one may itself construct, and
            the site is set last, immediately before the call, so nothing
            between the two can replace it. The constructor takes it as its
            first act; one reached through a function value finds none. *)
         let temps =
           List.map (fun (a : Tast.expr) -> (fresh_slot ctx a.Tast.ty, a)) args
         in
         let uses =
           List.map
             (fun (s, (a : Tast.expr)) -> mk a.Tast.loc a.Tast.ty (Tast.Local s))
             temps
         in
         expect ctx loc ~want
           (mk loc ret
              (Tast.Let
                 (temps,
                  [ rt loc Types.Unit "flan_dyn_ctor_site" [ here loc ];
                    mk loc ret (Tast.Call (name, uses)) ])))
       | None ->
         let call = mk loc ret (Tast.Call (name, args)) in
         expect ctx loc ~want
           (if is_string_ty ret && prelude_defined ctx name
               && not (String.equal loc.Loc.file Prelude.file)
            then prechecked_call ctx loc name ret args
            else call))
    | None ->
      if Hashtbl.mem ctx.env.datas name then
        fail loc
          "%s is a data type, so a value of it names a case — write \
           (%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
        positional_struct ctx ~want loc name args
      else if Hashtbl.mem ctx.env.gstructs name then
        positional_struct ctx ~want loc
          (generic_ctor ctx ~want loc name
             (`Positional args)) args
      else if List.mem_assoc name operator_aliases then
        (* Asked before the package test, because [/=] and [=/=] have a slash
           in them and are not package calls. The did-you-mean cannot reach
           these: [not=] is one edit from [not], which is the wrong answer,
           and [&&] is no edit at all from [and]. *)
        let flan, what = List.assoc name operator_aliases in
        Loc.failk "check/unknown-function" loc
          "there is no %s. %s is %s. %s" name what flan
          (alias_fix flan args)
      else if String.contains name '/' then
        unimplemented loc
          (Printf.sprintf "the call %s into an imported package" name) 4
      else if name = "as-slice" then
        (* A name nothing defines, near enough to [slice] to be worth a
           sentence rather than a did-you-mean: whatever [slice] is given
           decides what the view means, so there is one word for it and this
           says which. Asked here, after every table, so that a program that
           defines an [as-slice] of its own still reaches its own. *)
        (* The call is written back out rather than described, and every
           argument the reader wrote that can be spelled is spelled
           ([spell_arg]), so the suggestion is always a form that compiles
           rather than a form with a hole in it. *)
        let spell = spell_arg in
        let call =
          match args with
          | [] -> "(slice v)"
          | t :: bounds ->
            let names = [ "lo"; "hi" ] in
            let bounds =
              List.mapi
                (fun i b ->
                   " " ^ spell (try List.nth names i with _ -> "n") b)
                bounds
            in
            "(slice " ^ spell "v" t ^ String.concat "" bounds ^ ")"
        in
        Loc.failk "check/unknown-function" loc
          "there is no as-slice. slice takes the view, and what it is given \
           says what the view is: over a Vec it borrows the storage the Vec \
           owns, over an array or a string it looks at the value itself. \
           Write %s" call
      else if name = "slice-from-ptr" then
        (* The name this form had before; code written against it lands here.
           Said as the form to write, with the reader's arguments, and not as
           a rename — a first-time reader has no old name to be told about. *)
        let call =
          match args with
          | [ p; n ] ->
            "(slice-from " ^ spell_arg "p" p ^ " " ^ spell_arg "n" n ^ ")"
          | _ -> "(slice-from p n)"
        in
        Loc.failk "check/unknown-function" loc
          "there is no slice-from-ptr. A slice from a pointer and a count of \
           the elements behind it is slice-from. Write %s" call
      else if no_such_rand name <> None then
        (* A retired randomness name, which is a name and not a near miss:
           "did you mean rand?" for [rand-f32] would be true and would not say
           what to write, and the line in [no_such_rand] does. *)
        Loc.failk "check/unknown-function" loc "%s"
          (Option.get (no_such_rand name))
      else if name = "len" then
        (* [len] is an ordinary name and the count is [length], so this is the
           one sentence a program that reached for the short word needs. It is
           said rather than guessed at because the did-you-mean below cannot
           reach it: [len] and [length] are three edits apart, and the net is
           one. Asked here, after every table and after the shadowing guard at
           the head of the dispatch, so a program that defines a [len] of its
           own reaches its own — this is only ever the answer for a name that
           nothing in the program has taken.

           The reader's own argument is spelled back only when there is one of
           it. [length] takes exactly one, so writing three of them out would
           produce a suggestion that is refused for a second reason the moment
           it is pasted — and a suggestion that does not compile is the bug
           this spelling exists to avoid. [as-slice] above can write every
           argument out because [slice] takes one, two or three; this cannot,
           and the difference is the arity and not the style. *)
        let call =
          match args with
          | [ a ] -> "(length " ^ spell_arg "v" a ^ ")"
          | _ -> "(length v)"
        in
        Loc.failk "check/unknown-function" loc
          "there is no len. The number of elements in an array, a slice, a \
           string, a Vec or a Map is length. Write %s" call
      else
        (* The did-you-mean comes first, and for a capitalised head it is asked
           of the *type* tables as well: [(Piont 1 2)] with [Point] declared is
           a typo, and the generics sentence below would be a confident answer
           about a feature nobody was reaching for. Only a capitalised head
           consults the types — a lowercase name written where a value goes
           was not a mistyped struct, which is [value_candidates]' whole
           point. *)
        let capitalised =
          name <> "" && name.[0] = Char.uppercase_ascii name.[0]
          && name.[0] <> Char.lowercase_ascii name.[0]
        in
        let guess =
          match nearest (!builtin_names @ value_candidates ctx) name with
          | Some _ as m -> m
          | None -> if capitalised then near_miss ctx.env name else None
        in
        (* A near miss that names a value rather than a function is still the
           near miss, but [(m)] would be refused in its turn, so the sentence
           says how that name is written instead. *)
        let callable m =
          let fn_ty = function
            | Types.Fn _ | Types.CFn _ | Types.Dyn -> true
            | _ -> false
          in
          match lookup ctx m with
          | Some b -> fn_ty b.bty
          | None ->
            match Hashtbl.find_opt ctx.env.globals m with
            | Some (ty, _) -> fn_ty ty
            | None ->
              not (List.mem m [ "true"; "false"; "nil"; "None";
                                "context/allocator"; "context/temp" ])
        in
        (* [(string b)], [(byte x)]: another language's name for a type, used
           as the conversion, which Flan spells with its own type name. *)
        (match foreign_spelling name with
         | Some m ->
           Loc.failk "check/unknown-function" loc
             "unknown function %s — Flan spells it %s" name m
         | None -> ());
        match guess with
        | Some m when not (callable m) ->
          if args = [] then
            Loc.failk "check/unknown-function" loc
              "unknown function %s — did you mean %s? It is a value and not a \
               function, so it is written without parentheses" name m
          else
            Loc.failk "check/unknown-function" loc
              "unknown function %s. The nearest name, %s, is a value and not a \
               function" name m
        | Some m ->
          Loc.failk "check/unknown-function" loc
            "unknown function %s — did you mean %s?" name m
        | None ->
          if args <> [] && capitalised then
            (* [(defonce p (Pair i32))]. A capitalised head with arguments and
               no near miss anywhere is somebody reaching for a parameterised
               type, which is what the type resolver says about [(Pair i32)]
               when the same text lands in a type position. Before defonce took
               either reading, that is the message this text got; it says the
               same thing here so the answer does not depend on which side of
               the fork the form fell down. *)
            Loc.failk "check/unknown-function" loc
              "unknown function %s. A capitalised name is a type, and no \
               struct or generic struct %s is declared — a generic struct is \
               one whose fields introduce $t, as in (defstruct %s [x $t])"
              name name name
          else Loc.failk "check/unknown-function" loc "unknown function %s" name

(* Does the program's own definition of this name take this call over?
   Two questions, in this order, and the order is what makes the guard cheap
   enough to be the first arm of the dispatch.

   Is the name a builtin's at all. One lookup in [builtin_set], false for
   every call to an ordinary function — which is most calls in most programs
   — and the question that stops the second from being asked at all. Asking
   it first also keeps the arms that are not calls — an enum cast, a cast to
   a type variable, a machine-type cast — exactly where they were, since a
   name that reaches one of those is not a builtin's either.

   Is there a definition of it that reaches this call: a local of function
   type, or a defn — ordinary or generic — written in this same file.

   And is the definition visible here, which is asked of the two files: the
   one the definition was written in and the one this call is written in. A
   definition shadows the builtin through its own file and no further, which
   is the same visibility a defn has everywhere else — the prelude is the
   language's own source and means the builtin wherever it writes one, and an
   imported package keeps the builtin it was written against no matter what
   the program importing it decides to call [get].

   The file and not the enclosing function's name. A package's functions are
   qualified at the import ([rl/get]), so asking whether the owner's name
   carries a slash answers correctly everywhere a call sits inside a
   function — and wrongly in the one place a call does not: a package's
   global initialiser, which is checked with no owner at all. An importer
   defining [length] reached inside an imported
   [(defonce sz i32 (length "abcd"))]
   and changed what it computed. The files were never wrong about it.

   What it costs is the REPL: an expression evaluated with no file behind it
   is not the file the defn was written in, so it reaches the builtin. That
   is the conservative direction, and C-c C-c — which sends the buffer's own
   path — is not affected. *)
(* A [defn-] is its module's own. A use of one — a call, or the name taken
   as a value — is refused unless it is written inside the module that
   declares it. A directory package is every file in its directory, so the
   test there is the two files' directories; a single file imported outright
   is that file alone, which [Load] records by narrowing the flag to
   [Private_to_file]. Realpath'd, because one side is usually the path the
   importer was given on the command line and the other the one [Load]
   resolved.

   Code the package's own macro wrote counts as inside, wherever it was
   expanded: SBCL's rule, where a macro's expansion refers to its package's
   internal symbols freely. What the importer wrote itself does not, even when
   it is an argument the macro passed through. [Expand.unmarshal] tells the two
   apart already: a node the macro invented carries the call site's location
   with the macro's name on it and no separate call site, and a form the author
   wrote keeps its own position with the call recorded beside it. The macro's
   package is its qualifier, which is the function's when both come from the
   same module, because an import qualifies every name a directory declares
   under the one alias it is read as.

   Only a qualified name is asked about. An unqualified one belongs to the
   program being built, and nothing outside a program can name it. *)
and private_ref ctx loc name =
  let qualifier n =
    match String.rindex_opt n '/' with
    | Some i -> Some (String.sub n 0 i)
    | None -> None
  in
  let written_by_own_macro () =
    match loc.Loc.macro, loc.Loc.msite with
    | Some m, None -> qualifier m <> None && qualifier m = qualifier name
    | _ -> false
  in
  match Hashtbl.find_opt ctx.env.privates name with
  | Some (at, scope) when String.contains name '/' ->
    let real file = try Unix.realpath file with Unix.Unix_error _ -> file in
    let inside =
      match scope with
      | Ast.Private_to_file -> String.equal (real at.Loc.file) (real loc.Loc.file)
      | _ ->
        String.equal (Filename.dirname (real at.Loc.file))
          (Filename.dirname (real loc.Loc.file))
    in
    if not inside && not (written_by_own_macro ()) then begin
      let where =
        match scope with
        | Ast.Private_to_file -> real at.Loc.file
        | _ -> "the files in " ^ Filename.dirname (real at.Loc.file)
      in
      let name = written_name name in
      Loc.failk "check/private" loc
        ~notes:[ Loc.note at (Printf.sprintf "%s is declared here" name) ]
        "%s is private to its package: it is declared with defn-, so only %s \
         can use it. Declaring it with defn instead makes it usable from here"
        name where
    end
  | _ -> ()

(* One version of a name, as a line in a message: its parameters, named and
   typed, spelled the way the file around [loc] writes a function. *)
and version_text env loc v =
  let base = match version_of v with Some (b, _) -> b | None -> v in
  let names, tys =
    match Hashtbl.find_opt env.fns v, Hashtbl.find_opt env.gsigs v with
    | Some (ps, _), _ ->
      ( (match Hashtbl.find_opt env.fparams v with
         | Some fs -> List.map (fun (f : Ast.field) -> f.Ast.fname) fs
         | None -> []),
        ps )
    | None, Some (_, ps, _) ->
      ( (match Hashtbl.find_opt env.generics v with
         | Some fn -> List.map (fun (f : Ast.field) -> f.Ast.fname) fn.Ast.params
         | None -> []),
        ps )
    | None, None -> ([], [])
  in
  let param i t =
    let n = match List.nth_opt names i with Some n -> n | None -> "_" in
    if fln_source loc then n ^ ": " ^ tyname loc t
    else n ^ " " ^ tyname loc t
  in
  let ps = List.mapi param tys in
  if fln_source loc then base ^ "(" ^ String.concat ", " ps ^ ")"
  else "(" ^ base ^ " [" ^ String.concat " " ps ^ "])"

and shadows_builtin ctx loc name =
  (* Where the definition was written, if this name has one. A generic is in
     [generics] and nowhere near [fn_locs], so both tables are asked. *)
  let declared_in () =
    let name =
      match Hashtbl.find_opt ctx.env.versions name with
      | Some ((_, v) :: _) -> v
      | _ -> name
    in
    match Hashtbl.find_opt ctx.env.fn_locs name with
    | Some at -> Some at.Loc.file
    | None ->
      (match Hashtbl.find_opt ctx.env.generics name with
       | Some fn -> Some fn.Ast.nloc.Loc.file
       | None -> None)
  in
  (* A local of function type is lexical: it cannot be in scope anywhere but
     the file that bound it, so there is no file to compare. *)
  let local_fn () =
    match lookup ctx name with
    | Some b -> (match b.bty with Types.Fn _ -> true | _ -> false)
    | None -> false
  in
  Hashtbl.mem builtin_set name
  && (local_fn ()
      || (match declared_in () with
          | Some file -> String.equal file loc.Loc.file
          | None -> false))

(* ── 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" (written_name 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
  (* Does the signature bind [v] anywhere *inside* a type — [[$t]],
     [(Fn [$t $t] bool)], [(Vec $t)]? A bare [$t] parameter is a scalar the
     join below may move; a variable reached through a constructor is bound
     exactly, because a container's elements cannot be rewritten and a
     function value's type is its own. One scan, answered per variable. *)
  let rec mentions v (t : Types.t) =
    match t with
    | Types.Var u -> String.equal u v
    | Types.Slice (_, e) | Types.Array (_, e) | Types.Ptr (_, e) | Types.Vec e
    | Types.Option e -> mentions v e
    | Types.LArray (u, e) -> String.equal u v || mentions v e
    | Types.Map (k, w) -> mentions v k || mentions v w
    | Types.Fn (ps, r) | Types.CFn (ps, r) ->
      List.exists (mentions v) ps || mentions v r
    | Types.Named k ->
      (match Hashtbl.find_opt struct_apps k with
       | Some (_, args) -> List.exists (mentions v) args
       | None -> false)
    | _ -> false
  in
  let bound_exactly v =
    List.exists
      (fun (p : Types.t) ->
         match p with Types.Var _ -> false | t -> mentions v t)
      pats
  in
  (* Pairs that met no join while the arguments were walked. They are not
     refused on the spot because a *later* argument can still settle them:
     (f u32-x i32-y i64-z) has no join at the second argument and a perfectly
     good one — i64, which both widen into — at the third. Each entry is
     re-asked against the final binding below, so acceptance cannot depend on
     the order the arguments were written in. *)
  let pending = ref [] in
  let targs =
    map2_lr
      (fun pat a ->
         let p = subst_ty !subst pat in
         (* Which variable, if any, this parameter *is* — written as a bare
            [$t] and already bound by an argument to the left. That is the one
            shape implicit widening can reach, because [Types.widens_to] admits
            only numeric scalars: a variable bound inside [[$t]] or
            [(Fn [$t $t] bool)] leaves a parameter no widening applies to, so
            the [sort-by] path below is untouched by construction. *)
         let bound_scalar =
           match pat with
           | Types.Var v when (not (open_ty p)) && Types.is_numeric p ->
             Some v
           | _ -> None
         in
         (* An untyped constant has no type of its own to keep, so it still
            takes the variable's — [(clamp-to y 0 10)] with [y] an i64 means
            three i64s and there is no conversion anywhere in it. Everything
            else is checked on its own terms. *)
         let untyped_literal =
           match a.Ast.e with
           | Ast.Int _ | Ast.UInt _ | Ast.Float _ | Ast.Byte _ -> true
           | _ -> false
         in
         (* A bare [$t] an earlier argument bound to a slice or a pointer:
            this argument may differ from it only in const, and the two meet
            at the read-only one ([Types.const_join]), whichever came first.
            So it is checked on its own terms rather than against the
            binding. *)
         let bound_view =
           match pat, p with
           | Types.Var v, (Types.Slice _ | Types.Ptr _)
             when not (open_ty p || bound_exactly v) -> Some v
           | _ -> None
         in
         (* A typed .fln lambda, [(the (Fn [i32] i32) (fn ...))], at a
            [CFn($t) -> $t] parameter: the literal is a CFn at its own types,
            and those bind [$t] below as any argument's type would. *)
         let typed_cfn =
           match p, a.Ast.e with
           | Types.CFn _, Ast.The (t, { Ast.e = Ast.Fn _; _ }) ->
             (match resolve ctx.env t with
              | Types.Fn (ps, r) when fits_shape p (Types.CFn (ps, r)) ->
                Some (Types.CFn (ps, r))
              | _ -> None
              | exception Loc.Error _ -> None)
           | _ -> None
         in
         let a =
           if typed_cfn <> None then check ctx ~want:(Option.get typed_cfn) a
           else if open_ty p || bound_view <> None then check ctx a
           else if bound_scalar <> None && not untyped_literal then
             (* On its own terms first. A form that has no type without a want
                — [(zeroed)] is the one that matters — refuses here and is
                checked against the parameter as it always was; the trial
                leaves no trace of the attempt. *)
             (match trial ctx (fun () -> check ctx a) with
              | Ok r -> r
              | Error _ -> check ctx ~want:p a)
           else check ctx ~want:p a
         in
         (* **Mixed widths at one variable join at the wider type.** The rule
            used to refuse the pair both ways — TODO.org, "abs is one generic,
            and a bound joins to the wider type", records the join as the
            coherent alternative
            and refusing as the direction that could be walked back. It was
            walked back on 2026-09-20, by the author: a numeric argument at a
            variable an earlier argument already bound resolves the variable
            to whichever of the pair the other widens into, value-preserving
            widening only, so [(is-eq2 (i8 3) (i64 3))] and its reverse are one
            copy at i64. A pair with no join — u64 against i64 — is still
            refused: there is no type that holds every value of both, and
            inventing one would be picking a type neither argument was
            written at.

            Only where the variable is bound by bare scalars. A variable the
            signature also reaches through a container is bound exactly —
            a slice's elements cannot be rewritten to a wider width — so
            those keep the refusal, in their own words. And only where the
            pair is one widening has an opinion about: a string where $t was
            bound to i64 is an ordinary mismatch and gets the ordinary
            refusal below. *)
         let handled =
           match bound_view, Types.const_join p a.Tast.ty with
           | Some v, Some j ->
             subst := (v, j) :: List.remove_assoc v !subst;
             true
           | _ ->
           match bound_scalar with
           | Some v
             when (not (Types.equal p a.Tast.ty))
                  && Types.is_numeric a.Tast.ty ->
             (match Types.join p a.Tast.ty with
              | Some j when Types.equal j p ->
                (* This argument widens into the binding; the wrap happens
                   with the others, once the binding is final. *)
                true
              | Some j when not (bound_exactly v) ->
                subst := (v, j) :: List.remove_assoc v !subst;
                true
              | Some _ ->
                Loc.failk "check/tyvar-no-widening" a.Tast.loc
                  "%s's $%s was bound to %s by an earlier argument, and this \
                   one is %s. The signature also binds $%s inside a \
                   container or function type, which binds its element \
                   exactly — the pair cannot join at the wider type there. \
                   Write the conversion — (%s x) — or pass the arguments at \
                   one type"
                  (written_name name) v (tyname loc p) (tyname loc a.Tast.ty) v
                  (tyname loc p)
              | None ->
                pending := (v, p, a.Tast.ty, a.Tast.loc) :: !pending;
                true)
           | _ -> false
         in
         (* [~widen]: this is the top of an argument's type, which is the one
            place a widening thunk can be built around it. See [bind_ty]. *)
         if (not handled) && not (bind_ty ~widen:true subst p a.Tast.ty) then
           fail a.Tast.loc "%s expects %s here, found %s%s" (written_name name)
             (tyname loc p) (tyname loc a.Tast.ty)
             (match p, a.Tast.ty with
              | Types.Slice (Types.Mut, _), Types.Slice (Types.Const, e) ->
                Printf.sprintf
                  " — %s takes a slice it may write through, and a %s can \
                   only be read%s"
                  (written_name name) (tyname loc a.Tast.ty)
                  (match const_copy ctx.env e with
                   | Some c ->
                     Printf.sprintf ". %s copies v into one that can be written" c
                   | None -> "")
              | _ -> "");
         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" (written_name name) v)
    vars;
  (* The pairs that met no join, re-asked now that every argument has spoken.
     A later, wider argument dissolves one — u32 and i32 both widen into an
     i64 that arrived third — and one still standing is the real refusal:
     these two widths meet at no type. *)
  List.iter
    (fun (v, t1, t2, ploc) ->
       let final = List.assoc v !subst in
       let fits t =
         Types.equal t final || Types.widens_to ~from:t ~into:final
       in
       if not (fits t1 && fits t2) then
         Loc.failk "check/tyvar-no-join" ploc
           "this call binds %s's $%s to both %s and %s, and neither holds \
            every value of the other. Write the conversion you mean at one \
            of the arguments, or pass them at one type"
           (written_name name) v (tyname loc t1) (tyname loc t2))
    !pending;
  (* The binding is final; the arguments it out-widened catch up. Only a bare
     [$t] parameter can be here — [bound_exactly] kept every container-bound
     variable at one exact type — and the cast is the same node the written
     conversion would have built. *)
  let targs =
    map2_lr
      (fun (pat : Types.t) a ->
         match pat with
         | Types.Var v ->
           (match List.assoc_opt v !subst with
            | Some f
              when (not (Types.equal f a.Tast.ty))
                   && Types.is_numeric a.Tast.ty
                   && Types.widens_to ~from:a.Tast.ty ~into:f ->
              widen a.Tast.loc f a
            | Some f when Types.const_widens ~from:a.Tast.ty ~into:f ->
              { a with Tast.ty = f }
            | _ -> a)
         (* And the other widening, for the same reason and at the same
            moment: a [CFn] argument against an [(Fn [$t] $t)] parameter.
            A parameter that still mentioned a variable was checked with no
            expectation at all — there was nothing to expect until the
            argument had spoken — so [expect] never saw the pair and never
            built the value the instance's signature needs. It is built here,
            once the binding is final, exactly as the numeric catch-up above
            is.

            A *concrete* [Fn] parameter never reaches this: it was checked
            with a want in the first pass and [expect] widened it there.

            The arm is total over the pair, and that is the point of writing
            it as an [if] rather than as a guard. [bind_ty]'s fallthrough is
            [Types.fits], which admits [Never] where the instance's signature
            wants a type — so a binding can succeed over a pair these two
            words cannot bridge, and a fallthrough of "hand the argument over
            unchanged" would pass one word where the instance declares two.
            Every [CFn] arriving at an [Fn] parameter either gets its thunk
            here or gets the refusal, which is the answer [expect] gives a
            call with no type variables in it. *)
         | _ ->
           (match subst_ty !subst pat, a.Tast.ty with
            (* A plain value at a [$t?] parameter, which [bind_ty] bound
               through the Option: wrapped now that $t is known (decision
               138). *)
            | Types.Option _ as o, at
              when (match at with Types.Option _ | Types.Dyn | Types.Never -> false | _ -> true) ->
              expect ctx a.Tast.loc ~want:(Some o) a
            | Types.Fn (ps, r), Types.CFn (ps', r') ->
              if Types.equal (Types.Fn (ps, r)) (Types.Fn (ps', r')) then
                mk a.Tast.loc (Types.Fn (ps, r))
                  (Tast.Thicken (thick_thunk ctx.env a.Tast.loc ps r, a))
              else
                fail a.Tast.loc "%s expects %s here, found %s" (written_name name)
                  (tyname loc (Types.Fn (ps, r)))
                  (tyname loc a.Tast.ty)
            | _ -> a))
      pats targs
  in
  (* **A type variable is not instantiated at dyn.** Nothing stopped it before:
     [dyn] is an ordinary case of [Types.t], so it substituted like any other
     type and a copy was generated at it. The copy then reached whatever the
     body did with the value, and the dyn answers are not all there — [(Option
     dyn)] has no descriptor the collector can find, [slice] over a
     [(Vec dyn)] refuses. So the refusal existed, it just arrived from inside
     the generic's own source: [(or-else (Some d) e)] over two dyns is reported
     against [<prelude>:385], a line the caller did not write and cannot act
     on. Every one of those is this refusal arriving late and in the wrong
     place.

     Refusing at the binding is also the honest statement of the split. Two
     models answer "one body, many types" here and they are not rivals: this
     one instantiates at compile time and keeps the types, and [defgeneric] /
     [defmulti] dispatch at run time on a value that carries its own. A dyn
     argument is asking the second question of the first machinery. The
     message says so and names the other spelling.

     Bounded variables were already refused — [pred_holds] says no to dyn for
     all four predicates — so this closes the unbounded half, which is exactly
     the half that reached the prelude-source diagnostics. A variable that
     *does* carry a clause is left to that refusal deliberately: it names the
     predicate the signature actually wrote down, which is the more specific
     answer of the two, and the generic cast's pin depends on it. *)
  let clause_on v =
    match Hashtbl.find_opt ctx.env.generics name with
    | None -> false
    | Some gfn ->
      List.exists
        (fun (p : Ast.pred) -> String.equal p.Ast.pvar v) gfn.Ast.fwhere
  in
  List.iter
    (fun (v, t) ->
       if reaches_dyn t && not (clause_on v) then
         Loc.failk "check/tyvar-at-dyn" loc
           "this call would instantiate %s at $%s = %s, and a type variable \
            is not instantiated at dyn. Write the type the value has, or use \
            a defgeneric with a defmethod per class"
           (written_name name) v (tyname loc t))
    !subst;
  let cparams = List.map (subst_ty !subst) pats in
  let cret = subst_ty !subst pret in
  List.iter (realise ctx.env loc) (cret :: cparams);
  if List.exists open_ty cparams || open_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 [is-ordered] covers a callee wanting
       [is-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 %s, and this call passes the \
                 type variable $%s, which nothing here declares %s. Add \
                 %s to this function's own clause"
                (written_name name) (where_text loc p.Ast.pname ("$" ^ p.Ast.pvar)) v
                (pred_word p.Ast.pname) (where_text loc p.Ast.pname ("$" ^ v))
            | Some t when not (open_ty t) && not (pred_holds p.Ast.pname t) ->
              Loc.failk "check/predicate-unsatisfied" loc
                "%s is written %s, and this call passes %s, \
                 which is not %s"
                (written_name name) (where_text loc p.Ast.pname ("$" ^ p.Ast.pvar)) (tyname loc t)
                (pred_word p.Ast.pname)
            | _ -> ())
         gfn.Ast.fwhere);
    expect ctx loc ~want (mk loc cret (Tast.Call (name, targs)))
  end
  else
    let sym = instantiate ctx.env loc name vars !subst cparams cret in
    expect ctx 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 jreplace 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
    (* 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.

       Before the name-collision check, on purpose. The prelude keeps a
       per-width family beside a generic where the generic's bound refuses
       some widths — [abs] under [is-integer] beside the declared [abs-f32] and
       [abs-f64] — so a float caller of [abs] computes the sym [abs-f64], and
       "abs-f64 is already defined, rename one of them" is the wrong sentence
       for what went wrong: the bound refused the type, and that is the
       message with the fix in 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 is not %s. %s is \
                written %s — pass a type the predicate admits"
               (written_name gname) p.Ast.pvar (tyname loc t) (tyname loc t)
               (pred_word p.Ast.pname) (written_name gname)
               (where_text loc p.Ast.pname ("$" ^ p.Ast.pvar)))
      fn.Ast.fwhere;
    if Hashtbl.mem env.fns sym then
      fail loc
        "%s at these types is called %s, and %s is already defined — rename \
         one" gname sym sym;
    runaway env loc gname cparams;
    (* 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. *)
    jset cache ((cparams, cret, sym) :: !cache);
    jreplace 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. *)
    let saved_lens = env.lenvars and saved_ph = env.len_placeholder in
    env.subst <- List.map (fun v -> (v, List.assoc v subst)) vars;
    env.tyvars <- [];
    env.lenvars <- [];
    env.len_placeholder <- false;
    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;
      env.lenvars <- saved_lens; env.len_placeholder <- saved_ph
    in
    if Hashtbl.mem env.refused_generics gname then begin
      restore ();
      sym
    end else
    let tfn =
      (* Without recovery: a copy that does not check is refused whole, at
         the call that asked for it, as it always was. *)
      match speculate env (fun () -> !check_fn_ref env { fn with Ast.name = sym }) with
      | tfn -> restore (); tfn
      | exception e ->
        restore ();
        (* The refusal is inside the generic's source, which says nothing about
           which call asked for this copy; the note names it. Nested copies
           each add their own, so the notes walk the chain back to the call
           the programmer wrote. *)
        let at () =
          String.concat ", "
            (List.map
               (fun v -> Printf.sprintf "$%s = %s" v
                   (tyname loc (List.assoc v subst)))
               vars)
        in
        let in_prelude (l : Loc.t) = String.equal l.Loc.file Prelude.file in
        let e =
          match e with
          (* A prelude generic's body is source nobody at this call wrote, and
             an editor cannot jump to it. The refusal moves to the call that
             asked for the copy, and the prelude's line comes along as a
             note. *)
          | Loc.Error d when in_prelude d.Loc.dloc && not (in_prelude loc) ->
            (* Only the reason comes along. The rest of the body's message is
               a fix to the body, which the caller cannot make. *)
            let reason =
              let cut sep m =
                match find_sub m sep with
                | Some i -> String.sub m 0 i
                | None -> m
              in
              cut ". " (cut " — " d.Loc.dmsg)
            in
            Loc.Error
              (Loc.sort_notes
                 { d with
                   Loc.dloc = loc;
                   dmsg =
                     Printf.sprintf
                       "%s cannot be made at %s: its body in the prelude does \
                        not compile at that type. Pass a value of a type it \
                        takes, or write the operation here"
                       gname (at ());
                   notes =
                     d.Loc.notes
                     @ [ Loc.note d.Loc.dloc ("in the prelude, " ^ reason) ];
                   expansion = None })
          | Loc.Error d when d.Loc.dloc <> loc ->
            Loc.Error
              (Loc.sort_notes
                 { d with
                   Loc.notes =
                     d.Loc.notes
                     @ [ Loc.note loc
                           (Printf.sprintf "%s is instantiated at %s here"
                              gname (at ())) ] })
          | e -> e
        in
        (* 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. *)
        jset cache (List.filter (fun (_, _, s) -> s <> sym) !cache);
        jremove 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.Const, 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, 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.

   Widening (TODO.org, "Implicit numeric widening is legal; narrowing stays a
   hard error") does not retire that rule, it finishes it.
   Three things decide, in this order:

   1. An expectation, if the site has one, and it reaches *both* operands. So
      (defn f [] i64 (+ a b)) over two i32s widens each operand and adds at
      i64, rather than adding at i32 and widening the sum. That is the better
      of the two readings and it costs nothing to prefer it, because no program
      that compiled before can reach it — the pair used to be a refusal.
   2. A literal, exactly as before: it takes its width from the other operand,
      so (+ x 1) over a u64 x is still u64 arithmetic and (let [h fnv-offset])
      over a u64 defconst still means what it meant. [needs_want] is what marks
      the forms this applies to and it is untouched.
   3. Otherwise the *wider* side decides — [Types.join], whichever operand the
      other widens into, with a [Cast] put on the narrower one. (+ i32-var
      i64-var) is an i64 add. Equal width across signedness has no join, by
      construction: neither i32 nor u32 widens into the other, and the refusal
      says which cast to write.

   The mechanism for 3 is a *trial*: ask y for [a]'s type, and if that refusal
   is the one widening was invented for, look again the other way round. Two
   things have to be true for a trial to be honest, and both are below.

   [trial] is the first. Checking is not a function of its argument — it
   allocates frame slots and it opens scopes — so a check that is abandoned
   has to leave no trace, and [scoped] cannot help: it restores the scope on
   the way *out*, which an exception does not take. Without this a binding
   from the abandoned pass outlives it, which is visible as a name that should
   be unknown resolving anyway, and worse, as a shadow: the inner binding of
   (let [t ...] ... (let [t ...] t) ... t) survives into the outer t's slot
   with nothing ever stored in it. That is an uninitialised read, produced by
   a program the compiler accepted.

   [literal_at_want] is the second. A trial that refused because a *literal*
   could not be built at the wanted type is not a pair of types that failed to
   meet — the literal had no type of its own to bring — so looking again would
   answer with the literal's default and quietly move (+ u8-thing 300) to i32.
   Rule 2 above is not a description of the old language kept for continuity;
   it is what the author decided, and the kind is how the trial obeys it. *)
and trial ctx f =
  (* Everything a check writes into the context, put back if the check is
     abandoned — and it is *everything* on purpose, not a chosen subset.

     Picking the fields that looked like they mattered was tried twice and was
     wrong twice. [scope] and the slot fields were the first round, found as an
     uninitialised read. The second round was worse, because the symptom was
     the other way up: a form that opens a window and closes it on the way out
     — [check_frames] setting [in_frames], [loop] pushing onto [loops] — leaves
     that window *open* when a trial inside it is abandoned, and then refuses
     a perfectly good program.

       (println (+ i32-x (handler-bind [] i64-y)))
       (return 0)

     compiled before this lane and was refused after it, with "return is not
     allowed inside handler-bind yet" pointing at a line with no handler-bind
     anywhere near it. A false refusal is not a lesser bug than a false accept;
     it is just quieter about being one.

     So the rule here is not judgement, it is the whole record. Three fields
     would have self-healed anyway — [defer_ok] and [tail] are read and cleared
     on entry to [check], [outer_what] is never written after the context is
     built — and they are restored regardless, because "this one cannot
     currently leak" is exactly the reasoning that produced two rounds of
     leaks. The destructuring below is closed and warning 9 is turned on for
     it, so a new field on [ctx] stops this function compiling until somebody
     decides about it, rather than joining the list of things nobody noticed.

     [env] is put back the same way, whole, by [snapshot_env]: a function
     lifted, a generic copy made and cached, a struct registered — all of it
     goes together, since keeping one of a pair without the other is how a
     copy ends up calling a lambda that was never emitted.

     Only [Loc.Error] is caught. A timeout or a stack overflow is not a
     refusal to reconsider, and silently continuing past one would turn a
     resource failure into a wrong answer. *)
  let[@warning "+9"] { env = _; ret = _; lits = _; slots; slot_tys; slot_names; as_slots; scope;
                       defers; defer_slot; defer_ok; defer_block; outer = _;
                       outer_what; caught; place_ok; envslot; parent = _;
                       in_frames; loops; tail; used; kept; in_defer;
                       owner = _ } = ctx in
  let undo, keep = snapshot_env ctx.env in
  match speculate ctx.env f with
  | r -> keep (); Ok r
  | exception Loc.Error d ->
    undo ();
    ctx.slots <- slots; ctx.slot_tys <- slot_tys;
    ctx.slot_names <- slot_names; ctx.as_slots <- as_slots; ctx.scope <- scope;
    ctx.defers <- defers; ctx.defer_slot <- defer_slot;
    ctx.defer_ok <- defer_ok; ctx.defer_block <- defer_block;
    ctx.outer_what <- outer_what; ctx.in_frames <- in_frames;
    ctx.caught <- caught; ctx.place_ok <- place_ok; ctx.envslot <- envslot;
    ctx.loops <- loops; ctx.tail <- tail; ctx.used <- used; ctx.kept <- kept;
    ctx.in_defer <- in_defer;
    Error d
  | exception e -> keep (); raise e

(* Whether the trial's refusal is one worth reconsidering. A literal that did
   not fit is not, and neither is a refusal a program cannot make any use of
   having a second opinion on. *)
and reconsiderable (d : Loc.diag) = not (String.equal d.Loc.kind literal_at_want)

(* [a] was checked, y refused [a]'s type, and [b] is y on its own terms — held
   by the caller when it has one, taken here when it does not. If the pair has
   a join it can only be [b]'s type (had it been [a]'s, the trial would have
   passed), so [a] is the operand that moves. *)
and join_widen (a : Tast.expr) (b : Tast.expr) =
  match Types.join a.Tast.ty b.Tast.ty with
  | Some t when not (Types.equal t a.Tast.ty) ->
    Some (widen a.Tast.loc t a, widen b.Tast.loc t b)
  | _ -> None

and join_pair ctx (a : Tast.expr) (y : Ast.expr) (d : Loc.diag) =
  (* Check y on its own terms to find out whether it was simply the wider
     operand. This trial is guarded too: if y cannot check without an
     expectation at all — [None], [(zeroed)] — the original refusal is the one
     reported, so no form loses the expectation it used to get. *)
  match trial ctx (fun () -> check ctx y) with
  | Error _ -> raise (Loc.Error d)
  | Ok b ->
    (match join_widen a b with
     | Some pair -> pair
     | None -> raise (Loc.Error d))

(* [y] checked at [w] in a trial, and a refusal kept ([arm_failed]) so the
   same operand asked again at the same type, in the same scope, is refused
   without being walked: a chain of these nested in their second operands is
   asked once per level above it. *)
and trial_at ctx (y : Ast.expr) (w : Types.t) =
  match
    List.find_opt
      (fun (n, (sc, r), w', _) ->
         n == y && r == ctx.ret && Types.equal w' w && same_scope sc ctx.scope)
      (Hashtbl.find_all arm_failed y.Ast.loc)
  with
  | Some (_, _, _, d) -> Error d
  | None ->
    (match trial ctx (fun () -> check ctx ~want:w y) with
     | Ok b -> Ok b
     | Error d ->
       if !lit_recording = 0 then Hashtbl.add arm_failed y.Ast.loc (y, (ctx.scope, ctx.ret), w, d);
       Error d)

and binary ctx ?(dyn_ok = false) ?(join = true) ?(char_ok = false) name loc ~want args =
  match args with
  | [ x; y ] ->
    lit_operands ctx x y (fun () -> binary_pair ctx ~dyn_ok ~join ~char_ok loc ~want x y)
  | _ -> fail loc "%s takes two arguments" name

(* An operator's two operands, while literal locals' uses are recorded: one
   beside a literal local says the type it meets it at ([Hint]), and two of
   them are merged. Checked exactly as ever, so a round whose guesses hold is
   the program. *)
and lit_operands ctx (x : Ast.expr) (y : Ast.expr) f =
  let key (e : Ast.expr) =
    match e.Ast.e with Ast.Var n -> lit_recorded ctx n | _ -> None
  in
  match ctx.lits, key x, key y with
  | Some s, kx, ky when kx <> None || ky <> None ->
    let float_lit (e : Ast.expr) = lit_kind e = Some `Float in
    (* A char local beside an integer literal stays a char: the pair is char
       arithmetic, or a comparison the checker refuses (decision 131). Only
       typed code that wants a particular integer makes it a number. *)
    let lit_add s k ((_, _, _) as c) (other : Ast.expr) =
      match lit_kind k, lit_kind other with
      | Some `Char, Some `Int -> ()
      | _ -> lit_add s k c
    in
    (* Before the check, which refuses a float literal beside an integer
       guess. *)
    (match kx, ky with
     | Some k, _ when float_lit y -> lit_add s k (Hint, Types.Float (float_default ()), y.Ast.loc) y
     | _, Some k when float_lit x -> lit_add s k (Hint, Types.Float (float_default ()), x.Ast.loc) x
     | _ -> ());
    let saved = !lit_operand_locs in
    lit_operand_locs := x.Ast.loc :: y.Ast.loc :: saved;
    let a, b =
      try Fun.protect ~finally:(fun () -> lit_operand_locs := saved) f
      with Loc.Error _ as ex ->
        (* Refused at the guess, as (+ acc x) is over an i32 guess and an
           i64 x: what the other operand is on its own terms is the use. *)
        let own (k, (other : Ast.expr)) =
          match trial ctx (fun () -> check ctx other) with
          | Ok e -> lit_add s k (Hint, e.Tast.ty, other.Ast.loc) other
          | Error _ -> ()
        in
        (match kx, ky with
         | Some k, None -> own (k, y)
         | None, Some k -> own (k, x)
         | _ -> ());
        raise ex
    in
    (match kx, ky with
     | Some k1, Some k2 -> lit_union s k1 k2
     | Some k, None -> lit_add s k (Hint, b.Tast.ty, y.Ast.loc) y
     | None, Some k -> lit_add s k (Hint, a.Tast.ty, x.Ast.loc) x
     | None, None -> ());
    a, b
  | _ -> f ()

and binary_pair ctx ~dyn_ok ~join ~char_ok loc ~want (x : Ast.expr) (y : Ast.expr) =
    (* A char defconst no local shadows reads as the literal it names. *)
    let is_literal (e : Ast.expr) =
      is_literal e
      || (match e.Ast.e with
          | Ast.Var n ->
            Hashtbl.mem char_consts n && lookup ctx n = None
            && peek_outer ctx n = None
          | _ -> false)
    in
    let y_decides =
      (is_literal x && not (is_literal y))
      || (match x.Ast.e, y.Ast.e with
          | (Ast.Int _ | Ast.UInt _ | Ast.Byte _), Ast.Float _ -> true
          | _ -> false)
    in
    (* A form that cannot be checked without being told what is wanted. A
       literal takes its width from the expectation, and a keyword has no
       meaning at all without one — [:lo] resolves against the enum the site
       expects and there is no keyword type to fall back on. Everything else
       checks on its own terms. *)
    let needs_want (f : Ast.expr) =
      is_literal f || (match f.Ast.e with Ast.Kw _ -> true | _ -> false)
    in
    (* A dyn the want opened is put back: beside a dyn a typed operand gives
       dyn (rule 117), so the pair is the dyn runtime's and only its answer
       is opened at the want. Opening the operand first made (+ p 1 1) at an
       i32 want an i32 add that wraps, where (+ 1 1 p) was a dyn add whose
       answer traps at the i32. *)
    let reopen (v : Tast.expr) =
      if not dyn_ok then v
      else match opened_dyn ~box:(to_dyn ctx) v with Some d -> d | None -> v
    in
    if y_decides then begin
      let b = reopen (check ctx ?want y) in
      (* An integer literal before a char, under [+] or [-], is an integer:
         the pair is char arithmetic ([char_step]). *)
      let a =
        match x.Ast.e with
        | (Ast.Int _ | Ast.UInt _) when char_ok && b.Tast.ty = Types.Char ->
          check ctx x
        | _ -> check ctx ~want:b.Tast.ty x
      in
      a, b
    end
    (* [dyn_ok] is set by the operators that have a dyn lowering, and it exists
       to stop the second operand being coerced to the first's type before
       anybody has asked whether the pair is a dyn one.

       Without it [(+ n x)] over an [i64] n and a dyn x threads [i64] into the
       second check, [expect] does what an annotation site asked for and
       unboxes, and the result is a *machine* add of a value the runtime was
       never asked about: the program traps on a float instead of promoting,
       and nothing in the source says why. The mirror image [(+ x n)] boxed
       correctly, so the bug was visible only in one operand order.

       Both sides are checked on their own terms here and the caller decides.
       That is safe exactly when neither operand needs an expectation, which is
       what [needs_want] settles — a literal still gets the first operand's
       type, so [(+ x 1)] over a dyn x goes on building an i64 one. *)
    else if dyn_ok && not (needs_want y) then begin
      let a = reopen (check ctx ?want x) in
      (* y at [a]'s type first, and on its own terms only if that is
         refused: checking it both ways every time made a chain of these
         nested in their second operands twice as slow per level. A dyn
         opened at [a]'s type is seen for what it was. *)
      let at_a =
        if a.Tast.ty = Types.Dyn then None
        else
          Some (trial_at ctx y a.Tast.ty)
      in
      match at_a with
      | Some (Ok b') ->
        (match opened_dyn ~box:(to_dyn ctx) b' with Some box -> a, box | None -> a, b')
      | _ ->
      let b = check ctx y in
      (* Nothing dyn about this pair after all, so it is put back the way the
         typed path built it. Re-checking only when the types actually differ
         keeps the common case to one check of each operand. *)
      if a.Tast.ty = Types.Dyn || b.Tast.ty = Types.Dyn
         || Types.equal a.Tast.ty b.Tast.ty
      then a, b
      (* Asking y for [a]'s type stays the first thing tried, and not only for
         continuity: y was checked above with no expectation at all, and an
         expectation is information. A sum of two products handed to an f32
         function is the case — test/programs/math.flan does it — because every
         literal inside those products defaults to f64 on its own terms, so
         reading the join off the two unexpected halves would answer f64 for a
         form the site asked to be f32. The re-check builds them at f32 as it
         always did.

         [b] is only used when that re-check refuses, which is the direction
         [expect] cannot serve: a is the narrower operand and it is the one
         that has to move. Nothing is checked a third time — the own-terms [b]
         already in hand is the answer. *)
      else
        (match
           match at_a with
           | Some (Error d) -> Error d
           | _ -> trial_at ctx y a.Tast.ty
         with
         | Ok b' -> a, b'
         | Error d ->
           (match
              if join && reconsiderable d then join_widen a b else None
            with
            | Some pair -> pair
            | None -> raise (Loc.Error d)))
    end
    else begin
      let a = reopen (check ctx ?want x) in
      match trial_at ctx y a.Tast.ty with
      | Ok b -> a, b
      | Error d ->
        (* The join moves [a] to something wider, and [a] already has the
           type asked of the whole: that can only be refused, so y is not
           walked on its own terms to find it out. *)
        let doomed =
          match want with Some w -> Types.equal a.Tast.ty w | None -> false
        in
        if join && reconsiderable d && not doomed then join_pair ctx a y d
        else
          (* Doomed: said the way the join would have been refused — the
             pair at the wider type, at this form — when y's own refusal
             names the wider type it found. *)
          match want, (if doomed then Found.find_opt mismatch_found d else None) with
          | Some w, Some found
            when String.equal d.Loc.dloc.Loc.file y.Ast.loc.Loc.file
                 && d.Loc.dloc = y.Ast.loc ->
            (match Types.join w found with
             | Some j when not (Types.equal j w) ->
               ignore (expect ctx loc ~want:(Some w) (mk loc j Tast.Unit));
               raise (Loc.Error d)
             | _ -> raise (Loc.Error d))
          | _ -> raise (Loc.Error d)
    end

(* ── 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
   ([is-numeric], [is-ordered], [is-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 *)
    ("+", "+ [is-numeric ...] is-numeric",
     "Sum, folded left over two or more operands. Two operands of different \
      numeric types meet at the wider one when that cannot lose — i32 and i64 \
      add at i64 — and i32 with u32 has no such type and is refused.");
    ("-", "- [is-numeric ...] is-numeric",
     "Difference, folded left: (- a b c) is ((a - b) - c). With one operand, \
      its negation: (- x).");
    ("*", "* [is-numeric ...] is-numeric",
     "Product, folded left over two or more operands of one numeric type.");
    ("/", "/ [is-numeric ...] is-numeric",
     "Quotient, folded left. Integer division truncates toward zero.");
    ("%", "% [is-numeric is-numeric] is-numeric",
     "Remainder, and it stays at two operands: (% a b c) would mean \
      (% (% a b) c), which is a thing nobody writes on purpose.");
    ("=", "= [is-equal ...] bool",
     "Equality, chained over two operands or more: (= a b c) is a = b and \
      b = c, which is every operand alike. It admits two types < does not: a \
      handle, where \"the same entity\" is the question the type exists to \
      answer, and a string, compared bytewise by content rather than \
      ordered.");
    ("!=", "!= [is-equal ...] bool",
     "All different: (!= a b c) is true when every operand differs from every \
      other, so (!= 1 2 1) is false. Over everything = accepts. A float NaN \
      is != to everything, itself included.");
    ("<", "< [is-ordered ...] bool",
     "Less than, chained: (< a b c) is a < b and b < c, and every operand is \
      evaluated once. Machine numbers and enums only — ordering a handle \
      would order a free-list slot index, which means nothing.");
    ("<=", "<= [is-ordered ...] bool", "Less than or equal, chained like <.");
    (">", "> [is-ordered ...] bool", "Greater than, chained like <.");
    (">=", ">= [is-ordered ...] bool",
     "Greater than or equal, chained like <.");
    ("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; a && b in a .fln file. Integers only; operands \
      of different widths meet at the wider one, the way + does.");
    ("bit-or", "bit-or [int ...] int",
     "Bitwise or, folded left over integers; a || b in a .fln file.");
    ("bit-xor", "bit-xor [int ...] int",
     "Bitwise exclusive or, folded left over integers; a ^^ b in a .fln file.");
    ("bit-not", "bit-not [int] int",
     "Every bit of an integer flipped; ~~a in a .fln file.");
    ("&&", "&& [int ...] int", "bit-and, by its .fln spelling.");
    ("||", "|| [int ...] int", "bit-or, by its .fln spelling.");
    ("^^", "^^ [int ...] int", "bit-xor, by its .fln spelling.");
    ("~~", "~~ [int] int", "bit-not, by its .fln spelling.");
    ("<<", "<< [int int] int",
     "Left shift. The value's type decides — a narrower count widens to it, a \
      wider one is refused — and a literal count at or past the value's width \
      is refused too. On a dyn int, a count outside 0 to 63 traps.");
    (">>", ">> [int int] int",
     "Right shift, arithmetic on a signed type and logical on an unsigned one. \
      The value's type decides and the count widens to it; a literal count at \
      or past the width is refused, as it is for <<.");
    ("rotate-left", "rotate-left [int int] int",
     "The bits of the value moved left by the count, the ones that fall off \
      the top coming back in at the bottom. The count is taken modulo the \
      width.");
    ("rotate-right", "rotate-right [int int] int",
     "The bits of the value moved right by the count, wrapping round to the \
      top. The count is taken modulo the width.");
    ("popcount", "popcount [int] int",
     "How many bits of the integer are set. The answer has the operand's \
      type.");
    ("leading-zeros", "leading-zeros [int] int",
     "How many zero bits come before the highest set bit, counted within the \
      operand's width: the width itself for 0.");
    ("trailing-zeros", "trailing-zeros [int] int",
     "How many zero bits come after the lowest set bit: the width for 0.");
    ("min", "min [is-ordered ...] is-ordered",
     "The smallest of two or more operands, each of them evaluated exactly \
      once however many there are. Two widths meet at the wider: (min i8-x \
      i16-y) is an i16.");
    ("max", "max [is-ordered ...] is-ordered",
     "The largest of two or more operands, each evaluated exactly once.");
    ("max-value", "max-value [type] T",
     "The largest value of a numeric type: (max-value u8) is 255, and at a \
      float the largest finite value. Takes a type variable under \
      {:where (is-numeric $t)}.");
    ("min-value", "min-value [type] T",
     "The least value of a numeric type: (min-value i8) is -128, 0 at an \
      unsigned type, and at a float the negation of the largest finite value.");
    ("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.");
    ("filled", "filled [u8] T",
     "Every byte of whatever it is being stored into set to one byte, as in \
      (set grid (filled 0xFF)). Numbers only, and structs and fixed arrays \
      built out of them.");
    ("dead-beef", "dead-beef [u32?] T",
     "A four-byte pattern repeating over whatever it is being stored into, \
      written so a hex dump reads it left to right: 0xDEADBEEF with no \
      argument, the u32 given otherwise. A size that is not a multiple of \
      four ends on a prefix of the pattern. Same types [filled] takes.");
    ("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-temp", "free-temp [] ()",
     "Releases everything in the temp allocator, context/temp — where \
      i64->bytes and f64->bytes put their text. Called once a frame; a dev \
      build also does it at every frame boundary the agent polls at. Text \
      kept past the frame is cloned out first.");
    ("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.");
    ("free", "free [(Vec T)|(Map K V)|String|[T] Allocator?] ()",
     "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. A slice (bytes s) or (clone xs) \
      made goes back to the current allocator, or the one named; a dev build \
      traps on a slice from another allocator or not from one at all.");
    ("clone", "clone [(Vec T)|(Map K V)|String|[T] Allocator?] (Vec T)|(Map K V)|String|[T]",
     "A deep, independent copy, from the current allocator or one named. \
      A slice's copy is a slice over a new block, released by (free s) or by \
      its allocator's free-all. Refused for elements that own \
      storage: a bytewise copy would alias the original's blocks under a \
      name promising otherwise.");
    ("into-copies-elements", "into-copies-elements [src dst transform...] ()",
     "What into writes when its chain has no (map f). Refuses a source whose \
      elements own storage, because pushing them as they stand would share \
      their blocks. Not meant to be written by hand.");

    (* String *)
    ("string-new", "string-new [(str|String)? Allocator?] String",
     "A String: owned, growable text that is always valid UTF-8. Empty, or \
      a copy of the text given; from the current allocator or one named, and \
      released by (free s). A str is checked as it is copied in.");
    ("bytes->string", "bytes->string [(Vec u8) Allocator?] String",
     "A new String holding a copy of the Vec's bytes, once they are checked \
      to be UTF-8 — here, at run time. Bytes that are not stop the program \
      at this call. The Vec is untouched and is still yours to free.");
    ("append", "append [String str|String|i32] ()  append [(Vec u8) [const u8]] ()",
     "Adds text or one code point to the end of a String. A str is checked \
      to be UTF-8 as it is stored and a code point to be a Unicode scalar \
      value; a literal is checked when the program is compiled. Onto a \
      (Vec u8), or a pointer to one, it adds raw bytes.");
    ("insert", "insert [String i32 str|String|i32] ()",
     "Stores text or a code point before the character at position i, \
      counting characters and not bytes; i may be the character count, \
      which is the end. Checked as append checks, and a position past the \
      end signals BoundsError.");
    ("remove", "remove [String i32] i32",
     "Takes out the character at position i, counting characters, and \
      answers its code point. A position past the end signals BoundsError.");
    ("runes", "runes [str|String|[const u8]] Runes",
     "A cursor over the text's chars: (runes-next (addr it)) answers \
      the next one, or None at the end. A malformed byte in a str comes back \
      as U+FFFD.");
    ("rune-count", "rune-count [str|String|[const u8]] i32",
     "How many characters — code points — the text holds, where length \
      counts bytes. A malformed byte counts as one.");

    (* (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]|[collection i32 ...] (Option V)|(Option T)",
     "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. Over an array, a slice, a string or a Vec it is at that \
      answers None for an index out of range, negative included, one index \
      per dimension. Over a dyn it answers nil for an absent key or index, \
      and more keys walk a level each.");
    ("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)) ...).");
    ("??", "?? [(Option T)|dyn T ...] T",
     "x ?? d in .fln: what x holds, or d when x is None (nil over a dyn). d is \
      evaluated only then. a ?? b ?? c reads from the right, and a default \
      that is itself an Option keeps the whole an Option.");
    ("?", "? [(Option T)|dyn] bool",
     "x? in .fln: whether x holds a value — Some, or a dyn that is not nil. \
      In if x?, elif x? and while x?, a local x is its payload in the block.");
    ("!!", "!! [(Option T)|dyn] T",
     "x! in .fln: what x holds. When x is None (nil over a dyn) the program \
      stops there, naming x.");
    ("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. Over a dyn map \
      it is the question that stays askable when nil might also be stored \
      under the key.");
    ("class-of", "class-of [dyn] dyn",
     "The class's name as a keyword for a value built by a defclass \
      constructor, and nil for everything else — an ordinary map included. \
      It is what a defgeneric dispatches on, so a class dispatcher is this \
      call over the first argument and a defmulti whose body is (class-of x) \
      is the same generic function written the other way.");
    ("type-of", "type-of [dyn] dyn",
     "The value's kind as a keyword — :nil :bool :int :float :text :vec \
      :keyword :map :char — or, for a value built by a defclass constructor, the \
      class's name as class-of answers it. A typed value answers the kind it \
      has as a dyn value: an i32 is :int.");
    ("chars", "chars [dyn] dyn",
     "A dyn text's characters, as a new dyn vector of chars. A dyn text \
      counts characters, not bytes, in length, at and slice.");
    ("text", "text [dyn] dyn",
     "The dyn text a dyn vector of chars, or a single char, spells: \
      (text (chars t)) is t.");
    ("keyword", "keyword [str|[const u8]] dyn",
     "The interned dyn keyword named by the bytes, for a name that only \
      exists at run time — a reader building :texture-path out of a token's \
      text. A literal :foo is already one.");

    (* assets, embedded at compile time *)
    ("embed", "embed [\"path\" str?] [const u8]",
     "The file's bytes, read at compile time and baked in as a constant; \
      (embed \"p\" str) reads it as a str 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.");
    ("compile-error", "compile-error [\"message\"] ()",
     "Refuses the compile with that message, at the form it is written in. \
      What a macro expands to when it has to say why: a name nothing defines \
      carries a name, and this carries a sentence.");

    (* files *)
    ("slurp", "slurp [str 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 [str [const 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 [str] ()",
     "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 [str] ()",
     "Creates the directory, or signals FileError. () for the reason \
      delete-file answers one.");
    ("rename-file", "rename-file [str str] ()",
     "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 *)
    ("length", "length [[n T]|[T]|str|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. A str and a String count bytes, as rune-count \
      does not; a dyn text counts characters.");
    ("at", "at [collection i32 ...] T",
     "The element at an index, bounds-checked — and for a Vec with the \
      allocator's epoch checked first. On a string it is the byte, a u8. It \
      is also a place, so (set (at v i) x) goes through the same check; a \
      string is the exception, being a view it does not own.");
    ("slice", "slice [[n T]|[T]|str|(Vec T) i32? i32?] [T]|str",
     "The half-open range [lo hi) as a non-owning view. lo defaults to 0 and \
      hi to the length, so (slice a) is the whole of it and (slice a n) is \
      the tail from n. A bound may sit one past the end; a literal pair that \
      runs backwards is refused here. A string slices to a string. A view of \
      a Vec is a borrow from storage the Vec owns, and a push, a put or a \
      reserve on that Vec may invalidate it.");
    ("slice-from", "slice-from [(Ptr T) n] [T]",
     "Puts a length on a pointer that came back from C; n is any integer \
      type. The caller promises it addresses that many initialised T and that \
      they outlive the result; the compiler checks none of it. A negative n \
      traps in every build.");
    ("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. Where an (Option T) is \
      expected a T is wrapped with no Some written, one level at a time; an \
      Option is never unwrapped that way.");

    (* the host primitives *)
    ("bytes", "bytes [str Allocator?] [u8]",
     "A writable copy of the string's bytes, from the current allocator or \
      one named. It allocates like vec-new does — a failure signals \
      StorageExhausted with retry — and (free b) releases it, through the \
      current allocator or (free b a) through the one it came from. For reading without a copy, \
      bytes-view.");
    ("bytes-view", "bytes-view [str|String] [const u8]",
     "The string's own storage seen as a read-only byte slice. It costs \
      nothing — both are a ptr and a length at run time — and it decodes \
      nothing. A store through it is a compile error; bytes is the writable \
      copy.");
    ("str", "str [[const u8]|String] str",
     "A byte slice, or a String's text, seen as a str, and free at run time. \
      A String's str lasts until the String next changes. It does not check \
      UTF-8, because `str` does not claim UTF-8 — is-valid-utf8 is an \
      ordinary function you call when you care.");
    ("char", "char [int|char|dyn] char",
     "A code point as a char. Only a Unicode scalar value is one — 0 to \
      0x10FFFF, outside 0xD800 to 0xDFFF: a literal is checked when it \
      compiles and any other value when it runs. (i32 c) is the way back.");
    ("bytes->f64", "bytes->f64 [[const u8]] f64", "Parses a float out of the bytes.");
    ("bytes->i64", "bytes->i64 [[const u8]] i64",
     "Parses an integer out of the bytes.");
    ("f64->bytes", "f64->bytes [f64] [u8]",
     "The number's text, %g, in the temp allocator: it lasts until the next \
      (free-temp). Clone it to keep it longer.");
    ("i64->bytes", "i64->bytes [i64] [u8]",
     "The number's text, in the temp allocator: it lasts until the next \
      (free-temp). Clone it to keep it longer.");
    ("write-stdout", "write-stdout [[const u8]] ()",
     "Writes the bytes to standard output exactly as given: no newline and \
      no formatting.");
    ("print", "print [T ...] ()",
     "The structural printer, selected for each argument's concrete type; \
      arguments print in order with a single space between them. 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 — (println) alone is the newline.");
    ("watch", "watch [str T] ()",
     "Writes the value, rendered as print renders it, into the dev session's \
      watch table under the name, where M-x flan-watch shows it. Does nothing \
      when no watch buffer is open. Outside a dev build it only evaluates \
      the value.");
    ("exit", "exit [i32] never",
     "Ends the process with this status. It has no value, so nothing written \
      after it runs.");
    ("argv", "argv [] [str]", "The command line, as a slice of strings.");

    (* the 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.");
    ("nil", "nil dyn",
     "The absent dyn value: what (get m k) answers for a key a dyn map does \
      not hold. It becomes None where an (Option T) is wanted, and stays dyn \
      everywhere else.");
    ("None", "None (Option T)",
     "The absent Option. It takes its type from its context — a return type, \
      a parameter, or (the (Option i32) None) — 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.")
  ]

(* The forward reference declared beside [nearest], filled the moment the table
   it names exists. Nothing reads it before a call is checked, and no call is
   checked before this module is loaded. *)
let () =
  builtin_names := List.map (fun (n, _, _) -> n) builtins;
  List.iter (fun (n, _, _) -> Hashtbl.replace builtin_set n ()) builtins

(* ── The one thing shadowing owes the reader ────────────────────────────
   A defn named after a builtin is legal and it wins ([shadows_builtin]), and
   that is a large thing to have happened in silence: every [(get m k)] in
   the file now means something the reader has to go and look at. So it is
   said once, where the decision was made, and never again at the call sites
   — a footgun notice, not a lint.

   It is a warning and it says so in the one way that matters: nothing raises
   and the exit status does not move. Unlike [memory_sites] it is behind no
   flag, because there is nothing to tune — a program either renamed a
   builtin or it did not, and the line is one line and rare.

   The second half of the sentence names the way out. Until [builtin/] there
   was none: a file that defined [length] had given the builtin [length] up
   for the
   whole file, and a defn that meant to *wrap* it was unbounded recursion
   instead. Saying so here is the cheapest place it can be said — the reader
   is being told the name was taken over, and the next thing they want to
   know is what is left.

   The prelude is skipped: its defns are the language's own and a collision
   there is a compiler bug rather than news for whoever is compiling. So are
   qualified names, for the reason [shadows_builtin]'s [visible] gives —
   [rl/get] is not [get] and shadows nothing. *)
let shadowed_builtins (decls : Ast.decl list) : Loc.diag list =
  (* Once per name: the arities of one fn are one definition. *)
  let said = Hashtbl.create 4 in
  List.filter_map
    (fun (d : Ast.decl) ->
       match d.Ast.d with
       | Ast.Defn fn
         when Hashtbl.mem builtin_set fn.Ast.name
              && not (Hashtbl.mem said fn.Ast.name)
              && (Hashtbl.replace said fn.Ast.name (); true)
              && not (String.contains fn.Ast.name '/')
              && not (String.equal fn.Ast.nloc.Loc.file Prelude.file) ->
         Some
           (Loc.diag ~kind:"check/shadows-builtin"
              (* A fn with several arities is warned about at its fn line. *)
              (if fn.Ast.fgroup <> None then d.Ast.dloc else fn.Ast.nloc)
              (Printf.sprintf
                 "%s shadows the builtin %s — every call in this program now \
                  reaches your definition — the builtin stays reachable as %s%s"
                 fn.Ast.name fn.Ast.name builtin_prefix fn.Ast.name))
       | _ -> None)
    decls

(* ── 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
  | Ast.Call ({ Ast.e = Ast.Var "-"; _ }, [ x ]) ->
    Option.map Int64.neg (const_int env x)
  (* A conversion to an integer type, which is how a negative number is
     written as an unsigned constant's bit pattern: [(u64 -1)]. Truncated to
     the type's width and extended by its sign, as the cast does at run time. *)
  | Ast.Call ({ Ast.e = Ast.Var k; _ }, [ x ])
    when Types.ikind_of_name k <> None ->
    let k = Option.get (Types.ikind_of_name k) in
    let bits = Types.bits k in
    Option.map
      (fun n ->
         if bits = 64 then n
         else if Types.signed k then
           Int64.shift_right (Int64.shift_left n (64 - bits)) (64 - bits)
         else Int64.logand n (Int64.sub (Int64.shift_left 1L bits) 1L))
      (const_int env x)
  (* 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

(* [(defconst grid [rows [cols u8]])]. A two-element defconst has no type slot
   — the second form is always a value — so the brackets were read as an array
   *literal* and [u8] as a name in it, and the refusal that came out was
   "unknown name u8", which sends the reader to look for a missing definition
   of something the language has had all along.

   A type name inside an array literal is unambiguous evidence, because a type
   and a value cannot share a name: [collect]'s claimed table is over every
   declaration kind there is. So finding one means the whole form was meant as
   a type, and the form that takes one is [defonce]. *)
let rec defconst_type_shaped env gname (v : Ast.expr) =
  match v.Ast.e with
  | Ast.Arr items ->
    List.iter
      (fun (i : Ast.expr) ->
         match i.Ast.e with
         | Ast.Var n when is_type_name env n ->
           Loc.failk "check/defconst-is-a-type" i.Ast.loc
             "%s is a type, and this is a value: a two-element defconst has no \
              type slot, so the brackets around it were read as an array \
              literal and %s as a name in it. A global declared by its type is \
              a defonce — write (defonce %s ...) with the same brackets"
             n n gname
         | _ -> defconst_type_shaped env gname i)
      items
  | _ -> ()

(* Every parent a struct names, now that every struct has its fields.

   A parent has exactly [Error]'s two fields, [name string] and
   [message string], and that is not a style rule: a handler that matched
   through the link is handed the signal site's descriptor rather than the
   condition, because the condition's layout is its own type's and the
   handler's type is an ancestor's. The descriptor's first two fields are the
   name and the sentence, so a parent shaped any other way would be read off
   bytes that are not its fields. *)
let check_parents env =
  Hashtbl.iter
    (fun child parent ->
       let loc =
         Option.value (Hashtbl.find_opt env.locs child) ~default:Loc.unknown
       in
       if not (error_shaped env parent) then begin
         let has =
           match Hashtbl.find_opt env.structs parent with
           | Some { Tast.fields = []; _ } -> "none"
           | Some s ->
             String.concat " "
               (List.map
                  (fun (f : Tast.field) ->
                     f.Tast.fname ^ " " ^ Types.to_string f.Tast.fty)
                  s.Tast.fields)
           | None -> "none"
         in
         let fix =
           match Hashtbl.find_opt env.parents parent with
           | Some _ -> Printf.sprintf "(defstruct %s :parent %s)" parent
                         (Hashtbl.find env.parents parent)
           | None -> Printf.sprintf "(defstruct %s :parent Error)" parent
         in
         fail loc
           "%s names %s as its parent, and a parent has exactly the fields \
            [name string message string], because a handler for a parent is \
            handed the name and the message of whatever it caught. %s has \
            [%s]. Declare it with no field vector, %s, which gives it those \
            two"
           child parent parent has fix
       end;
       (* A cycle is a chain with no root; the walk stops at the repeat. *)
       let chain = condition_chain env child in
       match Hashtbl.find_opt env.parents (List.nth chain (List.length chain - 1)) with
       | Some back ->
         fail loc
           "%s's parents go round in a loop, %s -> %s, and a chain of parents \
            has to end at a type with no parent, such as Error"
           child (String.concat " -> " chain) back
       | None -> ())
    env.parents

(* Untyped constants 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. *)
(* ── One fn, several arities (decision 139) ─────────────────────────────
   [fn f] with [(g: Grain) -> bool] and [(r: i32, c: i32) -> bool] under it
   is one function with two arities, and a call picks one by how many
   arguments it passes. [Parse.splice] made one [defn] per arity, all at the
   form's location; nothing past the checker knows either: each arity is
   renamed here to a name of its own, and from then on it is an ordinary
   function with an ordinary symbol, cell and stale-call word. The [~] is
   what keeps the renamed name out of a program's reach — it ends a symbol in
   both readers — as it does for [prelude~].

   A fn with one arity keeps its name, so its symbol is what it always was;
   only a name with two or more is renamed, all of its arities alike, so no
   arity is the plain name's by accident of order.

   The form is the unit of definition, Clojure's: the arities are closed, and
   a second [fn f] anywhere is [f] defined twice whatever its arity, since
   letting it add one would make which arities exist depend on which files
   were read. Types play no part in the choice. *)
let split_versions env (decls : Ast.decl list) : Ast.decl list =
  let arities = Hashtbl.create 16 in
  List.iter
    (fun (d : Ast.decl) ->
       match d.Ast.d with
       | Ast.Defn fn ->
         let n = fn.Ast.name and k = List.length fn.Ast.params in
         let seen = Option.value ~default:[] (Hashtbl.find_opt arities n) in
         (match seen with
          | (_, _, group, gloc) :: _
            when fn.Ast.fgroup = None || group <> fn.Ast.fgroup ->
            let fln = fln_source d.Ast.dloc in
            Loc.failk "check/defined-twice" d.Ast.dloc
              ~notes:[ Loc.note gloc (n ^ " is already defined here") ]
              "%s is defined twice. A function with several arities is one \
               definition, each arity under it:\n\n%s"
              n
              (if fln then
                 Printf.sprintf
                   "    fn %s\n      (a: T) -> R\n        ...\n      \
                    (a: T, b: T) -> R\n        ..." n
               else
                 Printf.sprintf "    (defn %s ([a T] R ...) ([a T b T] R ...))" n)
          (* [main] is called by the startup code, by its own name, so it has
             one arity. *)
          | (_, first, _, _) :: _ when String.equal n "main" ->
            Loc.failk "check/defined-twice" fn.Ast.nloc
              ~notes:[ Loc.note first "main's other arity is here" ]
              "main has one arity: the program's startup calls it by its \
               name"
          | _ -> ());
         (match List.find_opt (fun (j, _, _, _) -> j = k) seen with
          | Some (_, first, _, _) ->
            Loc.failk "check/defined-twice" fn.Ast.nloc
              ~notes:[ Loc.note first "the other one is here" ]
              "%s has two arities with %d parameter%s. Each arity takes a \
               different number of arguments, which is how a call picks one"
              n k (if k = 1 then "" else "s")
          | None -> ());
         Hashtbl.replace arities n
           (seen @ [ (k, fn.Ast.nloc, fn.Ast.fgroup, d.Ast.dloc) ])
       | _ -> ())
    decls;
  Hashtbl.iter
    (fun n seen ->
       if List.length seen > 1 then
         Hashtbl.replace env.versions n
           (List.sort compare
              (List.map (fun (k, _, _, _) -> (k, version_name n k)) seen)))
    arities;
  if Hashtbl.length env.versions = 0 then decls
  else
    List.map
      (fun (d : Ast.decl) ->
         match d.Ast.d with
         | Ast.Defn fn when Hashtbl.mem env.versions fn.Ast.name ->
           let v = version_name fn.Ast.name (List.length fn.Ast.params) in
           { d with Ast.d = Ast.Defn { fn with Ast.name = v } }
         | _ -> d)
      decls

let settle_consts env consts =
  let infer (_, v) =
    with_typed_literals (fun () -> (check (invented_ctx env Types.Unit) v).Tast.ty)
  in
  let pending = ref consts in
  let rec settle () =
    let left =
      List.filter
        (fun ((n, _) as c) ->
           match speculate env (fun () -> 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

(* Set by [collect], read by [build_program] once [infer_returns] ran. *)
let consts_after_infer : (string * Ast.expr) list ref = ref []

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 [defonce item] are two
     declarations of one name and are rejected here. *)
  (* The qualifier is reserved on this side too. [(defn builtin/length ...)]
     reads — the reader treats [/] as an ordinary symbol character — and would
     otherwise land in [env.fns] under a name nothing can ever call, because
     [named_call] strips the prefix before any table is consulted. A
     declaration that can only ever be dead is refused where it is written
     rather than left to be discovered. [Load] refuses the same qualifier from
     the other direction, at an import's alias. *)
  List.iter
    (fun (d : Ast.decl) ->
       match Ast.declared_name d with
       | Some n when qualified_builtin n <> None ->
         fail d.Ast.dloc
           "%s cannot be declared: %s is a reserved qualifier, so a name \
            spelled with it reaches the compiler's builtins and never a \
            declaration — nothing could call this one"
           n builtin_prefix
       (* [[const u8]] is a read-only slice only because no constant can be
          named [const]: [[n T]] takes a constant's name for [n], and a
          declaration of that name would make the brackets mean two things.
          A local cannot be an array length, so only a declaration is
          refused. *)
       | Some "const" ->
         Loc.failk "check/reserved-const" d.Ast.dloc
           "const cannot be declared: it is reserved for the read-only slice \
            type, [const T]. Choose another name"
       | _ -> ())
    decls;
  let claimed = Hashtbl.create 64 in
  let is_defn (d : Ast.decl) = match d.Ast.d with Ast.Defn _ -> true | _ -> false in
  List.iter
    (fun (d : Ast.decl) ->
       match Ast.declared_name d with
       | None -> ()
       | Some n ->
         (match Hashtbl.find_opt claimed n with
          (* Two [defn]s of one name are either the arities of one fn or one
             name defined twice, and the arities are known only once the
             parameter vectors are paired — [split_versions], below
             [pair_decls], says which. *)
          | Some (_, true) when is_defn d -> ()
          | 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, is_defn d)))
    decls;
  (* A defstruct whose fields introduce a variable is a template. *)
  let generic_fields (fs : Ast.field list) =
    let vs, _, _ =
      sigil_vars ~kinds_of:(fun _ -> None)
        (List.map (fun (f : Ast.field) -> f.Ast.fty) fs)
    in
    vs <> []
  in
  let gpending = Hashtbl.create 4 in
  (* 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, fs, parent) when generic_fields fs ->
         (match parent with
          | Some t ->
            fail t.Ast.tloc
              "%s is generic, and a condition struct is not — a handler \
               matches one type, and %s is a type only at its arguments" n n
          | None -> ());
         Hashtbl.replace env.locs n d.Ast.dloc;
         Hashtbl.replace gpending n (fs, d.Ast.dloc)
       | 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 = [] }
       (* [int] and [float] are builtin aliases (Types), and a program that
          declared them itself — which this one's author did, before they were
          builtin — must not quietly stop meaning what it says. The alias
          table is never consulted for either name: [resolve_name] answers
          from [ikind_of_name] first, so a [(defalias int i64)] left to
          register would be read as [i32] at every use and nothing would ever
          say so.

          So the target decides. Spelled as the builtin's own type, the
          declaration is true and is accepted as the no-op it is — the old
          program still compiles, and deleting the line is a cleanup rather
          than a fix. Spelled as anything else it is refused, because the only
          alternative is to silently mean something else. Nothing is written
          to the table either way: the name resolves without it. *)
       | Ast.Defalias (n, { Ast.t = Ast.Tname target; _ })
         when n = "int" || n = "float" ->
         let builtin = if n = "int" then "i32" else "f32" in
         if target <> builtin then
           Loc.failk "check/builtin-alias" d.Ast.dloc
             "%s is a builtin alias for %s and cannot be redefined as %s — \
              delete this defalias, or give the type another name"
             n builtin target
       | Ast.Defalias (n, _) when n = "int" || n = "float" ->
         let builtin = if n = "int" then "i32" else "f32" in
         Loc.failk "check/builtin-alias" d.Ast.dloc
           "%s is a builtin alias for %s and cannot be redefined — delete \
            this defalias, or give the type another name"
           n builtin
       | Ast.Defalias (n, t) -> Hashtbl.replace env.aliases n t
       | _ -> ())
    decls;
  (* Each template's parameters, which needs every other template's: a
     template's length argument to another is a length of its own. A cycle
     between templates reads the arguments on it as types; any length among
     them is then refused where it is used. *)
  let rec params_of visiting n =
    match Hashtbl.find_opt env.gstructs n with
    | Some g -> Some (List.map snd g.gparams)
    | None ->
      match Hashtbl.find_opt gpending n with
      | None -> None
      | Some _ when List.mem n visiting -> None
      | Some (fs, gloc) ->
        let _, _, vs =
          sigil_vars ~kinds_of:(params_of (n :: visiting))
            (List.map (fun (f : Ast.field) -> f.Ast.fty) fs)
        in
        Hashtbl.replace env.gstructs n { gparams = vs; gfields = fs; gloc };
        Some (List.map snd vs)
  in
  Hashtbl.iter (fun n _ -> ignore (params_of [] n)) gpending;
  (* 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 =
    (* The flag is reset through [Fun.protect] because a refusal here does not
       end the run: [program_all] carries on collecting diagnostics, and a
       flag left set would misword every later unknown-type message. *)
    env.in_field <- true;
    let fty =
      Fun.protect ~finally:(fun () -> env.in_field <- false)
        (fun () -> 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
  Hashtbl.reset char_consts;
  (* 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
  let decls = split_versions env decls in
  (* And for the same reason, at the same point: a three-element defonce is a
     type or a value by name, and every type name is registered by here. *)
  let decls = settle_defvars 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" -> ()
           (* Its own arm, because the general advice below is wrong for it and
              dangerously so. A dyn is one machine word and would cross without
              complaint — [(Ptr dyn)] is not the fix and there is nothing for a
              shim to read: what the C side would receive is a word whose
              meaning only the dyn runtime knows, and C has no way to ask.
              Refused by name rather than let through as an integer. *)
           | Types.Dyn ->
             fail loc
               "%s of %s is dyn, which does not cross to C — take the value \
                at a written type and pass that"
               what fn.Ast.name
           (* Its own arm too, because "pass (Ptr T)" is nonsense for a
              function and the real objection is worth stating. A [CFn] is
              one word and is the right *shape* for a C callback — that is
              what it is for — but a Flan function's emitted signature still
              ends with the transfer channel, and a C caller knows nothing
              about one. So the address is not a C function pointer yet, and
              what would make it one is dropping the channel from a signature
              that cannot transfer (TODO.org, "CFn and C's calling
              convention"). A [Fn] is two words
              and is not even the right shape. *)
           | Types.CFn _ | Types.Fn _ ->
             fail loc
               "%s of %s is %s, and a Flan function's address is not a C \
                function pointer yet — not even a CFn's. Its signature ends \
                with the transfer channel, and a C caller knows nothing \
                about one; the C in CFn is about having no environment, \
                which is what a C function pointer would need, and not about \
                crossing today. Write the callback in C, or give the binding \
                a (Ptr ()) and let the shim pass C's own"
               what fn.Ast.name (tyname loc t)
           | _ ->
             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
               (tyname loc t) (tyname loc 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;
         Hashtbl.replace env.extern_locs fn.Ast.name loc
       | Ast.Defalias _ -> ()
       | Ast.Defstruct (n, fs, _) when Hashtbl.mem env.gstructs n ->
         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;
         (* The template is checked once, here, at its variables: an unknown
            type in a field is refused at the defstruct rather than at the
            first use of it. *)
         let g = Hashtbl.find env.gstructs n in
         (match
            struct_copy ~at_definition:true env loc n
              (List.map (fun (p, _) -> Types.Var p) g.gparams)
          with
          | _ -> ()
          | exception Loc.Error d ->
            Hashtbl.replace env.broken n ();
            defer_or_raise env d)
       | Ast.Defstruct (n, fs, parent) ->
         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;
         (* The parent is recorded here and its shape checked once every
            struct has its fields, below, since it may be declared later. *)
         (match parent with
          | None -> Hashtbl.remove env.parents n
          | Some t ->
            (match resolve env t with
             | Types.Named pn when Hashtbl.mem env.structs pn ->
               if String.equal pn n then
                 fail t.Ast.tloc "%s cannot be its own parent" n;
               Hashtbl.replace env.parents n pn
             | pt ->
               fail t.Ast.tloc
                 "%s names %s as its parent, and a parent is a condition \
                  struct, such as Error, the root every error descends from"
                 n (tyname loc pt)));
         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. *)
         (* A dyn field used to be refused here, for the reason a condition's
            was: the collector's roots are the frames, and a struct outlives
            the frame that built it, so its dyn field was a live value
            reachable only through memory the marker never walked. The
            per-type descriptors lifted that. A struct that holds a dyn now
            gets a descriptor saying at which byte offsets its dyn words sit,
            and every slot, global and temporary that holds one goes on the
            collector's root stack with that descriptor beside it — see
            runtime/flan_dyn.h's [flan_dyn_root_push_desc], which is also where
            the reason no instance carries a header word is written down.

            What is still refused is a dyn the descriptor cannot reach: one
            inside a typed container, behind a pointer, or in a data type's
            payload, where the offset is not a static property of the type.
            That refusal is [hidden_dyn] below, and it is made over the whole
            program rather than here, because the type that hides it may be
            declared after the one that names it. *)
         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 — 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 — 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 ->
         missing_return_type env 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, lens = signature_tyvars env 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%s"
                  p.Ast.pvar fn.Ast.name
                  (if vars = [] then " — it binds none"
                   else
                     " — it binds "
                     ^ String.concat ", " (List.map (fun v -> "$" ^ v) vars));
              (* A where clause takes type predicates, and a length is not a
                 type. Whether it should take value predicates over one is
                 an open question in TODO.org, not an accident to fall out
                 of this. *)
              if List.mem p.Ast.pvar lens then
                defer_or_raise env
                  (Loc.diag ~kind:"check/length-predicate" p.Ast.ploc
                     (Printf.sprintf
                        "$%s is a length, and a where clause takes type \
                         predicates only — %s is about a type"
                        p.Ast.pvar p.Ast.pname)))
           fn.Ast.fwhere;
         (* A predicate over a length was refused above; what is left is the
            clause every copy is judged against. *)
         let fn =
           { fn with
             Ast.fwhere =
               List.filter
                 (fun (p : Ast.pred) -> not (List.mem p.Ast.pvar lens))
                 fn.Ast.fwhere }
         in
         env.tyvars <- vars;
         env.lenvars <- lens;
         env.tvpreds <- fn.Ast.fwhere;
         let params, ret =
           Fun.protect
             ~finally:(fun () ->
               env.tyvars <- []; env.lenvars <- []; env.tvpreds <- [])
             (fun () ->
                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 -> Some Types.Unit
                  (* Read off the body by [infer_returns], once every
                     written signature is in [fns]; until then the name
                     has none. *)
                  | Some { Ast.t = Ast.Tinfer; tloc } ->
                    if vars <> [] then
                      Loc.failk "check/infer-generic" tloc
                        "%s is generic, and _ asks for its return type to be \
                         read off one body — but each call site makes its own \
                         copy. Write the return type, in terms of the $ \
                         variables"
                        fn.Ast.name;
                    None
                  | Some t -> Some (resolve env t)
                in
                params, ret)
         in
         if fn.Ast.fprivate <> Ast.Exported then
           Hashtbl.replace env.privates fn.Ast.name
             (fn.Ast.nloc, fn.Ast.fprivate);
         if vars = [] then begin
           Option.iter
             (fun ret -> Hashtbl.replace env.fns fn.Ast.name (params, ret))
             ret;
           Hashtbl.replace env.fparams fn.Ast.name fn.Ast.params;
           Hashtbl.replace env.fn_locs fn.Ast.name fn.Ast.nloc
         end
         else begin
           let ret = Option.get ret in
           Hashtbl.replace env.generics fn.Ast.name fn;
           Hashtbl.replace env.gsigs fn.Ast.name (vars, params, ret);
           Hashtbl.replace env.glens fn.Ast.name lens
         end
       | Ast.Defvar (n, t, _, k) ->
         let ty = match t with
           | Some t -> resolve env t
           | None ->
             fail loc "%s %s needs a type"
               (match k with Ast.Once -> "defonce" | Ast.Every -> "def") n
         in
         Hashtbl.replace env.globals n (ty, false);
         Hashtbl.replace global_forms n k;
         Hashtbl.replace env.global_locs n loc
       | Ast.Defconst (n, Some t, _) ->
         Hashtbl.replace env.globals n (resolve env t, true);
         Hashtbl.replace env.global_locs n loc
       | Ast.Defconst (n, None, v) ->
         (match v.Ast.e with
          | Ast.Byte b -> Hashtbl.replace char_consts n b
          | _ -> ());
         defconst_type_shaped env n v;
         Hashtbl.replace env.global_locs n loc;
         untyped := (n, v) :: !untyped
       (* [Classes.expand] ran at the top of [build_program] and left none of
          these behind, the way [Shim.expand] leaves no [declare-c] behind. A
          driver that assembled a declaration list and skipped that pass would
          otherwise get a missing name from wherever the constructor was
          called, with nothing pointing here. *)
       | Ast.Defclass (n, _) ->
         fail loc
           "internal: the class %s reached the checker unpaired — \
            pair_decls writes its constructor, and did not run" n
       | Ast.Defgeneric { Ast.name = n; _ }
       | Ast.Defmulti { Ast.name = n; _ } ->
         fail loc
           "internal: %s reached the checker unexpanded — Classes.expand did \
            not run over this declaration list" n
       | Ast.Defmethod m ->
         fail loc
           "internal: a method of %s reached the checker unexpanded — \
            Classes.expand did not run over this declaration list" m.Ast.mgen)
    decls;
  (* The untyped constants ([settle_consts]). One that calls a [_] function
     waits for [infer_returns], which needs every signature this pass
     registers; it is settled after that, and its refusal is the one a
     written return type would get. *)
  let inferred_names =
    List.filter_map
      (fun (d : Ast.decl) ->
         match d.Ast.d with
         | Ast.Defn { Ast.name; ret = Some { Ast.t = Ast.Tinfer; _ }; _ } ->
           Some name
         | _ -> None)
      decls
  in
  let waits (_, v) =
    let acc = ref [] in
    Load.expr_uses acc v;
    List.exists (fun (n, _) -> List.mem n inferred_names) !acc
  in
  let late, now = List.partition waits (List.rev !untyped) in
  consts_after_infer := late;
  settle_consts env now;
  check_parents env;
  (* 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 walk _ n = finite_from env n in
  (* A generic struct's copy was asked this when it was made. *)
  Hashtbl.iter
    (fun n _ -> if not (Hashtbl.mem env.copies n) then 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 — 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 — \
         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 ────────────────────────────── *)

(* The names a body hands back or stores into: every name mentioned in a value
   it answers — its last form's tails, a [return]'s value — and the name at
   the root of every [set] place. A parameter among them is not warned at for
   growing: the grown copy goes back to the caller, or the copy is the
   function's own business. *)
let escaping_names ~returns (body : Ast.expr list) : string list =
  let names = ref [] in
  let rec mentions (e : Ast.expr) =
    (match e.Ast.e with Ast.Var n -> names := n :: !names | _ -> ());
    ignore (Ast.map_children (fun x -> mentions x; x) e)
  in
  let rec tails (e : Ast.expr) =
    match e.Ast.e with
    | Ast.Do es | Ast.Let (_, es) ->
      (match List.rev es with x :: _ -> tails x | [] -> ())
    | Ast.If (_, a, b) -> tails a; Option.iter tails b
    | Ast.IfLet (_, a, b) ->
      (match List.rev a.Ast.body with x :: _ -> tails x | [] -> ());
      Option.iter tails b
    | Ast.Chain (_, _, b) -> tails b
    | Ast.Match (_, arms) ->
      List.iter
        (fun (a : Ast.arm) ->
           match List.rev a.Ast.body with x :: _ -> tails x | [] -> ())
        arms
    (* A value that is the parameter, a field of it, or a literal built with
       it. A call's result is its callee's business, and a unit form — the
       push itself, last in a function that returns nothing — answers
       nothing. *)
    | Ast.Var _ | Ast.Field _ | Ast.Struct _ | Ast.Bare _ | Ast.Arr _
    | Ast.MapLit _ -> mentions e
    | _ -> ()
  in
  let rec root (e : Ast.expr) =
    match e.Ast.e with
    | Ast.Var n -> names := n :: !names
    | Ast.Field (x, _) -> root x
    | Ast.Call ({ Ast.e = Ast.Var ("at" | "deref"); _ }, x :: _) -> root x
    | _ -> ()
  in
  let rec walk (e : Ast.expr) =
    (match e.Ast.e with
     | Ast.Return (Some x) -> tails x
     | Ast.Set (Ast.Pvar n, _) -> names := n :: !names
     | Ast.Set ((Ast.Pfield (x, _) | Ast.Pindex (x, _) | Ast.Pderef x
                | Ast.Pslot (x, _)), _) -> root x
     | _ -> ());
    ignore (Ast.map_children (fun x -> walk x; x) e)
  in
  List.iter walk body;
  if returns then (match List.rev body with x :: _ -> tails x | [] -> ());
  !names

let rec check_fn ?sign env (fn : Ast.fn) : Tast.fn =
  let params, ret =
    match sign with Some s -> s | None -> Hashtbl.find env.fns fn.Ast.name
  in
  (* A [_] body whose type could not be read stands in [fns] as Never (see
     [infer_returns]); pass two reads it the same way again, so its errors
     are reported here, once, with every other body's. *)
  let ret =
    match sign, fn.Ast.ret with
    | None, Some { Ast.t = Ast.Tinfer; _ }
      when Hashtbl.mem env.infer_failed fn.Ast.name ->
      infer_ret
    | _ -> ret
  in
  let ctx = { (invented_ctx env ret) with owner = fn.Ast.name } in
  let was_unnarrowable = !unnarrowable in
  unnarrowable := unnarrowable_in fn.Ast.fbody;
  Fun.protect ~finally:(fun () -> unnarrowable := was_unnarrowable) @@ fun () ->
  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 grow_before = !grow_warnings in
  let grow_saved = !grow_params in
  grow_params :=
    ( ctx,
      List.filter_map
        (fun (p : Ast.field) ->
           Option.map (fun b -> (b.slot, p)) (List.assoc_opt p.Ast.fname ctx.scope))
        fn.Ast.params )
    :: grow_saved;
  let escaping =
    lazy
      (let names =
         escaping_names ~returns:(not (Types.equal ret Types.Unit)) fn.Ast.fbody
       in
       List.filter_map
         (fun (p : Ast.field) ->
            if List.mem p.Ast.fname names then Some p.Ast.floc else None)
         fn.Ast.params)
  in
  Fun.protect
    ~finally:(fun () ->
        grow_params := grow_saved;
        let added =
          List.filteri
            (fun i _ -> i < List.length !grow_warnings - List.length grow_before)
            !grow_warnings
        in
        if added <> [] then
          grow_warnings :=
            List.filter
              (fun (d : Loc.diag) ->
                 not (List.mem d.Loc.dloc (Lazy.force escaping)))
              added
            @ grow_before)
  @@ fun () ->
  let body =
    match fn.Ast.fbody with
    | [] ->
      if Types.equal ret Types.Unit || ret == infer_ret then []
      else fail fn.Ast.nloc "%s returns %s but has no body" (written_name fn.Ast.name)
             (tyname fn.Ast.nloc 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 || ret == infer_ret 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
      (* A dyn function whose value-giving form gives none — a [while], a
         [set] — reaches [box]'s unit refusal, which can only say that () is
         not a dyn value. Here the function is known, so the refusal is
         restated as what went wrong with it. Only a refusal at the body's
         own tail is: one deeper in the last form (a unit argument to a dyn
         parameter) is about that argument and keeps its own message. *)
      let rec tail_locs (e : Ast.expr) =
        e.Ast.loc
        :: (match e.Ast.e with
            | Ast.Do es | Ast.Let (_, es) ->
              (match List.rev es with x :: _ -> tail_locs x | [] -> [])
            | Ast.If (_, a, b) ->
              tail_locs a @ (match b with Some b -> tail_locs b | None -> [])
            | _ -> [])
      in
      let restate_unit last (d : Loc.diag) =
        let at (l : Loc.t) =
          l.Loc.file = d.Loc.dloc.Loc.file && l.Loc.line = d.Loc.dloc.Loc.line
          && l.Loc.col = d.Loc.dloc.Loc.col
        in
        if d.Loc.kind = "check/dyn-unit" && Types.equal ret Types.Dyn
           && List.exists at (tail_locs last)
        then
          Loc.diag ~kind:"check/dyn-unit" d.Loc.dloc
            (Printf.sprintf
               "%s is declared to return dyn, but the last form of its body \
                gives no value. End the body with the value to return (nil \
                for none), or declare %s to return nothing: %s"
               fn.Ast.name fn.Ast.name
               (if fln_source d.Loc.dloc then
                  Printf.sprintf "fn %s(...) -> ()" fn.Ast.name
                else Printf.sprintf "(defn %s [...] () ...)" fn.Ast.name))
        else d
      in
      (* The refusal arrives either raised or, under recovery, recorded on
         [env.recovered] while checking goes on; both are restated. *)
      let check_last last =
        let env = ctx.env in
        let before = env.recovered in
        let r =
          try check ctx ?want last
          with Loc.Error d -> Loc.raise_diag (restate_unit last d)
        in
        let rec fresh = function
          | l when l == before -> l
          | d :: rest -> restate_unit last d :: fresh rest
          | [] -> []
        in
        env.recovered <- fresh env.recovered;
        r
      in
      let rec go = function
        | [ last ] ->
          ctx.defer_ok <- true;
          [ (if is_defer last then check ctx last else check_last 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 =
    let ends_never =
      match List.rev body with
      | (last : Tast.expr) :: _ -> Types.equal last.Tast.ty Types.Never
      | [] -> false
    in
    match ctx.defers with
    | [] -> body
    (* A body read only for its type is thrown away after. *)
    | _ when ret == infer_ret -> body
    (* A body that never falls off the end — its last form a [return], say —
       has no fall-off path to put the defers on, and a copy of them there is
       code after a terminator. *)
    | _ when ends_never -> 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
  (* The counter's zero, at the top of the body and above every store to it.
     Nothing else in the function reads the slot, so this is the whole of its
     cost on the path that never transfers. *)
  let body =
    match ctx.defer_slot with
    | None -> body
    | Some s -> defer_counter_zero s fn.Ast.nloc :: body
  in
  let checked =
  { Tast.name = fn.Ast.name; params;
    slots = Array.of_list (List.rev ctx.slot_tys);
    snames = Array.of_list (List.rev ctx.slot_names); as_slots = ctx.as_slots;
    (* The same defers again, for the transfer exit path §5 describes. The
       normal path has them spliced into [body] above; this one is guarded on
       the count, because a transfer can start above a defer that the text has
       not reached and cleanup over an unwritten binding is not cleanup. *)
    ret; body;
    fdefers =
      (match ctx.defer_slot with
       | None -> ctx.defers
       | Some s -> guarded_defers s ctx.defers);
    fenv = None; fparent = None; floc = fn.Ast.nloc }
  in
  let checked =
    if sign = None && ret == infer_ret then
      (* Pass two over a [_] body pass one could not read: its errors are
         raised above; a body that checks has the refusal pass one made
         about its exits, or waited on one that did, and stands as Never. *)
      match Hashtbl.find_opt env.infer_failed fn.Ast.name with
      | Some (Some d) -> raise (Loc.Error d)
      | _ -> { checked with Tast.ret = Types.Never }
    else checked
  in
  refuse_frame_escapes checked;
  checked

(* 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 and saved_lens = env.lenvars
  and saved_ph = env.len_placeholder in
  (* The body sees a length variable's array at [abstract_len], an ordinary
     array every array operation already answers for; the signature keeps
     its [Types.LArray] for call sites to bind against. *)
  let rec at_placeholder (t : Types.t) =
    match t with
    | Types.LArray (_, e) -> Types.Array (abstract_len, at_placeholder e)
    | Types.Slice (m, e) -> Types.Slice (m, at_placeholder e)
    | Types.Array (n, e) -> Types.Array (n, at_placeholder e)
    | Types.Ptr (m, e) -> Types.Ptr (m, at_placeholder e)
    | Types.Vec e -> Types.Vec (at_placeholder e)
    | Types.Option e -> Types.Option (at_placeholder e)
    | Types.Map (k, v) -> Types.Map (at_placeholder k, at_placeholder v)
    | Types.Fn (ps, r) -> Types.Fn (List.map at_placeholder ps, at_placeholder r)
    | Types.CFn (ps, r) ->
      Types.CFn (List.map at_placeholder ps, at_placeholder r)
    | t -> t
  in
  let params = List.map at_placeholder params and ret = at_placeholder ret in
  env.tyvars <- vars;
  env.lenvars <-
    Option.value (Hashtbl.find_opt env.glens fn.Ast.name) ~default:[];
  env.len_placeholder <- true;
  (* 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;
  jreplace env.fns fn.Ast.name (params, ret);
  let finish () =
    jremove env.fns fn.Ast.name;
    env.lifted <- saved_lifted;
    env.tyvars <- saved_vars;
    env.tvpreds <- saved_preds;
    env.lenvars <- saved_lens;
    env.len_placeholder <- saved_ph
  in
  (match check_fn env fn with
   | _ -> finish ()
   | exception e -> finish (); raise e)

(* ── Return types read off the body ([_]) ────────────────────────────
   Between the two passes: every written signature is in [fns], and a [defn]
   whose return slot is [_] gets its entry here, from its own body and
   nothing else — never a call site (docs/SPIKE-INFERENCE.md, "The cheap
   first step"). Its parameters are written, so the body checks exactly as it
   would with the type written, and the Tast is thrown away: pass two checks
   the body again against the type found, which is what keeps literals and
   [return]s coerced the way a written signature would coerce them.

   One such body may call another, so the bodies are read callees first and
   then to a fixpoint, the untyped-[defconst] loop's shape. A cycle among
   them never settles and is refused by name; a body that calls its own name
   is the cycle of one. *)

(* The type one body gives, and the form that decided it. The exits — the
   last form and every [return], less what never arrives — meet at
   [arm_join], the function an [if]'s arms meet at, in any order: the typed
   ones decide and the lone literals take their type; literals alone meet at
   the wider of their own types. The body is then checked against that type
   exactly as a written one would be, so whatever [if] refuses between its
   arms is refused between exits, in the same words. None gives (); no value
   beside a value is refused, since () does not take a value's place. *)
and read_return env (fn : Ast.fn) params =
  (* One check of the body against [ret], thrown away with everything it
     wrote into [env] ([snapshot_env]); pass two checks it again for real. *)
  let attempt ret =
    let undo, _ = snapshot_env env in
    let seen = !infer_seen in
    infer_seen := [];
    let restore () = undo (); infer_seen := seen in
    match speculate env (fun () -> check_fn ~sign:(params, ret) env fn) with
    | exception e -> restore (); raise e
    | tf ->
      let returns = List.rev !infer_seen in
      restore ();
      (tf, returns)
  in
  let tf, returns = attempt infer_ret in
  let last =
    match List.rev tf.Tast.body, List.rev fn.Ast.fbody with
    | (x : Tast.expr) :: _, (a : Ast.expr) :: _ ->
      [ (x.Tast.ty, x.Tast.loc, adapts a) ]
    | (x : Tast.expr) :: _, [] -> [ (x.Tast.ty, x.Tast.loc, false) ]
    | [], _ -> []
  in
  let arrive =
    List.filter (fun (t, _, _) -> not (Types.equal t Types.Never)) (returns @ last)
  in
  let unit (t, _, _) = Types.equal t Types.Unit in
  (match List.find_opt unit arrive, List.find_opt (fun x -> not (unit x)) arrive with
   | Some (_, bare, _), Some (t, valued, _) ->
     Loc.failk "check/infer-mixed" bare
       ~notes:[ Loc.note valued ("this gives " ^ tyname valued t) ]
       "%s gives no value here and %s on another path, and its return \
        type is read off its body. Give this path a value too, or write \
        the return type"
       fn.Ast.name (tyname bare t)
   | _ -> ());
  match arrive with
  | [] -> (Types.Unit, fn.Ast.nloc)
  | (t, l, _) :: rest
    when not (List.exists (fun (u, _, _) -> not (Types.equal t u)) rest) ->
    (t, l)
  | (t0, l0, _) :: _ ->
    (* Where no join exists the first typed exit's type is the one checked
       against, so the refusal is the one [if] gives its else arm. *)
    let meet ?(join = arm_join) = function
      | [] -> None
      | ((t, l, _) :: _) as xs ->
        let j =
          List.fold_left
            (fun acc (u, _, _) -> Option.bind acc (fun a -> join a u))
            (Some t) xs
        in
        let at =
          match j with
          | Some j ->
            (match List.find_opt (fun (u, _, _) -> Types.equal u j) xs with
             | Some (_, l', _) -> l'
             | None -> l)
          | None -> l
        in
        Some (Option.value j ~default:t, at)
    in
    let decided =
      match meet (List.filter (fun (_, _, lit) -> not lit) arrive) with
      | Some d -> d
      | None ->
        (* Every exit a literal: they meet as two literals do. *)
        Option.value (meet ~join:literal_meet arrive) ~default:(t0, l0)
    in
    ignore (attempt (fst decided));
    decided

and infer_returns ~keep_going ?tolerate ?(previous = fun _ -> None) env
    (decls : Ast.decl list) =
  let pending =
    List.filter_map
      (fun (d : Ast.decl) ->
         match d.Ast.d with
         | Ast.Defn ({ Ast.ret = Some { Ast.t = Ast.Tinfer; _ }; _ } as fn)
           when not (Hashtbl.mem env.gsigs fn.Ast.name) ->
           Some fn
         | _ -> None)
      decls
  in
  if pending <> [] then begin
    let names = List.map (fun (fn : Ast.fn) -> fn.Ast.name) pending in
    (* The other pending names each body mentions, with where. A local of
       the same name is counted too, which only matters once the fixpoint
       has stalled on a real error, and then only to pick which to show. *)
    let calls (fn : Ast.fn) =
      let acc = ref [] in
      List.iter (Load.expr_uses acc) fn.Ast.fbody;
      List.filter (fun (n, _) -> List.mem n names) (List.rev !acc)
    in
    let deps = List.map (fun (fn : Ast.fn) -> (fn.Ast.name, calls fn)) pending in
    let byname = List.map (fun (fn : Ast.fn) -> (fn.Ast.name, fn)) pending in
    (* Callees first, so a program with no cycle settles in one round. *)
    let order =
      let visited = Hashtbl.create 16 and out = ref [] in
      let rec visit n =
        if not (Hashtbl.mem visited n) then begin
          Hashtbl.replace visited n ();
          List.iter (fun (m, _) -> visit m) (List.assoc n deps);
          out := List.assoc n byname :: !out
        end
      in
      List.iter visit names;
      List.rev !out
    in
    let params_of (fn : Ast.fn) =
      List.map (fun (p : Ast.field) -> resolve env p.Ast.fty) fn.Ast.params
    in
    let settle (fn : Ast.fn) =
      let params = params_of fn in
      let ret, cause = read_return env fn params in
      Hashtbl.replace env.fns fn.Ast.name (params, ret);
      Hashtbl.replace env.inferred fn.Ast.name cause
    in
    (* A body [tolerate] excuses keeps the signature it was compiled with,
       [previous]'s, the way pass two keeps its compiled body: it is a stale
       caller, not a change. *)
    (* A body that fails for its own reasons is left to pass two, which
       reports its errors with every other body's. Until then it stands as
       Never, which fits anywhere, so its callers are not refused for its
       sake; a [_] body that calls it cannot be read either, and waits the
       same way. *)
    let failed = env.infer_failed in
    let fail_quietly ?refusal (fn : Ast.fn) =
      Hashtbl.replace failed fn.Ast.name refusal;
      Hashtbl.replace env.fns fn.Ast.name (params_of fn, Types.Never)
    in
    (* Only while every error is collected: a check that stops at the first
       reports this body's own, here. *)
    let excused (fn : Ast.fn) =
      match settle fn with
      | () -> ()
      | exception (Loc.Error d as e) ->
        (match tolerate, previous fn.Ast.name with
         | Some ok, Some (params, ret) when ok env fn.Ast.name d ->
           Hashtbl.replace env.fns fn.Ast.name (params, ret)
         | _ -> if keep_going then fail_quietly ~refusal:d fn else raise e)
    in
    let rec rounds left =
      let still =
        List.filter
          (fun (fn : Ast.fn) ->
             if List.exists (fun (m, _) -> Hashtbl.mem failed m)
                  (List.assoc fn.Ast.name deps)
             then begin fail_quietly fn; false end
             else
               match settle fn with
               | () -> false
               | exception Loc.Error _ -> true)
          left
      in
      if still <> [] && List.length still < List.length left then rounds still
      else still
    in
    (* A loop of [_] bodies that give no value on any way out — a
       countdown that calls itself — is (): each is read with the others
       taken as (), and kept only when every one of them gives () back. *)
    let units stuck =
      List.iter
        (fun (fn : Ast.fn) ->
           Hashtbl.replace env.fns fn.Ast.name (params_of fn, Types.Unit))
        stuck;
      let all_unit =
        List.for_all
          (fun (fn : Ast.fn) ->
             match read_return env fn (params_of fn) with
             | t, cause when Types.equal t Types.Unit ->
               Hashtbl.replace env.inferred fn.Ast.name cause; true
             | _ -> false
             | exception Loc.Error _ -> false)
          stuck
      in
      if not all_unit then
        List.iter
          (fun (fn : Ast.fn) ->
             Hashtbl.remove env.fns fn.Ast.name;
             Hashtbl.remove env.inferred fn.Ast.name)
          stuck;
      all_unit
    in
    let rec stalled left =
      let stuck = rounds left in
      if stuck <> [] then refuse stuck
    and refuse stuck =
      let stuck_names = List.map (fun (fn : Ast.fn) -> fn.Ast.name) stuck in
      let waits n =
        List.filter (fun (m, _) -> List.mem m stuck_names) (List.assoc n deps)
      in
      (* One that waits on nothing else stuck failed on its own body: check
         it again, unswallowed, and its own error is the report. *)
      (match List.find_opt (fun n -> waits n = []) stuck_names with
       | Some n ->
         excused (List.assoc n byname);
         stalled (List.filter (fun (fn : Ast.fn) -> fn.Ast.name <> n) stuck)
       | None ->
         (* Every one waits on another, so following the first wait from
            any of them comes back round: that loop is the cycle. *)
         let rec walk path n =
           if List.mem n path then
             let rec from = function
               | m :: rest when m = n -> m :: rest
               | _ :: rest -> from rest
               | [] -> []
             in
             from (List.rev path)
           else walk (n :: path) (fst (List.hd (waits n)))
         in
         let cycle = walk [] (List.hd stuck_names) in
         (* Told from the one written first, which is where a reader of the
            file meets the loop. *)
         let cycle =
           let index n =
             let rec at i = function
               | [] -> max_int
               | m :: rest -> if m = n then i else at (i + 1) rest
             in
             at 0 names
           in
           let start =
             List.fold_left (fun a n -> if index n < index a then n else a)
               (List.hd cycle) cycle
           in
           let rec rot = function
             | m :: rest when m <> start -> rot (rest @ [ m ])
             | l -> l
           in
           rot cycle
         in
         if units (List.map (fun n -> List.assoc n byname) cycle) then
           stalled
             (List.filter
                (fun (fn : Ast.fn) -> not (List.mem fn.Ast.name cycle)) stuck)
         else
         let first = List.hd cycle in
         let fn = List.assoc first byname in
         let next i = List.nth cycle ((i + 1) mod List.length cycle) in
         let notes =
           List.mapi
             (fun i n ->
                let callee = next i in
                let at = List.assoc callee (waits n) in
                Loc.note at
                  (if n = callee then n ^ " calls itself here"
                   else Printf.sprintf "%s calls %s here" n callee))
             cycle
         in
         (* Collected like any refusal when every error is: the loop's
           first member carries it into pass two, the rest stand quietly. *)
         match
         (match cycle with
          | [ n ] ->
            Loc.failk "check/infer-recursive" fn.Ast.nloc ~notes
              "%s calls itself, so its return type cannot be read off its \
               body. Write the return type in its signature" n
          | _ ->
            Loc.failk "check/infer-recursive" fn.Ast.nloc ~notes
              "%s call each other (%s), so %s of their return types can \
               be read off their bodies. Write the return type of one of \
               them in its signature"
              (String.concat " and " cycle)
              (String.concat " → " (cycle @ [ first ]))
              (if List.length cycle = 2 then "neither" else "none"))
         with
         | () -> ()
         | exception (Loc.Error d as e) ->
           if not keep_going then raise e;
           List.iter
             (fun n ->
                fail_quietly
                  ?refusal:(if n = first then Some d else None)
                  (List.assoc n byname))
             cycle;
           stalled
             (List.filter
                (fun (fn : Ast.fn) -> not (List.mem fn.Ast.name cycle)) stuck))
    in
    stalled order
  end

(* 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. (defonce 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. Write (defonce \
         %s %s) with no initialiser — a zeroed %s is an empty one"
        n (tyname loc ty) n (tyname loc ty) (tyname loc ty)
    | _ -> ()

(* A container global has to be a [defonce]. 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 defonce, not a defconst — a \
       defconst would stay the empty %s it was declared as. Write (defonce %s \
       %s) and fill it in a function"
      n (tyname loc ty) (tyname loc ty) (tyname loc ty)
      n (tyname loc 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 defonce 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. Leave it zeroed, or make it a defonce"
      n un
  | _ -> ()

(* A defconst's value is what the linker writes into the program's image, so it
   has to be a value the linker can write: a literal, a zero, an aggregate of
   those — [Tast.const_init]'s set, which is [Emit.const]'s accepted set asked
   as a question. The integer arithmetic a defconst is allowed to be written as
   is already gone by here: [collect]'s folding pass turned [(/ screen-height
   cell-size)] into its answer before any type resolved, so what arrives here
   is an [Int] and passes.

   The author's rule, 2026-09-20: "defconst should not be computed, it's the
   equivalent to a compiler const." Refused here rather than in a backend
   because a backend can only refuse the program it is asked to emit, and the
   two were not asking the same question — [Emit.const] refused a computed
   defconst by name while the x86 backend ran it through the startup function
   behind an [.init~once.] flag, like a defonce. One refusal in the checker is
   the same program refused the same way on both, and it is the only place
   that can say what to do instead.

   A data type case says it with its own message, which is the one thing a
   reader could not work out from "this is computed": the case would have to be
   serialised into the payload blob, and that is an encoder rather than an
   order of operations. It is searched for the way [Emit.const] used to find it
   — down through the aggregates, because a case inside a struct literal is the
   same unwritable value as a case on its own, and [(defconst g S (S {.u (U.B
   {.x 1})}))] told about "computed" would be advice nobody could follow.

   Left to right and stopping at the first value the image cannot hold, which
   is [Emit.const]'s own order: it spelled the fields in order and failed at
   the one it could not spell. So a computed field written before a case field
   is still the general message, because that is the field a reader meets
   first. *)
(* The first subexpression a constant image has no value for, descending
   through the aggregates whose parts are themselves constants. [None] is a
   value the linker can write, which is [Tast.const_init] arrived at from the
   other side — the two walk the same nodes, and this one keeps the offender
   rather than the verdict. *)
let rec unwritable (e : Tast.expr) =
  match e.Tast.e with
  | Tast.Int _ | Tast.Float _ | Tast.Bool _ | Tast.Str _ | Tast.Unit
  | Tast.Zero _ | Tast.Uninit _ | Tast.None_ -> None
  | Tast.Make (_, es) | Tast.Arr es -> List.find_map unwritable es
  | Tast.Some_ v -> unwritable v
  | _ -> Some e

let const_defconst_init env loc n (v : Tast.expr) =
  match unwritable v with
  | None -> ()
  | Some { Tast.e = Tast.MakeCase (dname, case, _); _ } ->
    fail loc
      "a constant cannot be %s.%s. Make it a defonce, or declare it zeroed, \
       which is %s.%s"
      dname case dname
      (match Hashtbl.find_opt env.datas dname with
       | Some { Tast.cases = c :: _; _ } -> c.Tast.vname
       | _ -> "its first case")
  | Some _ ->
    fail loc
      "a constant's value must be a compile-time constant — the constant %s \
       is computed. A defonce may have a computed initialiser, because it runs \
       at startup and stores the result; a defconst is what the linker writes \
       into the image and has nowhere to run. Write (defonce %s ...), or give \
       the constant a literal — integer constants may also be written as \
       arithmetic over literals and other constants, which is folded here"
      n n

(* 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 (defonce
   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, can only %s. Write one inside the \
            initialiser, or move the whole thing into a function"
           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 — [(defonce 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); as_slots = ctx.as_slots;
      (* An initialiser is a nested form as far as [defer_ok] is concerned, so
         nothing can register one here and both of these are empty. Written the
         same way [check_fn] writes them anyway, so that the day the rule
         widens this does not quietly become the one exit path that runs a
         defer nobody reached. *)
      ret = ty;
      body =
        (match ctx.defer_slot with
         | None -> [ v ]
         | Some s -> [ defer_counter_zero s loc; v ]);
      fdefers =
        (match ctx.defer_slot with
         | None -> ctx.defers
         | Some s -> guarded_defers s ctx.defers);
      fenv = None; 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 () = invented_ctx env Types.Unit in
  match d.Ast.d with
  | Ast.Defvar (n, _, init, kind) ->
    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;
    (* A [def]'s initialiser is lifted into [global/<n>] whatever it is — a
       zero, a literal, a computed expression — where a [defonce]'s is lifted
       only when it is computed. The lifting is what makes the form's promise
       reachable: the host's startup function calls the initialiser through
       its function cell, so a re-evaluated [def] swaps the cell and the next
       re-run stores the *edited* value. A constant left inline would be
       baked into the host's startup body, and every re-run would paint the
       stale value back. The same lifted function is what [Session.eval]'s
       store thunk calls to assign the new value straight away, which is the
       other half of what [defparameter] means. [uninit] is the one exception
       on both forms: there is nothing to run, so there is nothing to
       lift. *)
    let lift_always = (match kind with Ast.Once -> false | Ast.Every -> true) in
    let ginit =
      match init with
      | Ast.Zeroed when lift_always ->
        let c = ctx () in
        lift_ginit c d.Ast.dloc n ty { Tast.e = Tast.Zero ty; ty; loc = d.Ast.dloc }
      | 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. Drop the \
              uninit — a zeroed %s is %s"
             (tyname d.Ast.dloc 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
        (match v.Ast.e with
         | Ast.UInt (_, s) when ty = Types.Dyn ->
           Loc.failk literal_at_want v.Ast.loc "%s. Give %s the type u64"
             (wide_at_dyn s) n
         | _ -> ());
        let v =
          view_global_init := Some (n, kind);
          Fun.protect ~finally:(fun () -> view_global_init := None)
            (fun () -> check c ~want:ty v)
        in
        if Tast.const_init v && not lift_always then v
        else lift_ginit c d.Ast.dloc n ty v
      (* [settle_defvars] turned every one of these into a [Zeroed] or an
         [Init] during [collect], and this pass runs over the list that pass
         handed back. One arriving here is a driver that checked a global
         without collecting first. *)
      | Ast.Ambiguous _ ->
        fail d.Ast.dloc
          "internal: the third element of (%s %s ...) was never decided"
          (match kind with Ast.Once -> "defonce" | Ast.Every -> "def") n
    in
    Some { Tast.gname = n; gty = ty; ginit; gconst = false; gfolded = false;
           grerun = (match kind with Ast.Once -> false | Ast.Every -> true) }
  | 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. *)
    (* A folded conversion is still a value of the type it converts to. *)
    (match v.Ast.e, ty with
     | Ast.Call ({ Ast.e = Ast.Var c; _ }, [ _ ]), Types.Int kind
       when (match Types.ikind_of_name c with
             | Some k ->
               k <> kind
               && not (Types.widens_to ~from:(Types.Int k) ~into:(Types.Int kind))
             | None -> false) ->
       fail v.Ast.loc "expected %s, found %s" (Types.ikind_name kind) c
     | _ -> ());
    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
                 ~pattern:(match v.Ast.e with Ast.Int _ -> false | _ -> true)
                 v.Ast.loc kind k, kind); ty;
          loc = d.Ast.dloc }
      | _ -> with_typed_literals (fun () -> check (ctx ()) ~want:ty v)
    in
    no_union_const env d.Ast.dloc n ginit;
    (* After the union's own refusal, so a computed union member keeps the
       message that names its way through rather than the general one. *)
    const_defconst_init 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; grerun = false }
  | _ -> 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 [str], not (%s)"
        (String.concat (if Source.indented_at at then ", " else " ")
           (List.map (tyname at) 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"
        (tyname at 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: [(defonce b
   i64 (+ a 10))] written above [(defonce 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: [(defonce 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 — 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. Leave one zeroed and load \
          it in a function"
         (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

(* ── What a per-type descriptor can reach ───────────────────────────────
 *
 * The struct dyn field is no longer refused: a type that holds dyn words at
 * static offsets gets a descriptor naming those offsets, and every place a
 * value of it can live — a frame slot, a global, a temporary a call answered
 * with — goes on the collector's root stack with that descriptor beside it.
 * runtime/flan_dyn.h's [flan_dyn_root_push_desc] is where the whole of that
 * argument is written, including why no instance carries a header word.
 *
 * What a static offset cannot express is what is left, and it is refused here
 * rather than emitted as a descriptor that quietly omits a field:
 *
 * - a dyn inside a typed container. A [(Vec S)] holds its elements in
 *   allocator memory of a length nothing static knows, so the dyn words of
 *   one are not a list of offsets. The M2 queue's item 3 is the
 *   descriptor that can say it — pointer, length and element type — and it is
 *   a different shape from this one, deliberately. A [(Map K V)] is the same
 *   fact twice over.
 * - a dyn in a data type's payload. The cases overlay one another, so which
 *   words are dyn depends on the tag, which is a run-time question. The same
 *   goes for a C union's members.
 * - a dyn inside an [(Option T)], whose payload exists only under the tag: the
 *   words of a [None] are zero and marking them is harmless, but that is a
 *   fact about how this compiler happens to build one and not something the
 *   type says, and a descriptor that relied on it would be relying on it
 *   silently.
 *
 * A [(Ptr S)] and a [[S]] are deliberately *not* on that list, and the reason
 * is worth stating because it looks like an omission. Neither owns storage.
 * The only storage this compiler hands out for a type that holds dyn is a
 * frame slot, a global, or a fixed array inside one of those — and all three
 * are rooted with their descriptor already, so a pointer or a slice into one
 * addresses bytes the collector is marking. That is what makes a condition's
 * payload work at all: a handler clause is lifted to a function taking a
 * [(Ptr Cond)], and the value it points at is in the signalling frame with a
 * descriptor beside it. Storage that came from C is the program's business the
 * way every other pointer from C is.
 *
 * And one cap, which is not a representation question but an arithmetic one:
 * the offsets of a fixed array are flattened one element at a time, so an
 * array of a million structs would be a million-word table in .rodata. The
 * repeat form that avoids it is item 3's machinery, so this says so instead of
 * building half of it. *)

let desc_offsets_max = 4096

(* Is there a dyn in the storage a value of this type *is*, which is not the
   same as whether its printed form mentions dyn anywhere. A pointer and a
   slice are stopped at, because what they address is somebody else's storage
   and is rooted where it was declared. That is the same line [hidden_dyn]
   takes for a bare [(Ptr S)], and taking it here as well is what lets
   [(Vec (Ptr Cond))] be written — a vector of pointers to condition structs
   holds no dyn words of its own, and refusing it with a sentence about the dyn
   inside it was wrong twice over. *)
let rec dyn_reach ~through p seen (t : Types.t) =
  let go = dyn_reach ~through p seen in
  match t with
  | Types.Dyn -> true
  | Types.Array (_, e) | Types.Vec e | Types.Option e -> go e
  | Types.Map (k, v) -> go k || go v
  | Types.Ptr (_, e) | Types.Slice (_, e) -> through && go e
  | Types.Fn _ -> false
  | Types.Named n when not (List.mem n seen) ->
    let seen = n :: seen in
    let field (fl : Tast.field) = dyn_reach ~through p seen fl.Tast.fty in
    (match List.find_opt (fun (s : Tast.structure) -> s.Tast.sname = n)
             p.Tast.structs with
     | Some s -> List.exists field s.Tast.fields
     | None ->
       match List.find_opt (fun (u : Tast.data) -> u.Tast.dname = n)
               p.Tast.datas with
       | Some u ->
         List.exists
           (fun (c : Tast.variant) -> List.exists field c.Tast.vfields)
           u.Tast.cases
       | None ->
         match List.find_opt (fun (u : Tast.structure) -> u.Tast.sname = n)
                 p.Tast.unions with
         | Some u -> List.exists field u.Tast.fields
         | None -> false)
  | _ -> false

let dyn_anywhere p seen t = dyn_reach ~through:false p seen t

(* The other question, and it is a different one: is there a dyn reachable from
   here *at all*, pointers and slices followed. Only the foreign boundary asks
   it, and it has to — the storage on the far side of a pointer is rooted where
   it was declared when the declaration was Flan's, and is rooted nowhere at
   all when it was C's. Keeping the two apart is the whole of the fix: the
   narrowing above is right for a Flan type, and reusing it at the boundary
   made [(Ptr (Ptr S))] and [(Ptr [S])] answer no. *)
let dyn_through p seen t = dyn_reach ~through:true p seen t

(* Is a dyn reachable from here only by going through a pointer or a slice.
   This is the parameter question. Flan supplies the storage one level down
   from a foreign parameter — it passes the address of a place, and a place is
   a frame slot, a global or an array inside one, all of them rooted with their
   descriptor — so a [(Ptr S)] parameter is an ordinary borrow and stays
   writable. What is *below* that level is C's, and a pointer or a slice found
   there is a hop into storage nothing rooted. *)
let rec dyn_behind_pointer p seen (t : Types.t) =
  let go = dyn_behind_pointer p seen in
  match t with
  (* The crossing, and the [seen] set does *not* travel across it. The two
     walks ask different questions — this one does not count a direct dyn, the
     one below it does — so a name already visited on the way here would be
     pruned from a question it was never asked. That is not a nicety: a struct
     with a pointer to itself and a dyn field is exactly the shape that hits
     it, and [(defstruct Node [next (Ptr Node) x dyn])] at [(Ptr Node)] was
     accepted while the same thing unrolled into two types was refused. C
     hung a node off [next], put a dyn in it, and the collector freed it —
     which is the one failure this whole boundary exists to prevent.

     It still terminates. This walk's own [seen] guards its own [Named]
     recursion, and each crossing starts a separate finite walk of its own. *)
  | Types.Ptr (_, e) | Types.Slice (_, e) -> dyn_through p [] e
  | Types.Array (_, e) | Types.Vec e | Types.Option e -> go e
  | Types.Map (k, v) -> go k || go v
  | Types.Dyn | Types.Fn _ -> false
  | Types.Named n when not (List.mem n seen) ->
    let seen = n :: seen in
    let field (fl : Tast.field) = dyn_behind_pointer p seen fl.Tast.fty in
    (match List.find_opt (fun (s : Tast.structure) -> s.Tast.sname = n)
             p.Tast.structs with
     | Some s -> List.exists field s.Tast.fields
     | None ->
       match List.find_opt (fun (u : Tast.data) -> u.Tast.dname = n)
               p.Tast.datas with
       | Some u ->
         List.exists
           (fun (c : Tast.variant) -> List.exists field c.Tast.vfields)
           u.Tast.cases
       | None ->
         match List.find_opt (fun (u : Tast.structure) -> u.Tast.sname = n)
                 p.Tast.unions with
         | Some u -> List.exists field u.Tast.fields
         | None -> false)
  | _ -> false

(* How many dyn words a descriptor for this type would name, which is what the
   cap above is about. Only the by-value shapes contribute; the rest are
   refused by [hidden_dyn] before this number matters. *)
(* Saturated at one past the cap, because the number only ever has to be
   compared with it. That is not tidiness: [(defonce big [4611686018427387904
   S])] is a length an [Int64.to_int] multiplication wraps *negative* on, so an
   honest product made the test [n > desc_offsets_max] false, the declaration
   was accepted, and the emitter then sat building the offset list until
   something killed it. A refusal that overflows into an acceptance is worse
   than no refusal. Every arm below stays at or under [desc_offsets_max + 1],
   so nothing here can multiply two numbers large enough to wrap. *)
let sat n = if n > desc_offsets_max then desc_offsets_max + 1 else n

let rec dyn_words p seen (t : Types.t) =
  match t with
  | Types.Dyn -> 1
  | Types.Array (n, e) ->
    let w = dyn_words p seen e in
    (* Out of range in either direction saturates. A negative length is
       nonsense and the layout refuses it further down, but this arm has to
       answer *something*, and the one thing it must not answer is a small
       number: [Int64.to_int (-1L) * w] is negative, which reads as under the
       cap and is how the overflow above got through in the first place. *)
    if w = 0 then 0
    else if Int64.compare n 0L < 0
         || Int64.compare n (Int64.of_int (desc_offsets_max + 1)) > 0 then
      desc_offsets_max + 1
    else sat (Int64.to_int n * w)
  | Types.Named nm when not (List.mem nm seen) ->
    (match List.find_opt (fun (s : Tast.structure) -> s.Tast.sname = nm)
             p.Tast.structs with
     | Some s ->
       List.fold_left
         (fun acc (fl : Tast.field) ->
            sat (acc + dyn_words p (nm :: seen) fl.Tast.fty))
         0 s.Tast.fields
     | None -> 0)
  | _ -> 0

(* The first place under this type where a dyn sits that no descriptor reaches,
   as the type to name in the refusal. *)
let rec hidden_dyn p seen (t : Types.t) : Types.t option =
  let under e = if dyn_anywhere p seen e then Some t else None in
  match t with
  | Types.Dyn -> None
  | Types.Array (_, e) -> hidden_dyn p seen e
  | Types.Vec e | Types.Option e -> under e
  (* A Map's values are walked through the value type's own descriptor, so a
     dyn there is found wherever that descriptor finds one. A key never holds
     one: dyn is not a key type. *)
  | Types.Map (k, v) ->
    if dyn_anywhere p seen k then Some t else hidden_dyn p seen v
  (* A pointer and a slice are views of storage something else roots; see the
     note above. What they point at is checked where it is declared. *)
  | Types.Ptr (_, e) | Types.Slice (_, e) -> hidden_dyn p seen e
  | Types.Fn _ -> None
  | Types.Named n when not (List.mem n seen) ->
    let seen = n :: seen in
    (match List.find_opt (fun (s : Tast.structure) -> s.Tast.sname = n)
             p.Tast.structs with
     | Some s ->
       List.fold_left
         (fun acc (fl : Tast.field) ->
            match acc with
            | Some _ -> acc
            | None -> hidden_dyn p seen fl.Tast.fty)
         None s.Tast.fields
     | None ->
       (* A data type's payload and a union's members both overlay, so any dyn
          in one is hidden by the type itself and not by a member of it. *)
       match List.find_opt (fun (u : Tast.data) -> u.Tast.dname = n)
               p.Tast.datas with
       | Some u ->
         if List.exists
              (fun (c : Tast.variant) ->
                 List.exists
                   (fun (fl : Tast.field) -> dyn_anywhere p seen fl.Tast.fty)
                   c.Tast.vfields)
              u.Tast.cases
         then Some t else None
       | None ->
         match List.find_opt (fun (u : Tast.structure) -> u.Tast.sname = n)
                 p.Tast.unions with
         | Some u ->
           if List.exists
                (fun (fl : Tast.field) -> dyn_anywhere p seen fl.Tast.fty)
                u.Tast.fields
           then Some t else None
         | None -> None)
  | _ -> None

(* Every place a value can live: a global, a parameter, a return, a frame slot.
   Two passes want exactly this list — the descriptor refusal below and the
   [--no-gc] site collection at the bottom of the file — and each walked it
   itself until the phrase naming an unnamed slot drifted between the two. One
   walk now; the callers keep their own filters, which is where they really
   differ.

   [visit] is handed the location, the phrase naming the place, and the type.
   [~slot] says whether this is a frame slot: that is the one distinction a
   caller filters on, and a caller cannot recover it from the type. [?after_fn]
   runs at the end of each function, before the next is begun, so that a caller
   which also walks the body emits its diagnostics in the order a single loop
   over [p.Tast.fns] gave them. *)
let value_sites (p : Tast.program) ?(after_fn = fun (_ : Tast.fn) -> ())
    (visit : slot:bool -> _) =
  List.iter
    (fun (g : Tast.global) ->
       visit ~slot:false g.Tast.ginit.Tast.loc
         (Printf.sprintf "the global %s" g.Tast.gname) g.Tast.gty)
    p.Tast.globals;
  List.iter
    (fun (fn : Tast.fn) ->
       List.iteri
         (fun i t ->
            visit ~slot:false fn.Tast.floc
              (Printf.sprintf "parameter %d of %s" (i + 1) fn.Tast.name) t)
         fn.Tast.params;
       visit ~slot:false fn.Tast.floc
         (Printf.sprintf "the return type of %s" fn.Tast.name) fn.Tast.ret;
       Array.iteri
         (fun i t ->
            (* A slot the program named is called by that name; one the checker
               synthesised has none to give, and "a local" is the phrase both
               passes now use for it. The preposition is [in] either way,
               because a named slot has always read "%s in %s". *)
            let named =
              if i < Array.length fn.Tast.snames then fn.Tast.snames.(i)
              else None
            in
            visit ~slot:true fn.Tast.floc
              (Printf.sprintf "%s in %s"
                 (match named with Some n -> n | None -> "a local")
                 fn.Tast.name)
              t)
         fn.Tast.slots;
       after_fn fn)
    p.Tast.fns

(* Over the whole program rather than at each declaration, because the type
   that hides a dyn may be declared after the one that names it — and because
   a struct nobody ever holds a value of costs nothing either way. *)
(* Does a value of this type hold an (Fn ...) in its own storage — the
   function values a collector-allocated environment may hang off. A
   pointer and a slice are views of storage checked where it is declared. *)
let rec holds_fn p seen (t : Types.t) =
  let go = holds_fn p seen in
  match t with
  | Types.Fn _ -> true
  | Types.Array (_, e) | Types.Vec e | Types.Option e -> go e
  | Types.Map (k, v) -> go k || go v
  | Types.Named n when not (List.mem n seen) ->
    let seen = n :: seen in
    let field (fl : Tast.field) = holds_fn p seen fl.Tast.fty in
    (match List.find_opt (fun (s : Tast.structure) -> s.Tast.sname = n)
             p.Tast.structs with
     | Some s -> List.exists field s.Tast.fields
     | None ->
       match List.find_opt (fun (u : Tast.data) -> u.Tast.dname = n)
               p.Tast.datas with
       | Some u ->
         List.exists
           (fun (c : Tast.variant) -> List.exists field c.Tast.vfields)
           u.Tast.cases
       | None ->
         match List.find_opt (fun (u : Tast.structure) -> u.Tast.sname = n)
                 p.Tast.unions with
         | Some u -> List.exists field u.Tast.fields
         | None -> false)
  | _ -> false

let dyn_descriptors (p : Tast.program) =
  let check loc what (t : Types.t) =
    (match hidden_dyn p [] t with
     | Some at ->
       Loc.failk "check/dyn-descriptor" loc
         "%s is %s, and the dyn inside %s is one no descriptor can find. The \
          collector marks a struct's dyn fields by their byte offsets, which \
          %s does not have — its storage is not part of the value. Hold the \
          dyn in a struct field, or wait for the typed container view"
         what (tyname loc t) (tyname loc at) (tyname loc at)
     | None -> ());
    (* The count is saturated, so the message says more-than rather than a
       figure the reader could check — which is the honest thing to print,
       since the figure it would otherwise print is the one that wrapped. *)
    if dyn_words p [] t > desc_offsets_max then
      Loc.failk "check/dyn-descriptor" loc
        "%s is %s, whose descriptor would name more than %d dyn words. The \
         offsets of an array are flattened one element at a time, and %d is \
         the most this compiler will write out — the repeat form that would \
         avoid it arrives with the typed container view"
        what (tyname loc t) desc_offsets_max desc_offsets_max
  in
  (* The foreign boundary, which is the one place the note above admits an
     honest hole. Every slot, global and array this compiler hands out for a
     type that holds dyn is rooted with its descriptor. Storage that came from
     C is not: nothing pushed a root for it, nothing ever will, and a dyn word
     sitting in it is a live value the collector cannot see and will free. A
     bare dyn is already refused by name at this boundary for a different
     reason — C has no way to ask what the word means — and this is the same
     sentence at one remove.

     The rule is about *ownership* and not about shape, so the two directions
     are asked different questions and the answer to "is a (Ptr S) allowed" is
     "which way is it going":

     - A return, and anything reachable from it however many pointers deep, is
       C's storage. [(Ptr S)], [(Ptr (Ptr S))] and [(Ptr [S])] are all refused,
       and the last two are the ones a one-level check missed — following a
       pointer is exactly what [dyn_anywhere] stops doing, which is right for
       a Flan type and wrong here.
     - A parameter's outermost level is Flan's. The compiler passes the address
       of a *place*, and a place is a frame slot, a global or an array inside
       one — rooted with its descriptor and marked for the whole call. So
       [(Ptr S)] and [[S]] as parameters are ordinary borrows and stay
       writable, which is what a read-only C inspector wants and what
       shim.ml's own advice tells people to write. Below that level the
       storage is C's again: a [(Ptr (Ptr S))] parameter is an out-parameter,
       and what C writes into it is a pointer of C's own. *)
  List.iter
    (fun (e : Tast.extern) ->
       let refuse what (t : Types.t) why =
         Loc.failk "check/dyn-descriptor" e.Tast.eloc
           "%s of %s (the C symbol %s) is %s, and a dyn is reachable through \
            it. %s, so the collector cannot mark that word and will free what \
            it names — pass the fields across at written types instead"
           what e.Tast.ename e.Tast.esym (tyname e.Tast.eloc t) why
       in
       (* One level in, because that level is the compiler's own: what a
          foreign parameter of pointer or slice type receives is the address
          of a place. Below it the question is [dyn_behind_pointer]'s again. *)
       let below (t : Types.t) =
         match t with Types.Ptr (_, e) | Types.Slice (_, e) -> e | t -> t
       in
       List.iteri
         (fun i t ->
            if dyn_behind_pointer p [] (below t) then
              refuse (Printf.sprintf "parameter %d" (i + 1)) t
                "The outermost level is this compiler's own storage and is \
                 rooted, but what lies below it is C's and nothing rooted that")
         e.Tast.eparams;
       if dyn_through p [] e.Tast.eret then
         refuse "the return type" e.Tast.eret
           "What C hands back points at storage this compiler never rooted")
    p.Tast.externs;
  value_sites p (fun ~slot:_ loc what t -> check loc what t)
(* See lib/closures.ml. *)
let is_env_struct = Closures.is_env_struct
let heap_env = Closures.heap_env
let place_closures fns = Closures.place ~dev:false fns

(* A program's function named as a prelude function takes the name over, the
   way a definition of a builtin's name does: every call written in the file
   that defines it reaches the program's, and every call anywhere else — the
   prelude's own among them, which were written against the prelude's
   signature — keeps reaching the prelude's. The prelude's is renamed out of
   the way, under a qualifier no source can spell, rather than dropped.
   Functions only: a type or a global of the prelude's name is still defined
   twice. *)
let prelude_alias = "prelude~"

(* Off for a check whose warnings were already printed for the same source:
   the dev program re-creating the session its launcher built and warned for. *)
let print_warnings = ref true

(* Where a dev eval's own forms are, so its warnings are said for those and
   not again, on every later eval, for everything the session holds. [None]
   is a build or a check, which says everything. *)
let warn_within : Loc.t list option ref = ref None

(* The warnings [say_warnings] kept since [build_program] began, in order:
   what a dev eval hands the editor in its reply as well as printing. *)
let said_warnings : Loc.diag list ref = ref []

let say_warnings (ds : Loc.diag list) =
  let within (at : Loc.t) =
    match !warn_within with
    | None -> true
    | Some spans ->
      List.exists
        (fun (s : Loc.t) ->
           String.equal s.Loc.file at.Loc.file
           && s.Loc.line <= at.Loc.line && at.Loc.line <= max s.Loc.line s.Loc.eline)
        spans
  in
  let ds = List.filter (fun (d : Loc.diag) -> within d.Loc.dloc) ds in
  said_warnings := !said_warnings @ ds;
  if !print_warnings then
    List.iter
      (fun (d : Loc.diag) ->
         prerr_endline
           (Loc.entry ~mark:'~' ~label:"warning: " d.Loc.dloc d.Loc.dmsg))
      ds

(* A name the renaming above made, which nobody wrote: left out of every
   listing a person reads, and shown as whose it is where a frame has to be. *)
let internal_name n = String.starts_with ~prefix:(prelude_alias ^ "/") n

let shown_name n =
  let n = written_name n in
  if internal_name n then
    let p = String.length prelude_alias + 1 in
    "the prelude's " ^ String.sub n p (String.length n - p)
  else n

let shadow_prelude (prelude : Ast.decl list) (decls : Ast.decl list) =
  (* A value name, and whether it is a function's. A program's global takes
     a prelude function's name over as a program's function does: both are
     names a call or a read reaches, and the prelude's own uses keep the
     prelude's. *)
  let value_name (d : Ast.decl) =
    match d.Ast.d with
    | Ast.Defn fn | Ast.Declare (fn, _) | Ast.DeclareC (fn, _) ->
      Some (fn.Ast.name, true)
    | Ast.Defvar (n, _, _, _) | Ast.Defconst (n, _, _) -> Some (n, false)
    | _ -> None
  in
  let theirs = List.map fst (List.filter_map value_name prelude) in
  let taken =
    List.filter_map
      (fun (d : Ast.decl) ->
         match value_name d with
         | Some (n, f) when List.mem n theirs -> Some (n, d.Ast.dloc, f)
         | _ -> None)
      decls
  in
  let warnings =
    List.map
      (fun (n, at, f) ->
         Loc.diag ~kind:"check/shadows-prelude" at
           (Printf.sprintf
              "%s shadows the prelude's %s — every %s in this file now \
               reaches your definition"
              n n (if f then "call" else "use")))
      taken
  in
  let taken = List.map (fun (n, at, _) -> (n, at)) taken in
  let prelude, decls =
    List.fold_left
      (fun (prelude, decls) (n, (at : Loc.t)) ->
         ( List.map (Load.rename_refs [ n ] prelude_alias) prelude,
           List.map
             (fun (d : Ast.decl) ->
                if String.equal d.Ast.dloc.Loc.file at.Loc.file then d
                else Load.rename_refs [ n ] prelude_alias d)
             decls ))
      (prelude, decls) taken
  in
  (prelude @ decls, warnings)

(* ── A function that calls itself on every path (decision 142) ─────────
   Rust's [unconditional_recursion], and like it only the obvious case, with
   no false positives: from entry, every path reaches a direct call of the
   same name at the same arity before anything can leave. So a branch (an
   [if], [match], [if-let], [?.], [??]; [when] and [and]/[or] are [If] by
   now), a loop body, a handler, a restart and a closure each end the search
   rather than being looked into, and anything that may leave — [return],
   [some]/[try], a signal, a restart, [break]/[continue] out of the fn, or a
   call to a function whose type is [Never] — ends it before the call. A name
   the body binds itself (a parameter, a [let]) is not the function, so a
   body binding it is not looked at at all. Read over the AST after [collect],
   where the parameters are paired, a fn's arities are renamed apart and
   [infer_returns] has settled every callee's return type. *)
let recursion_warnings : Loc.diag list ref = ref []

let unconditional_recursion env (decls : Ast.decl list) : Loc.diag list =
  let children (e : Ast.expr) =
    let acc = ref [] in
    ignore (Ast.map_children (fun c -> acc := c :: !acc; c) e);
    !acc
  in
  let rec binds n (e : Ast.expr) =
    let pat (a : Ast.arm) =
      match a.Ast.pat with Ast.Pctor (_, ns) -> List.mem n ns | _ -> false
    in
    (match e.Ast.e with
     | Ast.Let (bs, _) -> List.exists (fun (b : Ast.binding) -> b.Ast.bname = n) bs
     | Ast.Loop (bs, _) -> List.mem_assoc n bs
     | Ast.Fn (ps, _) -> List.mem n ps
     | Ast.Dotimes (_, v, _, _) | Ast.Chain (v, _, _) -> v = n
     | Ast.Match (_, arms) -> List.exists pat arms
     | Ast.IfLet (_, a, _) -> pat a
     | Ast.HandlerBind (cs, _) | Ast.HandlerCase (_, cs) ->
       List.exists (fun (c : Ast.hclause) -> c.Ast.hname = n) cs
     | Ast.RestartCase (_, cs) ->
       List.exists
         (fun (c : Ast.rclause) ->
            List.exists (fun (p : Ast.field) -> p.Ast.fname = n) c.Ast.rparams)
         cs
     | _ -> false)
    || List.exists (binds n) (children e)
  in
  let never n nargs =
    let ret n =
      match Hashtbl.find_opt env.fns n with
      | Some (_, r) -> Some r
      | None ->
        Option.map (fun (_, _, r) -> r) (Hashtbl.find_opt env.gsigs n)
    in
    let r =
      match Hashtbl.find_opt env.versions n with
      | Some vs -> Option.bind (List.assoc_opt nargs vs) ret
      | None -> ret n
    in
    r = Some Types.Never
    || ((n = "exit" || n = builtin_prefix ^ "exit") && r = None)
  in
  (* Whether [e] may leave the function, or reach a [break]/[continue] of a
     loop outside it. [loops] counts the loops of [e] itself around the node. *)
  let rec leaves loops (e : Ast.expr) =
    match e.Ast.e with
    | Ast.Fn _ | Ast.Defer _ -> false
    | Ast.Return _ | Ast.Unwrap _ | Ast.Signal _ | Ast.InvokeRestart _
    | Ast.Recur _ -> true
    | Ast.Break l | Ast.Continue l -> loops = 0 || l <> None
    | Ast.Call ({ Ast.e = Ast.Var n; _ }, args) when never n (List.length args) ->
      true
    | Ast.While _ | Ast.Loop _ | Ast.Dotimes _ ->
      List.exists (leaves (loops + 1)) (children e)
    | _ -> List.exists (leaves loops) (children e)
  in
  let check_fn (d : Ast.decl) (fn : Ast.fn) =
    let name, arity =
      match version_of fn.Ast.name with
      | Some (b, k) when Hashtbl.mem env.versions b -> (b, k)
      | _ -> (fn.Ast.name, List.length fn.Ast.params)
    in
    (* The self-call every path reaches first, if there is one. *)
    let rec reaches (e : Ast.expr) =
      match e.Ast.e with
      | Ast.Call ({ Ast.e = Ast.Var n; _ }, args)
        when n = name && List.length args = arity ->
        (match seq args with
         | Some _ as c -> c
         | None -> if List.exists (leaves 0) args then None else Some e.Ast.loc)
      (* [??] evaluates its fallbacks only when what comes before is empty,
         so only its first operand is certain to run. Every other builtin
         evaluates all of its arguments. *)
      | Ast.Call ({ Ast.e = Ast.Var "??"; _ }, a :: _) -> seq [ a ]
      | Ast.Call (f, args) -> seq (f :: args)
      | Ast.Return (Some x) -> seq [ x ]
      | Ast.Do es -> seq es
      | Ast.Let (bs, es) -> seq (List.map (fun (b : Ast.binding) -> b.Ast.bval) bs @ es)
      | Ast.If (c, _, _) | Ast.Match (c, _) | Ast.IfLet (c, _, _)
      | Ast.Chain (_, c, _) -> seq [ c ]
      | Ast.Field (x, _) | Ast.The (_, x) | Ast.Unwrap (_, x) | Ast.Signal (_, x)
      | Ast.Narrow (_, x) | Ast.Alias (_, x) -> seq [ x ]
      | Ast.Set (Ast.Pvar _, v) -> seq [ v ]
      | Ast.Struct (_, fs) | Ast.Bare fs -> seq (List.map snd fs)
      | Ast.Arr es -> seq es
      | _ -> None
    and seq = function
      | [] -> None
      (* A loop that may never end: what follows it may never run. *)
      | { Ast.e = Ast.While (_, { Ast.e = Ast.Var "true"; _ }, _) | Ast.Loop _; _ } :: _ ->
        None
      | e :: rest ->
        (match reaches e with
         | Some _ as c -> c
         | None -> if leaves 0 e then None else seq rest)
    in
    if String.equal d.Ast.dloc.Loc.file Prelude.file
    || List.exists (fun (p : Ast.field) -> p.Ast.fname = name) fn.Ast.params
    || List.exists (binds name) fn.Ast.fbody
    then None
    else
      Option.map
        (fun (at : Loc.t) ->
           let fln = fln_source at in
           Loc.diag ~kind:"check/unconditional-recursion" at
             (Printf.sprintf
                "%s cannot return without first calling itself on line %d, \
                 so it never returns. If that call was meant to come after %s, it is %s \
                 by mistake; otherwise %s needs a base case, a path that \
                 returns without calling itself"
                name at.Loc.line
                (if fln then "the function" else "the defn")
                (if fln then "indented into the body" else "inside the defn's body")
                name))
        (seq fn.Ast.fbody)
  in
  List.filter_map
    (fun (d : Ast.decl) ->
       match d.Ast.d with Ast.Defn fn -> check_fn d fn | _ -> None)
    decls

let build_program ~keep_going ?tolerate ?previous (decls : Ast.decl list) :
  Tast.program * env * string list =
  let env = new_env () in
  said_warnings := [];
  Hashtbl.reset arm_failed;
  (* ── A declaration left as it was compiled ───────────────────────────
     A dev session installs a function whose signature changed, and a
     caller compiled against the old one is still in the running program and
     still in the declaration list. Its unchanged source may no longer check
     against the new signature — but it is not being recompiled, the process
     is running the body it was built with, and that body is what the break
     loop has to describe if the call stops. So [tolerate] may answer yes for
     a declaration whose body fails here, and the declaration is left out of
     the program rather than refused; the session puts the checked body it
     already had in its place. Everything the failed check registered on its
     way down — a lifted clause, a generic copy — is taken back, so nothing
     half-checked reaches the backend.

     Only a body. A signature is collected in pass one and nothing here
     excuses it, and with no [tolerate] this is the compiler it always was. *)
  let tolerated = ref [] in
  let tolerant name f =
    match tolerate with
    | None -> f ()
    | Some ok ->
      (* Everything the failed body wrote into [env] goes with it
         ([snapshot_env]): a copy it asked for would otherwise stay cached,
         and the next body asking for it would be handed the name of a copy
         the program does not have. *)
      let undo, keep = snapshot_env env in
      (match f () with
       | x -> keep (); x
       | exception ((Loc.Error d | Loc.Errors (d :: _)) as e) ->
         if ok env name d then begin
           undo ();
           tolerated := name :: !tolerated;
           None
         end
         else (keep (); raise e)
       | exception e -> keep (); raise e)
  in
  let decls, prelude_warnings =
    shadow_prelude (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. *)
  List.iter (fun (n, t) -> Hashtbl.replace env.tracks n t) (Shim.resources decls);
  let decls, cshim = Shim.expand decls in
  (* And on the same line: every class and generic function becomes the
     [defn]s it stands for. It runs over the whole list because a method may
     be written anywhere in it, which is also what makes a reload rebuild
     every dispatch from the session's declarations — see lib/classes.ml. *)
  let decls = Classes.expand decls in
  (* And with the declaration list in its final shape — the classes expanded,
     the shims flattened, the imports already qualified by [Load] — the one
     warning this compiler prints unasked. Here rather than in [bin/main.ml]
     beside [print_memory_warnings] because every route into the compiler
     passes through this function: build, check, run, and the dev daemon's
     reload, which is where a defn is most likely to be written. Printed in
     the shape [Loc] gives an error, so a checker in an editor parses it the
     same way. *)
  say_warnings (shadowed_builtins decls @ prelude_warnings);
  (* 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. *)
  if keep_going then env.deferred <- Some [];
  grow_warnings := [];
  let decls = collect env decls in
  say_warnings (List.rev !pairing_warnings);
  check_finite env;
  check_union_members env;
  infer_returns ~keep_going ?tolerate ?previous env decls;
  recursion_warnings := unconditional_recursion env decls;
  say_warnings !recursion_warnings;
  (let late = !consts_after_infer in
   consts_after_infer := [];
   settle_consts env late);
  let s = Loc.sink ~on:keep_going in
  (match env.deferred with
   | Some ds -> s.Loc.found <- ds; env.deferred <- None
   | None -> ());
  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 ->
         (match
            Loc.caught s (fun () ->
              tolerant fn.Ast.name (fun () ->
                with_recovery env ~on:keep_going (fun () ->
                  Some (check_generic env fn))))
          with
          | None -> Hashtbl.replace env.refused_generics fn.Ast.name ()
          | Some _ -> ())
       | _ -> ())
    decls;
  let globals =
    List.filter_map
      (fun (d : Ast.decl) ->
         Option.join
           (Loc.caught s (fun () ->
              let checked () =
                with_recovery env ~on:keep_going (fun () -> check_global env d)
              in
              match Ast.declared_name d with
              | Some n -> tolerant n checked
              | None -> checked ())))
      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 ->
           Option.join
             (Loc.caught s (fun () ->
                tolerant fn.Ast.name (fun () ->
                  with_recovery env ~on:keep_going (fun () ->
                    Some (check_fn env fn)))))
         | _ -> None)
      decls
  in
  say_warnings (List.rev !grow_warnings);
  Loc.finish s;
  (* The placeholder a [_] body is read against is never a type anything
     downstream may see; a signature carrying it would be emitted as a
     struct named _. *)
  List.iter
    (fun (f : Tast.fn) ->
       if f.Tast.ret == infer_ret
          || List.exists (fun t -> t == infer_ret) f.Tast.params
       then
         fail f.Tast.floc "internal: %s left the checker with its return \
                           type unread" f.Tast.name)
    fns;
  (* 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
  (* Which capturing fns outlive their frame; see [place_closures]. *)
  let fns = place_closures fns 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
         let eloc =
           match Hashtbl.find_opt env.extern_locs name with
           | Some l -> l
           | None -> Loc.unknown
         in
         { Tast.ename = name; esym; eparams; eret; eloc } :: acc)
      env.externs []
    |> List.sort (fun (a : Tast.extern) b -> String.compare a.Tast.esym b.Tast.esym)
  in
  let p =
    { Tast.structs =
        (* A struct copy at variables was only ever for an abstract pass. *)
        List.filter
          (fun (s : Tast.structure) ->
             Hashtbl.find_opt env.copies s.Tast.sname <> Some true)
          (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 }
  in
  (* Last, over the finished program: which dyn words a per-type descriptor can
     reach and which it cannot. It needs every declaration in hand, which is
     what makes it a pass here rather than a check at each one. *)
  dyn_descriptors p;
  (p, env, List.rev !tolerated)

(** 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 =
  let p, env, _ = build_program ~keep_going:false decls in
  (p, env)

(** The same, with [tolerate] deciding which body failures leave a
    declaration out rather than refuse it — see [build_program]. The names
    left out come back beside the program; nothing else about it changes. *)
let program_tolerant ?(keep_going = false) ~tolerate ?previous
    (decls : Ast.decl list) =
  build_program ~keep_going ~tolerate ?previous decls

let program (decls : Ast.decl list) : Tast.program =
  let p, _, _ = build_program ~keep_going:false decls in
  p

(** 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 =
  let p, _, _ = build_program ~keep_going:true decls in
  p

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

(* The same protocol for a body an expression lifted — an [fn] literal or a
   handler clause — and the environment struct each one captured into. Both
   are in [env] and in no program, and a module that calls one or lays one
   out needs them. *)
let lifted_mark env = List.length env.lifted

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

(* The struct copies this env made that [have] does not hold: what an
   expression checked against a running session named for the first time —
   [(Pair 1 2)] typed at a REPL makes [(Pair i32)] — which the module built
   for it has to lay out, and the session has to keep. *)
let fresh_copies env (have : Tast.structure list) =
  Hashtbl.fold
    (fun k at_vars acc ->
       if at_vars
          || List.exists (fun (s : Tast.structure) -> String.equal s.Tast.sname k)
               have
       then acc
       else
         match Hashtbl.find_opt env.structs k with
         | Some s -> s :: acc
         | None -> acc)
    env.copies []
  |> List.sort (fun (a : Tast.structure) b -> String.compare a.Tast.sname b.Tast.sname)

let env_structs env (fns : Tast.fn list) =
  List.filter_map
    (fun (f : Tast.fn) -> Hashtbl.find_opt env.structs ("env/" ^ f.Tast.name))
    fns

(* Expressions checked against a program that is already running, all of them
   into *one* frame. It is empty to start with — a REPL expression has no
   parameters and no enclosing function — so the slots it ends up with are
   whatever their own [let]s allocate.

   One frame and not one each, which is what the inspector's write verb needs
   and what it must not assemble by hand. Two expressions checked separately
   both number their slots from zero, so splicing them into one thunk would
   have the second one's [let] reading and writing the first one's storage — a
   frame that is two frames wearing one frame's clothes. Sharing the [ctx] is
   the whole of the fix, and it is a fix because there is exactly one allocator
   of slot indices in this compiler and it is this record's counter.

   They are otherwise independent: none of them binds a name for the next,
   because the list is a list of values being stored and not a sequence.

   [want] is the write verb too, and [C-x C-e] passes none: a store into a
   slot of type [f32] has an expectation to offer and a typed expression does
   not. The whole value of passing it is that [3] arrives as an [f32] rather
   than as an [i32] the store would then have to be refused for. It flows
   through [check] the way an expectation flows anywhere — that is what
   bidirectional means — and [expect] at the end catches the arms that ignore
   it, so the refusal is the checker's own "expected f32, found string" rather
   than a second sentence written here that would drift from it. *)
let expressions env (es : (Types.t option * Ast.expr) list) :
  Tast.expr list * Types.t array * string option array =
  let ctx = invented_ctx env Types.Unit in
  (* Folded rather than mapped, because [List.map]'s order is unspecified and
     every one of these calls has a side effect on [ctx] — the slot counter it
     shares. An order nobody chose is one that can differ between builds, and
     two frames laid out differently for the same edit is the kind of thing
     that is found by somebody else, much later. *)
  let ts =
    List.rev
      (List.fold_left
         (fun acc (want, (e : Ast.expr)) ->
            expect ctx e.Ast.loc ~want (check ctx ?want e) :: acc)
         [] es)
  in
  (ts, Array.of_list (List.rev ctx.slot_tys),
   Array.of_list (List.rev ctx.slot_names))

(* One expression checked with [scope]'s names already bound, in order, so a
   later entry shadows an earlier one of the same name: evaluating in a stopped
   frame, whose locals the expression may name. Each is bound to a slot of the
   expression's own frame, and which slot is answered beside the name, so the
   caller can point every use of it at the stopped frame's storage instead
   ([Tast.rewrite_locals]). *)
let expression_in_scope env ~(scope : (string * Types.t * bool * bool) list)
    (e : Ast.expr) :
  Tast.expr * Types.t array * string option array * (string * int) list =
  let ctx = invented_ctx env Types.Unit in
  let bound =
    List.map
      (fun (name, ty, assignable, by_as) ->
         let what = if by_as then Some as_tag else None in
         (name, bind ctx ?what name ty ~assignable:(assignable && not by_as)))
      scope
  in
  let t = expect ctx e.Ast.loc ~want:None (check ctx e) in
  (t, Array.of_list (List.rev ctx.slot_tys),
   Array.of_list (List.rev ctx.slot_names), bound)

(* The one-expression case, which is every caller but the write verb. *)
let expression env ?want (e : Ast.expr) :
  Tast.expr * Types.t array * string option array =
  match expressions env [ (want, e) ] with
  | [ t ], tys, names -> (t, tys, names)
  | _ -> assert false

(* ── --no-gc ────────────────────────────────────────────────────────────

   The flag that says this program is to be compiled with no collector in it,
   and the way to keep that promise is to refuse every dyn rather than to emit
   a different program. A dyn value is a value the runtime allocates and the
   collector owns; there is no smaller version of it to fall back to, and
   quietly leaking instead would be a memory model nobody asked for.

   So this is a pass and not a flag. It runs between [Check] and [Emit], it
   answers unit or it refuses, and nothing downstream of it is told the flag
   exists — which is what makes a fully annotated program's output byte for
   byte identical with the flag and without it. Emit has no [no_gc] field to
   branch on, and that is deliberate: a field would be one more thing that
   could change a comment, a name or an ordering, and the identity is worth
   more than the branch would ever buy.

   Every site is named, the way the global cycle refusal names the whole ring
   rather than one member of it. A reader who has to annotate their program
   wants the list, not the first one and then another compile. *)

let dyn_sites (p : Tast.program) : Loc.diag list =
  let found = ref [] in
  let add loc what = found := (loc, `Dyn what) :: !found in
  (* A type that *holds* a dyn and not only the type [dyn] itself. A struct
     with a dyn field is a collected value as much as a bare one is, and since
     the per-type descriptors it is a value a program can have without any
     expression in it ever having the type [dyn] — a zeroed one, never filled,
     whose dyn word the collector is still asked to mark. *)
  let holds t = dyn_anywhere p [] t in
  value_sites p
    (* The filter this pass has and the descriptor pass does not: a frame slot
       whose type is bare [dyn] is passed over here. A parameter or a global of
       that type is still named. *)
    (fun ~slot loc what t ->
       if holds t && not (slot && t = Types.Dyn) then add loc what)
    ~after_fn:(fun (fn : Tast.fn) ->
      (* The body's own dyn values, which are the ones a signature does not
         show: a let bound to a boxed literal, a (vec-new dyn) deep inside an
         expression. Reported at the node, because that is the character to
         change. *)
      List.iter
        (Tast.walk
           (fun (e : Tast.expr) ->
              match e.Tast.e with
              | Tast.Prim (Tast.Rt sym, _)
                when e.Tast.ty = Types.Dyn
                  && String.length sym > 8
                  && String.sub sym 0 8 = "flan_dyn" ->
                add e.Tast.loc (Printf.sprintf "this value in %s" fn.Tast.name)
              (* A capturing fn: its environment is a collector allocation,
                 which is a different sentence from a dyn and has a different
                 fix. *)
              | Tast.Closure (_, env) when heap_env env ->
                found := (e.Tast.loc, `Closure) :: !found
              | _ -> ()))
        fn.Tast.body);
  List.rev_map
    (fun (loc, site) ->
       Loc.diag ~kind:"check/no-gc" loc
         (match site with
          | `Dyn what ->
            Printf.sprintf
              "%s holds a dyn, and --no-gc says this program carries no \
               collector. A \
               dyn value is one the runtime allocates and the collector owns, \
               so there is nothing smaller to compile it to — write the type"
              what
          | `Closure ->
            "this fn captures and outlives the frame it was made in, and \
             --no-gc says this program carries no collector. The copies of an \
             fn that outlives its frame live in an environment the collector \
             allocates — call it or pass it down instead of keeping it, or \
             pass what it names in as parameters"))
    !found

let no_gc (p : Tast.program) =
  match dyn_sites p with [] -> () | ds -> raise (Loc.Errors ds)

(* ── Memory diagnostics ─────────────────────────────────────────────────

   "Which of these lines allocates?", answered on demand. Clojure's
   [*warn-on-boxed*] crossed with Rider's heap-allocation squiggles, and the
   same shape [dyn_sites] above has: a pass over the finished program, off
   unless somebody asks, and nothing downstream is told it exists. Asking for
   it cannot change what compiles.

   Two classes, because the two heaps are not the same heap and a reader wants
   to know which one a line is spending. [kind] carries it — ["memory/gc"] is
   the dyn runtime's collected heap, ["memory/native"] is an allocator the
   program named — so the CLI and the daemon dispatch on one field and neither
   has to parse a message.

   **Precision over completeness.** A site named here allocates, and a site
   that only *might* says so in the first two words. That rule is what decides
   the table below, and it decided it against the obvious guesses more than
   once — every claim here was read out of runtime/flan_rt.c and
   runtime/flan_dyn.c rather than assumed:

   - [(vec-new T)] does not allocate. The lowering passes a capacity of zero
     (see the [flan_vec_init] call in the ["vec-new"] arm) and
     [flan_vec_init]'s body returns before [flan_vec_grow] when [cap <= 0].
     The block arrives at the first push. [(map-new K V)] is the same: its
     [flan_map_init] leaves [data] NULL and says so on its own line.
     [(vec-new dyn)] and [(map-new dyn)] are the *other* answer — those are
     the dyn runtime's own objects and [gc_alloc] runs at the call.
   - A dyn immediate does not allocate: nil, a bool, an f64, a keyword, and
     an int inside the payload. The payload is 48 bits
     ([DYN_PAYMASK]/[DYN_INT_MAX] in flan_dyn.c), so only an i64 that can
     leave ±2^47 is a "may allocate", and a value widened from a narrower
     integer type provably cannot.
   - A keyword is interned and immortal — [flan_dyn_kw]'s entry is not a GC
     object and the collector never traces one — so it is not named here.
   - A dyn container growing itself is not named, and this one is a judgement
     rather than a fact about the runtime: [flan_dyn_push] and
     [flan_dyn_map_set] provably may [gc_alloc], and they are still left out.
     The unit this pass reports is a line the programmer can act on — crossing
     into dyn is a choice, pushing onto an allocator's Vec is a choice — and a
     dyn vector taking a block to hold what was just put in it is the only
     thing it could do. Marking it would squiggle every [(push dv x)] in a
     program that chose dyn. Written down in TODO.org, "Memory diagnostics on
     demand", because it is the one
     row here that the precision rule alone does not decide.
   - Dyn arithmetic is not named. [flan_dyn_add] and its siblings end in
     [flan_dyn_from_i64], so a wide enough result spills, but nothing static
     knows the operands and a squiggle on every [(+ a b)] over dyn is the
     false positive this pass exists not to have. *)

(* The payload's range, restated from [DYN_INT_MAX]/[DYN_INT_MIN] in
   runtime/flan_dyn.c: 2^47-1 and its negation less one. Restated rather than
   read, the way every other number this compiler shares with the runtime is,
   and wrong only in the direction of a missing warning if the runtime ever
   widens it. *)
let dyn_payload_max = 140737488355327L
let dyn_payload_min = -140737488355328L

(* An integer type that cannot reach the payload's edge whatever its value. *)
let narrower_than_payload (t : Types.t) =
  match t with
  | Types.Int (Types.I8 | Types.I16 | Types.I32
              | Types.U8 | Types.U16 | Types.U32) -> true
  | _ -> false

(* Can this argument to [flan_dyn_from_i64] spill onto the heap?

   One level of unwrapping and no more: [box] widens with a single
   [Cast i64], and peeling further would walk through a *narrowing* cast the
   programmer wrote and report a range the value cannot have. *)
let int_may_spill (e : Tast.expr) =
  let e =
    match e.Tast.e with
    | Tast.Prim (Tast.Cast (Types.Int Types.I64), [ inner ])
      when narrower_than_payload inner.Tast.ty -> inner
    | _ -> e
  in
  match e.Tast.e with
  | Tast.Int (n, _) -> n > dyn_payload_max || n < dyn_payload_min
  | _ -> not (narrower_than_payload e.Tast.ty)

(* A [flan_vec_init] whose capacity is a literal zero takes no block. That is
   every [(vec-new T)]; [slurp] passes the file's size and is the caller that
   makes this a test rather than a constant. *)
let vec_init_allocates (args : Tast.expr list) =
  match args with
  | _ :: _ :: cap :: _ ->
    (match cap.Tast.e with Tast.Int (n, _) -> n > 0L | _ -> true)
  | _ -> true

(* The classifier. [Some (kind, message)] for a site that allocates or may,
   [None] for everything else — and [None] is the answer for every symbol not
   named here, which is what keeps a new runtime entry point silent rather
   than guessed at. *)
let memory_class (sym : string) (args : Tast.expr list) =
  let gc m = Some ("memory/gc", m) and native m = Some ("memory/native", m) in
  match sym with
  (* ── The collected heap ── *)
  | "flan_dyn_from_bytes" ->
    gc "allocates: a string crossing into dyn is copied onto the \
        collector's heap"
  | "flan_dyn_vec_new" ->
    gc "allocates: a dyn vector is an object on the collector's heap"
  | "flan_dyn_map_new" ->
    gc "allocates: a dyn map is an object on the collector's heap"
  | "flan_dyn_map_new_class" ->
    gc "allocates: a class instance is a dyn map on the collector's heap, \
        with the class's name in its header"
  | "flan_dyn_view_slice" | "flan_dyn_view_at" ->
    gc "allocates: a typed container crossing into dyn takes a view record \
        on the collector's heap — the elements are not copied, the record is"
  | "flan_dyn_from_i64" when (match args with [ x ] -> int_may_spill x | _ -> true) ->
    gc "may allocate: an i64 outside ±2^47 does not fit a dyn's payload and \
        spills onto the collector's heap"
  | "flan_dyn_from_u64" when (match args with x :: _ -> int_may_spill x | [] -> true) ->
    gc "may allocate: a u64 above 2^47 does not fit a dyn's payload and \
        spills onto the collector's heap"
  (* ── An allocator the program named ── *)
  | "flan_arena_new" ->
    native "allocates: an arena takes its whole region from the host here"
  | "flan_vec_init" when vec_init_allocates args ->
    native "allocates: the Vec is sized up front and takes its block from \
            its allocator here"
  | "flan_vec_push" ->
    native "may allocate: a push past the Vec's capacity grows it through \
            its allocator"
  | "flan_vec_reserve" ->
    native "may allocate: a reserve past the Vec's capacity grows it through \
            its allocator"
  | "flan_map_put" ->
    native "may allocate: a put past the map's load factor grows its block \
            through its allocator"
  | "flan_map_reserve" ->
    native "may allocate: a reserve past the map's load factor grows its \
            block through its allocator"
  | "flan_vec_clone" ->
    native "may allocate: cloning a non-empty Vec takes a new block from its \
            allocator"
  | "flan_map_clone" ->
    native "may allocate: cloning a non-empty map takes a new block from its \
            allocator"
  | _ -> None

(** Every site in the program that allocates, or may. Ordered by source
    position, one diagnostic per location and class — a lowering emits several
    runtime calls at one location and a reader wants the line named once.

    [?file] narrows it to one source file, which is what a command that was
    handed a path wants: the prelude pushes onto Vecs on a dozen lines and an
    import has its own, and neither is a line the person who asked can do
    anything about. Left out, everything the program holds is reported — which
    is what a client that does its own filtering, the editor among them,
    should ask for. *)
let memory_sites ?file (p : Tast.program) : Loc.diag list =
  let found = ref [] in
  let seen = Hashtbl.create 64 in
  let look (e : Tast.expr) =
    let cls =
      match e.Tast.e with
      | Tast.Prim (Tast.Rt sym, args) -> memory_class sym args
      | Tast.Closure (_, env) when heap_env env ->
        Some ("memory/gc",
              "allocates: an fn that captures and outlives its frame keeps its \
               copies in an environment on the collector's heap")
      | _ -> None
    in
    match cls with
    | None -> ()
    | Some (kind, msg) ->
      let loc = e.Tast.loc in
      let key = (loc.Loc.file, loc.Loc.line, loc.Loc.col, kind) in
      if (match file with None -> true | Some f -> String.equal f loc.Loc.file)
         && not (Hashtbl.mem seen key) then begin
        Hashtbl.replace seen key ();
        found := Loc.diag ~kind loc msg :: !found
      end
  in
  (* A global's initialiser runs at startup and allocates there as much as a
     body does — [(defonce names (vec-new dyn))] is a heap object before main
     has a line of its own — so the globals are walked and not only the
     functions. *)
  List.iter (fun (g : Tast.global) -> Tast.walk look g.Tast.ginit) p.Tast.globals;
  List.iter
    (fun (fn : Tast.fn) -> List.iter (Tast.walk look) fn.Tast.body)
    p.Tast.fns;
  let placed (d : Loc.diag) = d.Loc.dloc.Loc.line > 0 in
  List.stable_sort
    (fun a b ->
       match (placed a, placed b) with
       | true, false -> -1
       | false, true -> 1
       | _ -> Loc.before a.Loc.dloc b.Loc.dloc)
    (List.rev !found)

(* The form that decided an inferred return type, for a name whose return
   slot was [_]; [None] for one whose type was written. *)
let inferred_cause env name = Hashtbl.find_opt env.inferred name