cubical-transport-hott-lean4/CubicalTransport/Value.lean

/-
  CubicalTransport.Value
  ======================
  Weak-head normal forms for the universe-stratified cubical calculus
  (cells-spec §5.4, Layer 0 §0.1 cascade).

  Named-variable adaptation: our `CTerm` uses `String` binders rather than
  de Bruijn indices, so `Env` is a name-keyed association list instead of
  an `Array`.  The three inductives (`CEnv`, `CVal`, `CNeu`) are mutually
  recursive: `CVal` contains closures (which capture their `CEnv`), `CNeu`
  (stuck terms) carries already-evaluated sub-values, and `CEnv` stores
  `CVal`s.

  ## Universe-aware shape

  CVal and CNeu constructors that carry a `CType` payload carry it at an
  implicit `{ℓ : ULevel}` parameter — mirroring the corresponding CTerm
  constructors in `Syntax.lean`.  At the value level the level is
  existentially packaged (forgotten by the constructor); the kernel-side
  level discipline lives on CType, not on CVal.

  Where a constructor stores TWO CTypes that must live at related levels
  (e.g. domain at ℓ and codomain at ℓ'), both levels are bound implicitly.

  Coverage matches the cells-spec's "λ-calculus fragment" milestone:
    · function abstractions and applications (`vlam`/`napp`)
    · dimension abstractions and applications (`vplam`/`npapp`)
    · transport and composition as *stuck* values (`ntransp`/`ncomp`) —
      reduction rules in `Transport.lean`/`Comp.lean`.
-/

import CubicalTransport.Syntax

mutual
  /-- Name-keyed environment: a cons-list of `(name, value)` bindings.  The
      most-recently-extended binding shadows earlier ones of the same name. -/
  inductive CEnv : Type where
    | nil  : CEnv
    | cons : String → CVal → CEnv → CEnv
    deriving Inhabited

  /-- Weak-head normal-form values. -/
  inductive CVal : Type where
    /-- Function closure `(λ x. body)` with captured environment. -/
    | vlam  : CEnv → String → CTerm → CVal
    /-- Dimension-abstraction closure `(⟨i⟩ body)` with captured environment. -/
    | vplam : CEnv → DimVar → CTerm → CVal
    /-- Embedded neutral term — a stuck computation. -/
    | vneu  : CNeu → CVal
    /-- A *transported function value*: result of `transp^i (pi domA codA) φ f`.

        Domain at level `ℓ`, codomain at level `ℓ'`; the result type
        lives at `ULevel.max ℓ ℓ'` (CCHM Π rule).  Levels are
        existentially packaged at the value level. -/
    | vTranspFun {ℓ ℓ' : ULevel} :
        DimVar → CType ℓ → CType ℓ' → FaceFormula → CVal → CVal
    /-- A *composed function value*: result of `hcomp (pi domA codA) φ tube base`.
        Stores only `codA` (homogeneous comp on the domain is trivial
        since A is fixed). -/
    | vHCompFun {ℓ : ULevel} :
        CType ℓ → FaceFormula → CVal → CVal → CVal
    /-- A *point-wise applied tube*: represents `λj. (tube @ j) arg`. -/
    | vTubeApp : CVal → CVal → CVal
    /-- A *heterogeneous-composition function value*: result of
        `comp^i (Π domA codA) φ u u₀` at the value level. -/
    | vCompFun {ℓ ℓ' : ULevel} :
        CEnv → DimVar → CType ℓ → CType ℓ' → FaceFormula →
        CTerm → CTerm → CVal
    /-- A *path-transport value*: result of `transp^i (Path A(i) a(i) b(i)) φ p`. -/
    | vPathTransp {ℓ : ULevel} :
        CEnv → DimVar → CType ℓ → CTerm → CTerm → FaceFormula →
        CTerm → CVal
    /-- A Σ pair value. -/
    | vpair : CVal → CVal → CVal
    /-- Schema constructor application — fully-evaluated, canonical
        constructor of an inductive (or higher-inductive) type (REL1).
        `params` is level-heterogeneous: each entry carries its own ULevel. -/
    | vctor : CTypeSchema → String →
              List (Σ ℓ : ULevel, CType ℓ) → List CVal → CVal
    /-- Lifted dimension-expression value (REL1). -/
    | vdimExpr : DimExpr → CVal
    /-- Value form of `CTerm.code A`.  Carries the encoded CType. -/
    | vcode {ℓ : ULevel} : CType ℓ → CVal

  /-- Neutral (stuck) terms. -/
  inductive CNeu : Type where
    /-- A free variable (name not bound in the current environment). -/
    | nvar    : String → CNeu
    /-- Stuck function application. -/
    | napp    : CNeu → CVal → CNeu
    /-- Stuck dimension application. -/
    | npapp   : CNeu → DimExpr → CNeu
    /-- Transport with an already-evaluated argument.  CType at any level. -/
    | ntransp {ℓ : ULevel} :
        DimVar → CType ℓ → FaceFormula → CVal → CNeu
    /-- Heterogeneous composition (varying line) with already-evaluated
        system body and base. -/
    | ncomp {ℓ : ULevel} :
        DimVar → CType ℓ → FaceFormula → CVal → CVal → CNeu
    /-- Homogeneous composition (fixed type) with already-evaluated tube
        and base. -/
    | nhcomp {ℓ : ULevel} :
        CType ℓ → FaceFormula → CVal → CVal → CNeu
    /-- A stuck multi-clause heterogeneous composition. -/
    | ncompN {ℓ : ULevel} :
        CEnv → DimVar → CType ℓ →
        List (FaceFormula × CVal) → CVal → CNeu
    /-- A stuck glue introduction. -/
    | nglueIn : FaceFormula → CVal → CVal → CNeu
    /-- A stuck unglue. -/
    | nunglue : FaceFormula → CVal → CVal → CNeu
    /-- A stuck first projection. -/
    | nfst    : CNeu → CNeu
    /-- A stuck second projection. -/
    | nsnd    : CNeu → CNeu
    /-- A stuck inductive eliminator (REL1).  `params` is level-heterogeneous. -/
    | nIndElim : CTypeSchema → List (Σ ℓ : ULevel, CType ℓ) → CVal →
                 List (String × CVal) → CNeu → CNeu
end

-- Inhabited instances — needed so `partial def` evaluators can be elaborated
-- (Lean's partial-fixpoint compilation requires a default value for divergence).

instance : Inhabited CNeu := ⟨.nvar "⊥"⟩
instance : Inhabited CVal := ⟨.vneu default⟩

namespace CEnv

/-- Look up a variable name; returns `none` if the name is free. -/
def lookup : CEnv → String → Option CVal
  | .nil,            _ => none
  | .cons n v rest,  x => if x = n then some v else rest.lookup x

/-- Extend an environment with a new `(name, value)` binding. -/
def extend (env : CEnv) (x : String) (v : CVal) : CEnv :=
  .cons x v env

@[simp] theorem lookup_nil (x : String) : CEnv.lookup .nil x = none := rfl

@[simp] theorem lookup_cons_hit (x : String) (v : CVal) (rest : CEnv) :
    (CEnv.cons x v rest).lookup x = some v := by
  simp [lookup]

theorem lookup_cons_miss (x y : String) (v : CVal) (rest : CEnv) (h : y ≠ x) :
    (CEnv.cons x v rest).lookup y = rest.lookup y := by
  simp [lookup, if_neg h]

@[simp] theorem extend_lookup_hit (env : CEnv) (x : String) (v : CVal) :
    (env.extend x v).lookup x = some v := by
  simp [extend]

theorem extend_lookup_miss (env : CEnv) (x y : String) (v : CVal) (h : y ≠ x) :
    (env.extend x v).lookup y = env.lookup y := by
  simp [extend, lookup, if_neg h]

end CEnv