(** The typed IR: what the checker produces and what every backend consumes.

    Three backends share this — the tree-walking interpreter, dev redefinition
    and the release AOT build (plan.org, Compilation) — so everything a backend
    would otherwise have to re-derive is resolved here and nowhere else:

    - names are gone. A local is a slot index into the frame, a global is a
      name, and a call names its callee directly. No environment lookup.
    - field access is an index, not a string, and any auto-deref the source
      relied on is an explicit [Deref] node.
    - literals have a machine type. There is no untyped 1 past this point.
    - a struct literal lists every field in declaration order, with the omitted
      ones filled in as [Zero] — ZII is settled here rather than at runtime.
    - sugar is already gone from the AST; what is left is the small set below. *)

type prim =
  (* arithmetic and comparison, per machine type — the operands carry their own
     kind at runtime, so one constructor covers every width *)
  | Add | Sub | Mul | Div | Rem
  | Eq | Ne | Lt | Le | Gt | Ge
  | Not
  (* bitwise, integers only. [Shr] is arithmetic on a signed type and logical
     on an unsigned one, which is what the operand's own kind already says. *)
  | BitAnd | BitOr | BitXor | Shl | Shr
  (* containers: fixed arrays and slices only at milestone 2 *)
  | Len | At | Slice
  (* the milestone-2 host primitives, plan.org. The four conversions are
     *text*: bytes->f64 parses "12.5", f64->bytes renders it — that is what
     calc-me's tokenizer and the prelude's printers each need. *)
  | Bytes | BytesToF64 | BytesToI64 | F64ToBytes | I64ToBytes
  | WriteStdout | Exit | Argv
  | Cast of Types.t

type expr = { e : expr_kind; ty : Types.t; loc : Loc.t }

and expr_kind =
  | Int    of int64 * Types.ikind
  | Float  of float * Types.fkind
  | Bool   of bool
  | Str    of string
  | Unit
  | Zero   of Types.t                 (* ZII: all-bytes-zero of this type *)
  | Uninit of Types.t                 (* the explicit opt-out *)
  | Local  of int                     (* slot index into the frame *)
  | Global of string
  | Prim   of prim * expr list
  | Call   of string * expr list      (* direct call; no first-class fns yet *)
  | Do     of expr list
  | Let    of (int * expr) list * expr list
  | If     of expr * expr * expr
  | While  of expr * expr list
  | Return of expr option
  | Set    of place * expr
  | Field  of expr * int              (* target is already a struct value *)
  | Addr   of place
  | Deref  of expr
  | Make   of string * expr list      (* struct literal, every field, in order *)
  | Arr    of expr list               (* fixed-array literal *)
  | Some_  of expr
  | None_
  | Match  of expr * arm list
  (* (some x): unwrap Some, else early-return None from the enclosing function.
     An early return, not an expression that can fail — hence its own node. *)
  | UnwrapSome of expr
  (* Conditions, spec-conditions.md. [Signal] walks the handler stack and
     returns Unit whatever it finds — with nothing matching it is a no-op, so
     nothing here alters control flow. [HandlerBind] pushes one frame per
     clause, runs its body, and pops them; each clause was lifted into its own
     function by the checker, so what is left is the frame and the call. *)
  | Signal  of sigkind * int * expr   (* how, the type id, the condition *)
  | Handled of hframe list * expr list
  (* The transfer, spec-conditions.md §3–§6. [RestartCase] pushes one frame per
     clause, runs its body, and pops them; if a transfer arrives naming one of
     *its* frames it runs that clause instead, and the whole form yields either
     way. [InvokeRestart] looks the name up on the restart stack, writes the
     frame it found into the transfer channel and leaves — it has type Never,
     so nothing follows it. *)
  | RestartCase of rclause list * expr
  | InvokeRestart of int * string * Loc.t   (* name id, name, where *)

(* [Serror] is §2's diverging variant: the same lookup, type Never, and with
   nothing transferring the program stops rather than carrying on. *)
and sigkind = Ssignal | Serror

and place =
  | Plocal  of int
  | Pglobal of string
  | Pfield  of expr * int
  | Pindex  of expr * expr list
  | Pderef  of expr

(* A pushed handler: which condition type it matches, and the lifted function
   that runs when one is signalled. *)
and hframe = { htype : int; hfn : string }

(* A restart clause. [rname_id] is what [invoke-restart] matches by name; the
   body is a branch in the function that wrote it, because unlike a handler a
   clause runs at the restart-case, which is where it was written. *)
and rclause = { rname_id : int; rname : string; rbody : expr list }

(* [binds] are the slots the pattern's fields are bound to, in field order. *)
and arm = { acase : string option; binds : int list; abody : expr list }

type field = { fname : string; fty : Types.t }

type structure = { sname : string; fields : field list }

type variant = { vname : string; vfields : field list }

type union = { uname : string; cases : variant list }

type fn = {
  name    : string;
  params  : Types.t list;             (* bound to slots 0 .. n-1, in order *)
  slots   : Types.t array;            (* the frame: one entry per slot *)
  ret     : Types.t;
  body    : expr list;
  (* The defers again, innermost first. [body] already has them spliced onto
     the normal exit path; this is the same list for the *transfer* exit path,
     which leaves through a landing block the backend builds and no form in
     [body] can reach. spec-conditions.md §5: they run, and errdefer does not. *)
  fdefers : expr list;
  (* Set on a function the checker made up rather than one anyone wrote: a
     handler-bind clause, lifted out of the function named here. It is reached
     by address from that function's body and from nowhere else, so it needs no
     cell and no registry slot, and a redefinition of the parent carries its
     own copy. *)
  fparent : string option;
  floc    : Loc.t;
}

(* [gfolded] is the difference between a constant whose value the *checker*
   consumed — an array length, decided before any type resolves — and one that
   is only ever read at run time. The first is in the program's shape and can
   never be reloaded; the second is just bytes in memory and can. Nothing else
   can tell them apart afterwards, so it is recorded here. *)
type global = {
  gname   : string;
  gty     : Types.t;
  ginit   : expr;
  gconst  : bool;
  gfolded : bool;
}

(* A foreign function: no body, and [esym] is the symbol the linker sees. The
   aggregate calling convention is not modelled here — a C shim flattens every
   struct that crosses the boundary, so clang classifies it per target and
   nothing in the backend has to know x86-64 from arm64 from wasm32. *)
type extern = {
  ename   : string;                   (* the Flan name, e.g. rl/init-window *)
  esym    : string;                   (* the C symbol *)
  eparams : Types.t list;
  eret    : Types.t;
}

type program = {
  structs : structure list;
  unions  : union list;
  globals : global list;              (* in declaration order *)
  externs : extern list;
  fns     : fn list;
}

let field_index (s : structure) name =
  let rec go i = function
    | [] -> None
    | f :: rest -> if String.equal f.fname name then Some i else go (i + 1) rest
  in
  go 0 s.fields