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

/-
  Topolei.Cubical.Value
  =====================
  Weak-head normal forms for the cubical calculus (cells-spec §5.4, Phase 1
  Week 2).

  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 (`Env`, `CVal`, `CNeu`) are mutually
  recursive: `CVal` contains closures (which capture their `Env`), `CNeu`
  (stuck terms) carries already-evaluated sub-values, and `Env` stores `CVal`s.

  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`) —
      actual reduction rules arrive in Weeks 3–4 (`Transport.lean`/`Comp.lean`).

  No type-level values yet: `CType` remains syntactic because types are not
  evaluated in the λ-fragment.  When we add the Π/Σ cases of transport the
  evaluator will grow a companion `evalType` returning a `VType`.
-/

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*: the result of
        `transp^i (pi domA codA) φ f` — the full CCHM Π rule, supporting
        both varying domain and varying codomain.  Stores `i`, the domain
        type, the codomain type, the face formula, and the underlying
        function value `f`.

        When applied to an argument `y : A(1)`, it reduces per the CCHM
        Π rule:
          `vApp (.vTranspFun i domA codA φ f) y =`
          `    vTransp i codA φ (vApp f (vTranspInv i domA φ y))`
        That is:
          1. Inversely transport `y` through `domA` to get `y' : A(0)`.
          2. Apply `f` to `y'` to get a value in `B(0)`.
          3. Forward-transport the result through `codA` to land in `B(1)`.

        When `domA` is absent from `i`, step 1 reduces to identity (via
        `vTranspInv_const`), recovering the earlier const-domain form. -/
    | vTranspFun : DimVar → CType → CType → FaceFormula → CVal → CVal
    /-- A *composed function value*: the result of
        `hcomp (pi domA codA) φ tube base`.  Homogeneous composition on a
        Π type reduces pointwise: applied to `y : A`, it returns
        `hcomp codA φ (λj. (tube@j) y) (base y)`.  Stores only `codA`
        (there is no inverse transport through `domA` in homogeneous
        composition, so `domA` plays no role in the reduction), the face
        formula, the tube, and the base function. -/
    | vHCompFun : CType → FaceFormula → CVal → CVal → CVal
    /-- A *point-wise applied tube*: represents `λj. (tube @ j) arg` as
        a dim-abstraction value.  Produced by `vApp` on `vHCompFun` when
        the outer hcomp's tube needs to be threaded into the inner hcomp
        on the codomain.  Reduces under `vPApp r` to
        `vApp (vPApp tube r) arg`. -/
    | vTubeApp : CVal → CVal → CVal
    /-- A *heterogeneous-composition function value*: the result of
        `comp^i (Π domA codA) φ u u₀` at the value level.  Stores env,
        line binder `i`, both CType halves, face, and tube `u` + base
        `u₀` as CTerms (so the CCHM reduction can construct term-level
        comp/transport expressions referencing them).

        Applied to `y : A(1)`, it reduces per CCHM Π hetero comp:
          1. Construct the *fill* `y_at_j : A(j)` — a partial transport
             of `y` backwards along the A-line.
          2. Inner tube: `(u @ i) (y_at_i)` — apply u's tube pointwise.
          3. Inner base: `u₀ (y_at_0)` — apply base to the "inverse-transport"
             endpoint of the fill.
          4. Build a new `comp^i codA φ <inner tube> <inner base>` and
             evaluate.

        When `domA` is absent from `i`, the fill degenerates (constant
        line ⇒ identity transport), so `y_at_i = y_at_0 = y` and the
        reduction specialises to the simpler const-domain form. -/
    | vCompFun : CEnv → DimVar → CType → CType → FaceFormula →
                 CTerm → CTerm → CVal
    /-- A *path-transport value*: the result of
        `transp^i (Path A(i) a(i) b(i)) φ p` at the value level.

        Stores the environment where `a`, `b`, `p` were meaningful, the
        line binder `i`, the path's base type `A` (may vary in `i`), the
        left/right endpoint CTerms, the face formula, and the path term
        `p` as a CTerm (so a later `.papp p r` term can be constructed
        for the CCHM multi-clause reduction).

        Reductions on `vPApp`:
          · At `.zero` → `eval env (a.substDim i .one)` (= a(1)).
          · At `.one`  → `eval env (b.substDim i .one)` (= b(1)).
          · At generic `r` → evaluate the CCHM compN term
            `comp^i A [φ ↦ p@r, (r=0) ↦ a, (r=1) ↦ b] (p@r)` via
            `vCompNAtTerm`.  This genuinely unsticks: when `r` has a
            resolved endpoint, the corresponding clause fires. -/
    | vPathTransp : CEnv → DimVar → CType → CTerm → CTerm → FaceFormula →
                    CTerm → CVal
    /-- A Σ pair value: both components already evaluated.  `vFst` and
        `vSnd` (defined in `Eval.lean`) project out the components; on a
        `vpair` they reduce component-wise, on a `vneu` they produce a
        stuck `.nfst`/`.nsnd` neutral. -/
    | vpair : CVal → CVal → CVal
    /-- Schema constructor application — fully-evaluated, canonical
        constructor of an inductive (or higher-inductive) type (REL1).

        `vctor S c params args` carries:
        - `S : CTypeSchema` — the schema this constructor belongs to.
        - `c : String` — the constructor's name.
        - `params : List CType` — the type parameters at which the
          inductive was instantiated.
        - `args : List CVal` — already-evaluated argument values.

        For path constructors, when a `.dim`-typed arg lands on a face
        in the constructor's boundary system, eval fires the boundary
        clause and never produces a `vctor` — so a `vctor` represents
        a value that is *not* on a boundary face. -/
    | vctor : CTypeSchema → String → List CType → List CVal → CVal
    /-- Lifted dimension-expression value (REL1).  Produced by
        `eval env (.dimExpr r)`; consumed by path-constructor face
        dispatch and by `vPApp` when its left operand is a `vplam`
        whose argument is a `.dimExpr`. -/
    | vdimExpr : DimExpr → CVal

  /-- Neutral (stuck) terms.  Each constructor corresponds to a
      λ-calculus or cubical elimination whose principal argument is itself
      neutral, so the elimination cannot proceed. -/
  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.  The `CType` and
        `FaceFormula` are kept syntactic for now; a later pass will evaluate
        them and destructure per type-former. -/
    | ntransp : DimVar → CType → FaceFormula → CVal → CNeu
    /-- Heterogeneous composition (varying line) with already-evaluated
        system body and base.  Used for `.comp` terms whose type varies
        along the dimension and whose reduction hasn't been pinned by
        one of the special-case rules (`.top`, `.bot`, constant line). -/
    | ncomp   : DimVar → CType → FaceFormula → CVal → CVal → CNeu
    /-- Homogeneous composition (fixed type) with already-evaluated tube
        and base.  Produced by `vHCompValue` when the type isn't a `.pi`
        (Π hcomp reduces to `vHCompFun` instead of a neutral). -/
    | nhcomp  : CType → FaceFormula → CVal → CVal → CNeu
    /-- A stuck multi-clause heterogeneous composition.  Produced by
        `vCompNAtTerm` when none of its reducing arms apply (e.g. every
        clause's face is neither trivially satisfied nor trivially empty,
        and the line type genuinely varies).  Preserves env, binder,
        line type, the evaluated clause list, and the evaluated base. -/
    | ncompN  : CEnv → DimVar → CType →
                List (FaceFormula × CVal) → CVal → CNeu
    /-- A stuck glue introduction.  Produced by `eval` on `.glueIn φ t a`
        when `φ` is neither `.top` (→ `t`) nor `.bot` (→ `a`).  Preserves
        the face formula and both face-on / face-off evaluated sub-values
        so that later dim-substitution can unstick if the face resolves. -/
    | nglueIn : FaceFormula → CVal → CVal → CNeu
    /-- A stuck unglue.  Produced by `eval` on `.unglue φ f g` when `φ` is
        not `.top` (→ `vApp f g`) and `g` is not a glued value whose face
        is `.bot` (→ `g`).  Preserves the face formula, the forward-map
        value `f`, and the argument value `g`. -/
    | nunglue : FaceFormula → CVal → CVal → CNeu
    /-- A stuck first projection.  Produced by `vFst` when its argument
        is itself a neutral (i.e. not a `vpair`). -/
    | nfst    : CNeu → CNeu
    /-- A stuck second projection.  Produced by `vSnd` on a neutral. -/
    | nsnd    : CNeu → CNeu
    /-- A stuck inductive eliminator (REL1).  Produced by `eval`'s
        `.indElim` arm when the target evaluates to a neutral (or a
        non-`vctor` value).  Preserves the schema, parameters, motive,
        evaluated branches, and the underlying neutral target so that
        later substitution / unstucking can fire the matching branch. -/
    | nIndElim : CTypeSchema → List 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