diff --git a/.github/scripts/check_sorry_frontier.pl b/.github/scripts/check_sorry_frontier.pl index 5c7d9ff4..ab088d7f 100755 --- a/.github/scripts/check_sorry_frontier.pl +++ b/.github/scripts/check_sorry_frontier.pl @@ -53,6 +53,8 @@ "Lean4Lean/Verify/Typing/Lemmas.lean\0TrProj.instL" => 1, # Tier V - checker verification, blocked on Tiers S/P "Lean4Lean/Verify/Level.lean\0NormLevel.subsumption_eval" => 1, + "Lean4Lean/Verify/Level.lean\0isEquiv_wf" => 1, + "Lean4Lean/Verify/Environment.lean\0addDecl.WF" => 1, "Lean4Lean/Verify/TypeChecker/InferType.lean\0inferProj.WF" => 1, "Lean4Lean/Verify/TypeChecker/WHNF.lean\0reduceRecursor.WF" => 1, "Lean4Lean/Verify/TypeChecker/WHNF.lean\0reduceProj.WF" => 1, diff --git a/.github/workflows/ci.yml b/.github/workflows/ci.yml new file mode 100644 index 00000000..b5578df2 --- /dev/null +++ b/.github/workflows/ci.yml @@ -0,0 +1,58 @@ +name: CI + +on: + push: + branches: [master] + pull_request: + workflow_dispatch: + +# A newer push to the same branch supersedes an in-flight run; master runs are +# never cancelled, since those are the ones that populate the build cache. +concurrency: + group: ${{ github.workflow }}-${{ github.ref }} + cancel-in-progress: ${{ github.ref != 'refs/heads/master' }} + +jobs: + build: + name: Build and self-check + runs-on: ubuntu-latest + timeout-minutes: 60 + steps: + - uses: actions/checkout@v7 + + # Installs the toolchain pinned in `lean-toolchain` and runs `lake build`, + # i.e. the `defaultTargets`: the `Lean4Lean` library, the `lean4lean` exe, + # `Lean4Lean.Theory`, `Lean4Lean.Verify` and `Lean4Lean.Tests`. The proofs + # in `Verify` deliberately contain `sorry`s, so warnings must not fail the + # build. `Lean4Lean.Experimental` is WIP and is not a default target. + - name: Build + uses: leanprover/lean-action@v1 + with: + use-mathlib-cache: false + + # `Lean4Lean.Experimental` is WIP and deliberately not a default target, but it still has to + # compile. `sorry`s here are expected, as in `Verify`. + - name: Build Lean4Lean.Experimental + run: lake build Lean4Lean.Experimental + + # `lake build` only establishes that lean4lean compiles; these check that it still + # *works*. The two modes exercise different code paths, so both are worth running. + + # Module-at-a-time replay, against an environment built from the module's imports. + # This is the path that goes through `replayFromImports`, including the compacted + # region handling that regressed into a SIGSEGV, so keep it as a regression test. + # + # One small module on purpose: `main` spawns an unbounded `IO.asTask` per module and + # each replay imports the world, so peak RSS scales with the fan-out and a large + # prefix (e.g. `Lean4Lean`) is OOM-killed. Widen once replay uses a bounded task + # pool, as lean4checker does. + - name: Replay Init.Core through lean4lean + run: lake exe lean4lean Init.Core + + # `--fresh` instead rechecks the module *and all its imports* into an empty + # environment -- ~43k declarations, the closest thing to an end-to-end kernel test. + # Single-threaded and `withImportModules`-bracketed, so it stays cheap on memory. + # Core only: modules importing `Lean` currently fail with "type checker does not + # support loose bound variables" (digama0/lean4lean#17). + - name: Recheck Init.System.IO and its imports from scratch + run: lake exe lean4lean --fresh Init.System.IO diff --git a/.gitignore b/.gitignore index 569dbeda..a27c2eff 100644 --- a/.gitignore +++ b/.gitignore @@ -1,4 +1,6 @@ /.lake /result /.direnv -/plans +# Keep scratch plans local while versioning the authoritative execution ladder. +/plans/* +!/plans/roadmap.md diff --git a/Lean4Lean/Declaration.lean b/Lean4Lean/Declaration.lean index 94cbdf80..cd6e9299 100644 --- a/Lean4Lean/Declaration.lean +++ b/Lean4Lean/Declaration.lean @@ -2,6 +2,21 @@ import Lean.Declaration namespace Lean + +/-- +The value of a constant for the purpose of delta reduction: definitions and theorems have one, +opaques do not. This mirrors the C++ `constant_info::has_value()`/`get_value()` pair. + +This is deliberately *not* `ConstantInfo.value?`, whose meaning changed in lean4#12973: it now +excludes theorems, but `constant_info::has_value()` was left untouched by that PR, so the kernel +still delta-unfolds theorems: `type_checker::is_delta` uses this predicate to select candidates, +and `instantiate_value_lparams` uses it before reading their values. +-/ +def ConstantInfo.deltaValue? : ConstantInfo → Option Expr + | .defnInfo {value, ..} => some value + | .thmInfo {value, ..} => some value + | _ => none + namespace ReducibilityHints def lt' : ReducibilityHints → ReducibilityHints → Bool -- lean4#2750 diff --git a/Lean4Lean/Environment.lean b/Lean4Lean/Environment.lean index ec97e5b0..226ebd49 100644 --- a/Lean4Lean/Environment.lean +++ b/Lean4Lean/Environment.lean @@ -53,9 +53,9 @@ def addTheorem (env : Environment) (v : TheoremVal) (check := true) (fuel : Fuel if check then -- TODO(Leo): we must add support for handling tasks here M.run env (safety := .safe) (lctx := {}) (lparams := v.levelParams) (fuel := fuel) do + checkConstantVal env v.toConstantVal if !(← isProp v.type) then throw <| .thmTypeIsNotProp env v.name v.type - checkConstantVal env v.toConstantVal let valType ← TypeChecker.checkType v.value if !(← isDefEq valType v.type) then throw <| .declTypeMismatch env (.thmDecl v) valType diff --git a/Lean4Lean/Environment/Basic.lean b/Lean4Lean/Environment/Basic.lean index eae2e6ff..7ed24cd0 100644 --- a/Lean4Lean/Environment/Basic.lean +++ b/Lean4Lean/Environment/Basic.lean @@ -43,9 +43,10 @@ def primitives : NameSet := .ofList [ /-- Returns true iff `constName` is a non-recursive inductive datatype that has only one constructor and no indices. -Such types have special kernel support. This must be in sync with `is_structure_like`. +Such types have special kernel support (e.g. the eta rule). +This must be in sync with `is_non_rec_structure()`. -/ -def isStructureLike (env : Environment) (constName : Name) : Bool := +def isNonRecStructure (env : Environment) (constName : Name) : Bool := match env.find? constName with | some (.inductInfo { isRec := false, ctors := [_], numIndices := 0, .. }) => true | _ => false diff --git a/Lean4Lean/Experimental/NormalEq.lean b/Lean4Lean/Experimental/NormalEq.lean index 99bd557a..3d7b22d6 100644 --- a/Lean4Lean/Experimental/NormalEq.lean +++ b/Lean4Lean/Experimental/NormalEq.lean @@ -5,7 +5,7 @@ import Lean4Lean.Theory.Typing.Pattern namespace Lean4Lean -open VExpr +open Lean4Lean VExpr variable (IsDefEqU : List VExpr → VExpr → VExpr → Prop) (Γ₀ : List VExpr) in inductive IsDefEqCtx : List VExpr → List VExpr → Prop diff --git a/Lean4Lean/Experimental/SExpr.lean b/Lean4Lean/Experimental/SExpr.lean index 3fe153d9..4204fccc 100644 --- a/Lean4Lean/Experimental/SExpr.lean +++ b/Lean4Lean/Experimental/SExpr.lean @@ -2,6 +2,7 @@ import Lean4Lean.Theory.Typing.Lemmas import Lean4Lean.Theory.Typing.Pattern namespace Lean4Lean +open Lean4Lean inductive Classification where | ctor (arity : Nat) diff --git a/Lean4Lean/Experimental/ShapeLogRel.lean b/Lean4Lean/Experimental/ShapeLogRel.lean index 98d62eb3..ac55969e 100644 --- a/Lean4Lean/Experimental/ShapeLogRel.lean +++ b/Lean4Lean/Experimental/ShapeLogRel.lean @@ -1,6 +1,7 @@ import Lean4Lean.Experimental.SExpr namespace Lean4Lean +open Lean4Lean namespace SExpr variable [Params] @@ -2156,9 +2157,7 @@ theorem WShape.ctor'_join {l l' : List (WShape n)} {c : Name} exact ih (fun z hz => h2' z (.tail _ hz)) · rw [dif_pos (key.mpr (.inr h2))]; simp [ctor, bot, Shape.bot_join] have h1' : ∀ x ∈ l, x.1 ≤ Shape.bot := by - have ⟨hIs, hNZ⟩ : IsStruct c = true ∧ ¬ListNonZero l := by - refine ⟨?_, fun hNZ => h1 fun _ => hNZ⟩ - by_contra hIs; exact h1 fun h => (hIs h).elim + have ⟨_, hNZ⟩ := Decidable.not_imp_iff_and_not.1 h1 simp [ListNonZero] at hNZ; exact hNZ congr 1; clear h1 h2 key induction h with | nil => rfl | @cons x y L L' hh _ ih @@ -2531,7 +2530,7 @@ theorem Shape.HasType.unfold_iff {m a : Shape n} : HasType m a ↔ HasTypeU m a | indTy => rfl | forallE => simpa [HasType, hasType] using h | sort => cases n <;> rfl - | forallE H => simpa [HasType, hasType, hasType.core.iff] using H + | forallE H => simpa [HasType, hasType, hasType.core.iff, HasTypePi] using H | lam H => simp [HasType, hasType, hasType.core.iff]; exact H | ctor | indTy => rfl @@ -3440,7 +3439,7 @@ theorem LE_Interp.Matches.head_wf (H : Matches p c rargs m) (wf : p.WF cl top k) theorem LE_Interp.Matches.head_wf_eq (H : Matches p c rargs m) (wf : p.WF cl top k) : cl c = some (if top then .symb (k + rargs.length) else .ctor (k + rargs.length)) := by induction H generalizing k with - | const => simpa using wf + | const => simpa [Pattern.WF] using wf | var _ ih => have := ih (k := k + 1) wf rw [List.length_cons]; rw [Nat.add_succ, ← Nat.succ_add]; exact this @@ -3615,8 +3614,8 @@ theorem pat_arity (hP : Params.Pat p r) (h : Arity (.const c) n p) : clear r hP h; intro cl n k h1 h2 induction h2 generalizing k with | refl => simpa only [Nat.zero_add] - | var _ ih => simpa [Nat.succ_add] using ih _ h1 - | app _ ih => simpa [Nat.succ_add] using ih _ h1.1 + | var _ ih => simpa [Nat.succ_add, ← Nat.add_assoc] using ih _ h1 + | app _ ih => simpa [Nat.succ_add, ← Nat.add_assoc] using ih _ h1.1 theorem LE_Interp.Matches.lift (le : n ≤ n') (H : Matches (n := n) p c rargs m) : ∃ m', Matches p c (rargs.map (.lift n')) m' ∧ ∀ p, m p ≤ m' p ∧ m' p ≤ m p := by @@ -4627,7 +4626,7 @@ structure StrongSoundEq (Γ : List SExpr) (M N A : SExpr) : Prop where left : StrongSound Γ M A right : StrongSound Γ N A -theorem SoundEq.rfl : SoundEq Γ M M := fun _ _ _ _ => .rfl +protected theorem SoundEq.rfl : SoundEq Γ M M := fun _ _ _ _ => .rfl theorem SoundEq.symm : SoundEq Γ M N → SoundEq Γ N M := fun H _ _ W _ => (H W).symm theorem StrongSoundEq.hasType : StrongSoundEq Γ M N A → StrongSound Γ M A ∧ StrongSound Γ N A | ⟨_, _, h1, h2⟩ => ⟨h1, h2⟩ @@ -4713,7 +4712,8 @@ theorem SoundEq.forallE_inv (H : SoundEq Γ (.forallE A B) (.forallE A' B')) · refine fun _ => ⟨_, WShape.bot_le, .bot' (.bot' .sort), ?_⟩ simpa [WShapeFun.single_app] using .rfl · intro x h'; cases h'.bot_r - simpa [WShapeFun.single_app] using h.mono_l fun _ => TShape.bot_le' + simpa [WShapeFun.single_app, show m.2.T = m from rfl] using + h.mono_l fun _ => TShape.bot_le' | @cons Γ ρ A a x b1 b2 b3 b4 => let k := max (max x.1 m.1) a.1 have hk := Nat.max_le.1 (Nat.le_refl k); simp [Nat.max_le] at hk diff --git a/Lean4Lean/Experimental/Stratified.lean b/Lean4Lean/Experimental/Stratified.lean index 251abb12..24c19393 100644 --- a/Lean4Lean/Experimental/Stratified.lean +++ b/Lean4Lean/Experimental/Stratified.lean @@ -4,7 +4,7 @@ import Lean4Lean.Theory.Typing.Strong namespace Lean4Lean namespace VEnv -open VExpr +open Lean4Lean VExpr def DefInv (env : VEnv) (U : Nat) (Γ : List VExpr) : VExpr → VExpr → Prop | .forallE A B, .forallE A' B' => diff --git a/Lean4Lean/Experimental/StratifiedUntyped.lean b/Lean4Lean/Experimental/StratifiedUntyped.lean index d1ba4df8..a3a9218a 100644 --- a/Lean4Lean/Experimental/StratifiedUntyped.lean +++ b/Lean4Lean/Experimental/StratifiedUntyped.lean @@ -4,7 +4,7 @@ import Lean4Lean.Theory.Typing.Strong namespace Lean4Lean namespace VEnv -open VExpr +open Lean4Lean VExpr section set_option hygiene false diff --git a/Lean4Lean/Experimental/Stronger.lean b/Lean4Lean/Experimental/Stronger.lean index 20c308b6..9cdf520d 100644 --- a/Lean4Lean/Experimental/Stronger.lean +++ b/Lean4Lean/Experimental/Stronger.lean @@ -2,7 +2,7 @@ import Lean4Lean.Theory.Typing.Lemmas namespace Lean4Lean -open VExpr +open Lean4Lean VExpr structure VEnv'.VConstant extends Lean4Lean.VConstant where level : VLevel @@ -339,10 +339,12 @@ theorem IsDefEqStrong.instL (H : env.IsDefEqStrong U Γ e1 e2 A u) : | defeqL _ _ h3 _ ih => exact .defeqL (.inst hls) (.inst hls) (VLevel.inst_congr_l h3) ih | beta _ _ _ _ _ _ _ _ ih1 ih2 ih3 ih4 ih5 ih6 => simpa using .beta (.inst hls) (.inst hls) ih1 ih2 ih3 ih4 - (by simpa using ih5) (by simpa using ih6) + (by simpa [VExpr.instL, VLevel.inst] using ih5) + (by simpa [VExpr.instL, VLevel.inst] using ih6) | eta _ _ _ _ _ _ _ ih1 ih2 ih3 ih4 ih5 => simpa [VExpr.instL] using .eta (.inst hls) (.inst hls) ih1 ih2 - (by simpa [VCtx.instL] using ih3) ih4 (by simpa [VExpr.instL] using ih5) + (by simpa [VCtx.instL, VExpr.instL, VLevel.inst] using ih3) ih4 + (by simpa [VCtx.instL, VExpr.instL, VLevel.inst] using ih5) | proofIrrel _ _ _ ih1 ih2 ih3 => exact .proofIrrel ih1 ih2 ih3 | extra h1 h2 h3 h4 _ _ _ _ _ _ ih1 ih2 ih3 ih4 ih5 => diff --git a/Lean4Lean/Inductive/Add.lean b/Lean4Lean/Inductive/Add.lean index 7a0f3e7d..1ceb4816 100644 --- a/Lean4Lean/Inductive/Add.lean +++ b/Lean4Lean/Inductive/Add.lean @@ -28,6 +28,16 @@ structure InductiveStats where isNotZero : Bool deriving Inhabited +/-- Explicit initial state for family validation. Naming this value keeps the +executable producer and its exact-result lemmas independent of the opaque +compiler-generated `Inhabited` instance. -/ +def InductiveStats.initial (levels : List Level) : InductiveStats where + levels := levels + resultLevel := .zero + indConsts := #[] + params := #[] + isNotZero := false + structure Context where env : Environment lctx : LocalContext := {} @@ -76,18 +86,87 @@ instance (priority := low) : MonadLift TypeChecker.M M where x.run c.env c.safety c.lctx c.lparams (fuel := c.fuel) := rfl +@[simp] theorem liftExcept_apply (x : Except Exception α) (c : Context) : + (liftM x : M α) c = x := + rfl + instance (priority := low+1) : MonadWithReaderOf LocalContext M where withReader f x := withReader (fun c => { c with lctx := f c.lctx }) x instance : MonadLCtx M where getLCtx := return (← read).lctx +@[simp] theorem withLocalDecl_apply + (name : Name) (binderInfo : BinderInfo) (type : Expr) + (k : Expr → M α) (context : Context) : + withLocalDecl name binderInfo type k context = + k context.freshExpr + (context.pushLocalDecl name binderInfo type) := by + rfl + @[inline] def withEnv (env : Environment) (x : M α) : M α := withReader (fun c => { c with env }) x +/-- Run a closed-metadata action without inheriting validation-local +declarations. All other reader fields, including the staged environment and +fuel, are preserved exactly. -/ +@[inline] def withEmptyLocalContext (x : M α) : M α := + withReader (fun c : Context => { c with lctx := {} }) x + +@[simp] theorem withEmptyLocalContext_apply (x : M α) (context : Context) : + withEmptyLocalContext x context = x { context with lctx := {} } := by + rfl + def getType (fvar : Expr) : M Expr := return ((← getLCtx).get! fvar.fvarId!).type +/-- Transparent binder-annotation peeling used by inductive checking. + +Lean's `Expr.consumeTypeAnnotations` is an opaque partial implementation. A +kernel proof of an exact successful inductive pass cannot reduce through that +helper, so using it directly would require a separate contract axiom for every +annotated binder. This structural mirror covers the same four top-level +annotations and is regression-checked against Lean's helper below at the +candidate boundary. -/ +def consumeTypeAnnotations : (source : Expr) → Expr + | .app (.app (.const name levels) type) default => + if name = ``_root_.optParam then + consumeTypeAnnotations type + else if name = ``_root_.autoParam then + consumeTypeAnnotations type + else + .app (.app (.const name levels) type) default + | .app (.const name levels) type => + if name = ``_root_.outParam then + consumeTypeAnnotations type + else if name = ``_root_.semiOutParam then + consumeTypeAnnotations type + else + .app (.const name levels) type + | source => source +termination_by source => sizeOf source + +/-- Transparent structural equality used only as a fast path before the +normalization-based universe comparison. -/ +def levelStructEq : Level → Level → Bool + | .zero, .zero => true + | .succ u, .succ v => levelStructEq u v + | .max u₁ u₂, .max v₁ v₂ | .imax u₁ u₂, .imax v₁ v₂ => + levelStructEq u₁ v₁ && levelStructEq u₂ v₂ + | .param u, .param v => u == v + | .mvar u, .mvar v => u == v + | _, _ => false + +/-- Transparent sufficient comparison for the common structural universe +cases used by constructor fields. Every universe is at least zero, successor +is monotone, and otherwise exact structural equality is sufficient. Cases +outside this deliberately small relation continue to the standard +normalization-based `Level.geq` comparison below. -/ +def levelStructGe : Level → Level → Bool + | _, .zero => true + | .succ u, .succ v => levelStructGe u v + | u, v => levelStructEq u v + def checkInductiveTypes (nparams : Nat) (indTypes : Array InductiveType) (k : InductiveStats → M α) : M α := do @@ -104,7 +183,7 @@ def checkInductiveTypes if let .forallE name dom body bi := type then if i < nparams then if stats.indConsts.isEmpty then - withLocalDecl name bi dom.consumeTypeAnnotations fun param => do + withLocalDecl name bi (consumeTypeAnnotations dom) fun param => do let stats := { stats with params := stats.params.push param } let type := body.instantiate1 param loop stats (← whnf type) (i + 1) nindices fuel k @@ -115,7 +194,7 @@ def checkInductiveTypes let type := body.instantiate1 param loop stats (← whnf type) (i + 1) nindices fuel k else - withLocalDecl name bi dom.consumeTypeAnnotations fun arg => do + withLocalDecl name bi (consumeTypeAnnotations dom) fun arg => do let type := body.instantiate1 arg loop stats (← whnf type) i (nindices + 1) fuel k else @@ -130,7 +209,7 @@ def checkInductiveTypes if stats.indConsts.isEmpty then let lctx := (← read).lctx stats := { stats with lctx, resultLevel, isNotZero := resultLevel.isNeverZero } - else if !resultLevel.isEquiv' stats.resultLevel then + else if !resultLevel.isEquiv stats.resultLevel then throw <| .other "mutually inductive types must live in the same universe" stats := { stats with nindices := stats.nindices.push nindices @@ -144,12 +223,72 @@ def checkInductiveTypes assert! stats.params.size == nparams stats termination_by indTypes.size - dIdx - loopInd 0 { (default : InductiveStats) with levels := (← read).lparams.map .param } - -def hasIndOcc (indConsts : Array Expr) (t : Expr) : Bool := - (t.find? fun - | .const e _ => indConsts.any fun I => I.constName! == e - | _ => false).isSome + loopInd 0 (InductiveStats.initial ((← read).lparams.map .param)) + +/-- Exact singleton result of the family-validation pass when the family type +normalizes directly to a sort. This is the non-telescope producer seam used by +end-to-end candidate certificates: the executable pass selects every retained +statistic, while callers supply only the ordinary checker runs it consumed. -/ +def singletonInductiveStats (context : Context) + (indType : InductiveType) (resultLevel : Level) : InductiveStats where + lctx := context.lctx + levels := context.lparams.map .param + resultLevel := resultLevel + nindices := #[0] + indConsts := #[.const indType.name (context.lparams.map .param)] + params := #[] + isNotZero := resultLevel.isNeverZero + +theorem checkInductiveTypes_singleton_zero_of_whnf_sort + (context : Context) (indType : InductiveType) + (inferred : Expr) (resultLevel : Level) + (k : InductiveStats → M α) + (hfuel : 0 < context.fuel.inductiveFuel) + (hclosed : + context.env.checkNoMVarNoFVar indType.name indType.type = .ok ()) + (hcheck : + TypeChecker.M.run context.env context.safety context.lctx + context.lparams context.fuel (TypeChecker.checkType indType.type) = + .ok inferred) + (hwhnf : + TypeChecker.M.run context.env context.safety context.lctx + context.lparams context.fuel (TypeChecker.whnf indType.type) = + .ok (.sort resultLevel)) + (hensure : + TypeChecker.M.run context.env context.safety context.lctx + context.lparams context.fuel + (TypeChecker.ensureSort (.sort resultLevel)) = + .ok (.sort resultLevel)) : + checkInductiveTypes 0 #[indType] k context = + k (singletonInductiveStats context indType resultLevel) context := by + cases hfuel_eq : context.fuel.inductiveFuel with + | zero => omega + | succ fuel => + simp [checkInductiveTypes, checkInductiveTypes.loopInd, + checkInductiveTypes.loopInd.loop, singletonInductiveStats, + readThe, MonadReader.read, MonadReaderOf.read, ReaderT.read, + ReaderT.bind, Bind.bind, Pure.pure, ReaderT.pure, + Except.bind, Except.pure, liftTypeChecker_apply, + hclosed, hcheck, hwhnf, hensure, hfuel_eq, + InductiveStats.initial, Expr.sortLevel!] + +/-- Transparent occurrence test for constants in the inductive block. + +Lean's `Expr.find?` is an opaque native traversal. Using it here makes the +kernel's recursive-family and positivity decisions impossible to reduce in an +exact producer theorem without postulating a separate contract for that +traversal. This structural version follows the same expression children and +keeps those decisions computational in the logic as well as at runtime. -/ +def hasIndOcc (indConsts : Array Expr) : Expr → Bool + | .const name _ => indConsts.any fun I => I.constName! == name + | .app fn arg => hasIndOcc indConsts fn || hasIndOcc indConsts arg + | .lam _ domain body _ | .forallE _ domain body _ => + hasIndOcc indConsts domain || hasIndOcc indConsts body + | .letE _ type value body _ => + hasIndOcc indConsts type || hasIndOcc indConsts value || + hasIndOcc indConsts body + | .mdata _ body | .proj _ _ body => hasIndOcc indConsts body + | _ => false /-- Return true if declaration is recursive -/ def isRec (indTypes : Array InductiveType) (indConsts : Array Expr) : Bool := @@ -185,6 +324,22 @@ def declareInductiveTypes (stats : InductiveStats) (numParams : Nat) env.checkName info.name c.allowPrimitive return env.add (.inductInfo info) +/-- Family declaration observes only the environment, universe parameters, +and primitive-name policy of its reader context. In particular, the local +telescope and fresh-name generator retained by family validation do not alter +the staged environment it produces. -/ +theorem declareInductiveTypes_context_eq + (stats : InductiveStats) (numParams : Nat) + (indTypes : Array InductiveType) (numNested : Nat) + (isUnsafe : Bool) (left right : Context) + (henv : left.env = right.env) + (hlparams : left.lparams = right.lparams) + (hallow : left.allowPrimitive = right.allowPrimitive) : + declareInductiveTypes stats numParams indTypes numNested isUnsafe left = + declareInductiveTypes stats numParams indTypes numNested isUnsafe right := by + unfold declareInductiveTypes + rw [henv, hlparams, hallow] + def isValidIndAppIdx (stats : InductiveStats) (t : Expr) (i : Nat) : Bool := t.withApp fun I args => Id.run do unless I == stats.indConsts[i]! && args.size == stats.params.size + stats.nindices[i]! do @@ -201,6 +356,14 @@ def isValidIndApp? (stats : InductiveStats) (t : Expr) : Option Nat := do return i none +theorem isValidIndApp?_singleton_zero + (stats : InductiveStats) (t : Expr) + (hsize : stats.indConsts.size = 1) + (hvalid : isValidIndAppIdx stats t 0 = true) : + isValidIndApp? stats t = some 0 := by + unfold isValidIndApp? + simp [hsize, hvalid] + def isRecArg (stats : InductiveStats) (t : Expr) : M (Option Nat) := do loop t (← readThe Context).fuel.inductiveFuel where @@ -209,7 +372,7 @@ where | fuel+1 => do let t ← whnf t let .forallE name dom body bi := t | return isValidIndApp? stats t - withLocalDecl name bi dom.consumeTypeAnnotations fun arg => do + withLocalDecl name bi (consumeTypeAnnotations dom) fun arg => do loop (body.instantiate1 arg) fuel def checkPositivity (stats : InductiveStats) (t : Expr) (ctor : Name) (idx : Nat) : @@ -223,7 +386,7 @@ def checkPositivity (stats : InductiveStats) (t : Expr) (ctor : Name) (idx : Nat if hasIndOcc stats.indConsts dom then throw <| .other s!"arg #{idx + 1} of '{ctor}' \ has a non positive occurrence of the datatypes being declared" - withLocalDecl name bi dom.consumeTypeAnnotations fun arg => do + withLocalDecl name bi (consumeTypeAnnotations dom) fun arg => do loop (body.instantiate1 arg) fuel else if let none := isValidIndApp? stats t then throw <| .other s!"arg #{idx + 1} of '{ctor}' \ @@ -242,7 +405,13 @@ def checkConstructors (indTypes : Array InductiveType) foundCtors := foundCtors.insert n let t := ctor.type env.checkNoMVarNoFVar n t - _ ← checkType t + -- Constructor metadata has just been established to contain no free + -- variables. Its full closed-type check must therefore not inherit the + -- parameter/index locals retained by family validation; keeping that + -- check local-context independent also gives candidate replay one stable + -- execution. The telescope loop below deliberately remains in the + -- family context because parameter matching uses `stats.params`. + _ ← withEmptyLocalContext do checkType t let rec loop t i | 0 => throw .deepRecursion | fuel+1 => do @@ -254,12 +423,20 @@ def checkConstructors (indTypes : Array InductiveType) loop (body.instantiate1 param) (i + 1) fuel else let s ← ensureType dom - unless stats.resultLevel.isZero || stats.resultLevel.geq' s.sortLevel! do - throw <| .other s!"universe level of type_of(arg #{i + 1}) of '{n}' \ - is too big for the corresponding inductive datatype" + -- Equal levels are reflexively admissible, so discharge that + -- common case before consulting the full standard-library + -- normalization comparison. Besides avoiding needless work, this + -- keeps exact checker executions reducible without a separate + -- reflexivity contract axiom. + if levelStructGe stats.resultLevel s.sortLevel! then + pure () + else + unless stats.resultLevel.isZero || stats.resultLevel.geq s.sortLevel! do + throw <| .other s!"universe level of type_of(arg #{i + 1}) of '{n}' \ + is too big for the corresponding inductive datatype" if !isUnsafe then checkPositivity stats dom n i - withLocalDecl name bi dom.consumeTypeAnnotations fun arg => do + withLocalDecl name bi (consumeTypeAnnotations dom) fun arg => do loop (body.instantiate1 arg) (i + 1) fuel else if !isValidIndAppIdx stats t idx then throw <| .other s!"invalid return type for '{n}'" @@ -433,6 +610,87 @@ theorem CandidateCheckTypeStep.innerRun exact ⟨state, by simpa [Context.toTypeChecker] using hinner⟩ +/-- One exact successful definitional-equality observation retained by the +candidate producer. The result is fixed to `true`; a negative checker result +is not evidence and aborts candidate construction. -/ +structure CandidateIsDefEqStep where + context : Context + lhs : Expr + rhs : Expr + +def CandidateIsDefEqStep.Valid + (step : CandidateIsDefEqStep) : Prop := + TypeChecker.M.run step.context.env step.context.safety + step.context.lctx step.context.lparams step.context.fuel + (TypeChecker.isDefEq step.lhs step.rhs) = + .ok true + +structure CandidateIsDefEqObservation + (context : Context) (lhs rhs : Expr) : Type where + valid : CandidateIsDefEqStep.Valid ⟨context, lhs, rhs⟩ + +def observeCandidateIsDefEq + (context : Context) (lhs rhs : Expr) : + Except Exception (CandidateIsDefEqObservation context lhs rhs) := + match hrun : + TypeChecker.M.run context.env context.safety context.lctx + context.lparams context.fuel (TypeChecker.isDefEq lhs rhs) with + | .error err => .error err + | .ok false => + .error (.other "normalization candidate changed a binder domain") + | .ok true => .ok ⟨hrun⟩ + +theorem observeCandidateIsDefEq_of_run + (context : Context) (lhs rhs : Expr) + (hrun : CandidateIsDefEqStep.Valid ⟨context, lhs, rhs⟩) : + observeCandidateIsDefEq context lhs rhs = .ok ⟨hrun⟩ := by + change + TypeChecker.M.run context.env context.safety context.lctx + context.lparams context.fuel (TypeChecker.isDefEq lhs rhs) = + .ok true at hrun + unfold observeCandidateIsDefEq + split + · simp_all + · simp_all + · rfl + +/-- Recover the state-bearing equality execution erased by `M.run`. -/ +theorem CandidateIsDefEqStep.innerRun + (step : CandidateIsDefEqStep) (recursionFuel : Nat) + (hdepth : step.context.fuel.recDepth = recursionFuel) + (hvalid : step.Valid) : + ∃ state : TypeChecker.State, + TypeChecker.Inner.isDefEq step.lhs step.rhs + (TypeChecker.Methods.withFuel recursionFuel) + step.context.toTypeChecker + ({} : TypeChecker.State) = + .ok (true, state) := by + unfold CandidateIsDefEqStep.Valid at hvalid + unfold TypeChecker.M.run TypeChecker.isDefEq + TypeChecker.RecM.run at hvalid + simp [readThe, MonadReaderOf.read, ReaderT.read, + ReaderT.bind, StateT.bind, Except.bind, Bind.bind, + StateT.pure, Except.pure, Pure.pure, + StateT.run', Functor.map, Except.map] at hvalid + rw [hdepth] at hvalid + cases hinner : + TypeChecker.Inner.isDefEq step.lhs step.rhs + (TypeChecker.Methods.withFuel recursionFuel) + { env := step.context.env + lctx := step.context.lctx + safety := step.context.safety + lparams := step.context.lparams + fuel := step.context.fuel } + ({} : TypeChecker.State) with + | error err => simp [hinner] at hvalid + | ok pair => + rcases pair with ⟨observed, state⟩ + have : observed = true := by + simpa [hinner] using hvalid + subst observed + exact ⟨state, by + simpa [Context.toTypeChecker] using hinner⟩ + /-- Source-indexed retained full-check execution. -/ structure CandidateCheckTypeRun (source : Expr) where step : CandidateCheckTypeStep @@ -447,12 +705,121 @@ def buildCandidateCheckType | .ok ⟨inferred, valid⟩ => return ⟨⟨context, source, inferred⟩, rfl, valid⟩ +/-- Structural certificate for the four top-level binder-domain annotations +peeled by `Expr.consumeTypeAnnotations`. + +The certificate exposes which application argument survives. Verify can +therefore recover a strict translation and free-variable facts for the +consumed domain from the translated raw domain, without assigning semantic +authority to Lean's opaque helper. -/ +inductive CandidateTypeAnnotationTrace : Expr → Expr → Type where + | identity (source : Expr) : + CandidateTypeAnnotationTrace source source + | outParam (levels : List Level) (type : Expr) + (inner : CandidateTypeAnnotationTrace type consumed) : + CandidateTypeAnnotationTrace + (.app (.const ``outParam levels) type) consumed + | semiOutParam (levels : List Level) (type : Expr) + (inner : CandidateTypeAnnotationTrace type consumed) : + CandidateTypeAnnotationTrace + (.app (.const ``semiOutParam levels) type) consumed + | optParam (levels : List Level) (type default : Expr) + (inner : CandidateTypeAnnotationTrace type consumed) : + CandidateTypeAnnotationTrace + (.app (.app (.const ``optParam levels) type) default) consumed + | autoParam (levels : List Level) (type tactic : Expr) + (inner : CandidateTypeAnnotationTrace type consumed) : + CandidateTypeAnnotationTrace + (.app (.app (.const ``autoParam levels) type) tactic) consumed + +namespace CandidateTypeAnnotationTrace + +/-- Transparent structural mirror of the top-level peeling algorithm. -/ +def build : (source : Expr) → Sigma (CandidateTypeAnnotationTrace source) + | .app (.app (.const name levels) type) default => + if hopt : name = ``_root_.optParam then by + subst name + let ⟨consumed, inner⟩ := build type + exact ⟨consumed, .optParam levels type default inner⟩ + else if hauto : name = ``_root_.autoParam then by + subst name + let ⟨consumed, inner⟩ := build type + exact ⟨consumed, .autoParam levels type default inner⟩ + else + ⟨.app (.app (.const name levels) type) default, .identity _⟩ + | .app (.const name levels) type => + if hout : name = ``_root_.outParam then by + subst name + let ⟨consumed, inner⟩ := build type + exact ⟨consumed, .outParam levels type inner⟩ + else if hsemi : name = ``_root_.semiOutParam then by + subst name + let ⟨consumed, inner⟩ := build type + exact ⟨consumed, .semiOutParam levels type inner⟩ + else + ⟨.app (.const name levels) type, .identity _⟩ + | source => ⟨source, .identity source⟩ +termination_by source => sizeOf source + +/-- The structural annotation builder computes the same transparent peeling +used by inductive validation. This deliberately relates two definitions in +this module, not Lean's opaque `Expr.consumeTypeAnnotations`. -/ +theorem build_consumed (source : Expr) : + (build source).1 = consumeTypeAnnotations source := by + fun_induction build source <;> simp_all [consumeTypeAnnotations] + +end CandidateTypeAnnotationTrace + +/-- A structural peeling certificate. Verify assigns semantic authority only +to the trace; compatibility with Lean's opaque helper is retained as a +differential executable check rather than a proof axiom. -/ +structure CandidateTypeAnnotations (source : Expr) where + consumed : Expr + trace : CandidateTypeAnnotationTrace source consumed + +def buildCandidateTypeAnnotations + (source : Expr) : Except Exception (CandidateTypeAnnotations source) := + let ⟨consumed, trace⟩ := CandidateTypeAnnotationTrace.build source + .ok ⟨consumed, trace⟩ + +namespace CandidateTypeAnnotations + +/-- Operational compatibility with this module's transparent annotation +peeling. Semantic consumers still rely on `trace` plus the retained +definitional-equality execution; `Matches` is used to replay the executable +family-validation path exactly. -/ +def Matches (annotations : CandidateTypeAnnotations source) : Prop := + annotations.consumed = consumeTypeAnnotations source + +theorem matches_of_build + (annotations : CandidateTypeAnnotations source) + (hbuild : buildCandidateTypeAnnotations source = .ok annotations) : + annotations.Matches := by + unfold buildCandidateTypeAnnotations at hbuild + cases htrace : CandidateTypeAnnotationTrace.build source with + | mk consumed trace => + simp only [Except.ok.injEq] at hbuild + subst annotations + simpa [Matches, htrace] using + CandidateTypeAnnotationTrace.build_consumed source + +end CandidateTypeAnnotations + +/-- Differential check pinning the transparent implementation to Lean's +opaque helper. This is executable regression evidence, not a logical premise +of the candidate producer. -/ +def candidateTypeAnnotationsAgree (source : Expr) : Bool := + let ⟨consumed, _⟩ := CandidateTypeAnnotationTrace.build source + consumed.equal source.consumeTypeAnnotations + /-- Context- and source-indexed tree underlying one candidate expression. The recursive indices are important: a Pi-domain trace uses the exact parent -context, while its body trace uses precisely `Context.pushLocalDecl` and the -corresponding fresh free variable. Thus both expression position and checker -context provenance are enforced by the type rather than being invariants of -the producer alone. -/ +context, while its body trace uses precisely `Context.pushLocalDecl` with the +structurally certified annotation-consumed domain and the corresponding fresh +free variable. The retained equality run relates that local declaration back +to the raw binder syntax. Thus expression position, annotation handling, and +checker-context provenance are enforced by the type rather than being +invariants of the producer alone. -/ inductive CandidateExprTrace : Context → Expr → Type where | terminal (context : Context) (source inferred result : Expr) (checked : CandidateCheckTypeStep.Valid @@ -463,29 +830,346 @@ inductive CandidateExprTrace : Context → Expr → Type where (inferred : Expr) (name : Name) (domain body : Expr) (binderInfo : BinderInfo) + (fresh : context.lctx.find? context.freshFVarId = none) + (annotations : CandidateTypeAnnotations domain) + (annotationsEq : CandidateIsDefEqStep.Valid + ⟨context, domain, annotations.consumed⟩) (checked : CandidateCheckTypeStep.Valid ⟨context, source, inferred⟩) (valid : CandidateWhnfStep.Valid ⟨context, source, .forallE name domain body binderInfo⟩) (domainCandidate : CandidateExprTrace context domain) (bodyCandidate : CandidateExprTrace - (context.pushLocalDecl name binderInfo domain.consumeTypeAnnotations) + (context.pushLocalDecl name binderInfo annotations.consumed) (body.instantiate1 context.freshExpr)) : CandidateExprTrace context source namespace CandidateExprTrace +/-- The main Pi spine exposed by candidate WHNF was already present in the +stored source syntax at every traversed body position. + +This is the structural precondition needed by mixed generation: it permits +normalization inside binder domains and at the terminal result, but it does +not let WHNF invent or remove the raw binders that generation must emit. -/ +def storedSpine : + {context : Context} → {source : Expr} → + CandidateExprTrace context source → Bool + | _, _, .terminal .. => true + | _, _, .forallE _ source _ name domain body binderInfo _ _ _ _ _ _ + bodyCandidate => + (source == .forallE name domain body binderInfo) && + storedSpine bodyCandidate + +/-- Number of stored Pi binders on the main (body) path of a candidate. -/ +def spineLength : + {context : Context} → {source : Expr} → + CandidateExprTrace context source → Nat + | _, _, .terminal .. => 0 + | _, _, .forallE _ _ _ _ _ _ _ _ _ _ _ _ _ bodyCandidate => + bodyCandidate.spineLength + 1 + +/-- The exact full-check observation at the root of a candidate trace. -/ +def rootCheck : + CandidateExprTrace context source → + CandidateCheckTypeObservation context source + | .terminal _ _ inferred _ checked _ => ⟨inferred, checked⟩ + | .forallE _ _ inferred _ _ _ _ _ _ _ checked _ _ _ => + ⟨inferred, checked⟩ + +/-- The exact WHNF result at the root, before recursively normalized domains +and bodies are reassembled into `view`. -/ +def rootWhnf : CandidateExprTrace context source → Expr + | .terminal _ _ _ result _ _ => result + | .forallE _ _ _ name domain body binderInfo _ _ _ _ _ _ _ => + .forallE name domain body binderInfo + +theorem rootWhnf_valid (candidate : CandidateExprTrace context source) : + CandidateWhnfStep.Valid ⟨context, source, candidate.rootWhnf⟩ := by + cases candidate <;> assumption + +/-- Reader context reached after following the complete main Π spine. -/ +def terminalContext : CandidateExprTrace context source → Context + | .terminal context _ _ _ _ _ => context + | .forallE _ _ _ _ _ _ _ _ _ _ _ _ _ bodyCandidate => + bodyCandidate.terminalContext + +theorem terminalContext_lparams + (candidate : CandidateExprTrace context source) : + candidate.terminalContext.lparams = context.lparams := by + induction candidate with + | terminal => rfl + | forallE context source inferred name domain body binderInfo fresh + annotations annotationsEq checked valid domainCandidate bodyCandidate + domain_ih body_ih => + simpa [terminalContext, Context.pushLocalDecl] using body_ih + +/-- Non-Π result reached after following the complete main Π spine. -/ +def terminalResult : CandidateExprTrace context source → Expr + | .terminal _ _ _ result _ _ => result + | .forallE _ _ _ _ _ _ _ _ _ _ _ _ _ bodyCandidate => + bodyCandidate.terminalResult + +/-- The first `count` local expressions allocated along the main Π spine. +These are exactly the expressions accumulated as inductive parameters when +`count` is the declaration's `nparams`. -/ +def parameterList : + (count : Nat) → CandidateExprTrace context source → List Expr + | 0, _ => [] + | _ + 1, .terminal .. => [] + | count + 1, + .forallE context _ _ _ _ _ _ _ _ _ _ _ _ bodyCandidate => + context.freshExpr :: bodyCandidate.parameterList count + +theorem parameterList_length + (candidate : CandidateExprTrace context source) + (hcount : count ≤ candidate.spineLength) : + (candidate.parameterList count).length = count := by + induction candidate generalizing count with + | terminal => + simp [spineLength] at hcount + subst count + rfl + | forallE context source inferred name domain body binderInfo fresh + annotations annotationsEq checked valid domainCandidate bodyCandidate + domain_ih body_ih => + cases count with + | zero => rfl + | succ count => + simp only [parameterList, List.length_cons] + rw [body_ih] + simpa [spineLength] using hcount + +/-- Every annotation choice on the main Π spine matches the transparent +peeling operation used by `checkInductiveTypes`. This is operational +provenance, separate from the semantic raw/consumed equality stored at each +candidate node. -/ +def validationAnnotations : + CandidateExprTrace context source → Prop + | .terminal .. => True + | .forallE _ _ _ _ _ _ _ _ annotations _ _ _ _ bodyCandidate => + annotations.Matches ∧ bodyCandidate.validationAnnotations + +/-- Replay the inner family-telescope validator from a candidate's exact main +Π spine. The first `remaining` binders extend `stats.params`; every later +binder contributes an index. The theorem is independent of any fixture and +preserves the exact terminal reader context reached by the executable loop. -/ +theorem checkInductiveTypes_loop_of_candidate + (candidate : CandidateExprTrace context source) + (stats : InductiveStats) (nparams i nindices fuel : Nat) + (remaining : Nat) (k : Expr → InductiveStats → Nat → M α) + (hi : i + remaining = nparams) + (hcount : remaining ≤ candidate.spineLength) + (hfuel : candidate.spineLength < fuel) + (hempty : stats.indConsts.isEmpty = true) + (hannotations : candidate.validationAnnotations) + (hterminal : candidate.terminalResult.isForall = false) : + checkInductiveTypes.loopInd.loop nparams stats candidate.rootWhnf + i nindices fuel k context = + k candidate.terminalResult + { stats with + params := stats.params ++ + (candidate.parameterList remaining).toArray } + (nindices + (candidate.spineLength - remaining)) + candidate.terminalContext := by + induction candidate generalizing i nindices fuel remaining stats with + | terminal context source inferred result checked valid => + simp only [spineLength] at hcount hfuel + have hremaining : remaining = 0 := by omega + subst remaining + have hi' : i = nparams := by omega + subst i + cases stats + cases fuel with + | zero => omega + | succ fuel => + cases result <;> + simp_all [rootWhnf, terminalResult, terminalContext, parameterList, + spineLength, checkInductiveTypes.loopInd.loop, Expr.isForall] + | forallE context source inferred name domain body binderInfo fresh + annotations annotationsEq checked valid domainCandidate bodyCandidate + domain_ih body_ih => + rcases hannotations with ⟨hmatch, hbodyAnnotations⟩ + cases remaining with + | zero => + have hi' : i = nparams := by omega + subst i + have hbodyFuel : bodyCandidate.spineLength < fuel - 1 := by + simp only [spineLength] at hfuel + omega + have hbodyCount : 0 ≤ bodyCandidate.spineLength := Nat.zero_le _ + have hvalid := bodyCandidate.rootWhnf_valid + change TypeChecker.M.run _ _ _ _ _ + (TypeChecker.whnf (body.instantiate1 context.freshExpr)) = + .ok bodyCandidate.rootWhnf at hvalid + rw [show fuel = (fuel - 1) + 1 by omega] + simp only [rootWhnf, checkInductiveTypes.loopInd.loop, + Nat.lt_irrefl, if_false, withLocalDecl_apply] + rw [← hmatch] + simp only [ReaderT.bind, Bind.bind, liftTypeChecker_apply] + rw [hvalid] + simp only [Except.bind] + rw [body_ih stats nparams (nindices + 1) (fuel - 1) 0 rfl + hbodyCount hbodyFuel hempty hbodyAnnotations hterminal] + simp [terminalResult, terminalContext, parameterList, spineLength, + Nat.add_comm, Nat.add_assoc] + | succ remaining => + have hil : i < nparams := by omega + have hbodyCount : remaining ≤ bodyCandidate.spineLength := by + simp only [spineLength] at hcount + omega + have hbodyFuel : bodyCandidate.spineLength < fuel - 1 := by + simp only [spineLength] at hfuel + omega + have hvalid := bodyCandidate.rootWhnf_valid + change TypeChecker.M.run _ _ _ _ _ + (TypeChecker.whnf (body.instantiate1 context.freshExpr)) = + .ok bodyCandidate.rootWhnf at hvalid + rw [show fuel = (fuel - 1) + 1 by omega] + simp only [rootWhnf, checkInductiveTypes.loopInd.loop, hil, if_true, + hempty, withLocalDecl_apply] + rw [← hmatch] + simp only [ReaderT.bind, Bind.bind, liftTypeChecker_apply] + rw [hvalid] + simp only [Except.bind] + rw [body_ih { stats with + params := stats.params.push context.freshExpr } + (i + 1) nindices (fuel - 1) remaining (by omega) + hbodyCount hbodyFuel (by simpa using hempty) hbodyAnnotations + hterminal] + simp [terminalResult, terminalContext, parameterList, spineLength] + +/-- Exact singleton statistics selected by a candidate family spine with an +arbitrary parameter/index split. -/ +def singletonCandidateInductiveStats + (indType : InductiveType) + (candidate : CandidateExprTrace context indType.type) + (nparams : Nat) (resultLevel : Level) : InductiveStats where + lctx := candidate.terminalContext.lctx + levels := context.lparams.map .param + resultLevel := resultLevel + nindices := #[candidate.spineLength - nparams] + indConsts := #[.const indType.name (context.lparams.map .param)] + params := (candidate.parameterList nparams).toArray + isNotZero := resultLevel.isNeverZero + +/-- A source-indexed candidate family spine discharges the complete singleton +family-validation pass for any number of parameters and indices. The result +records the same local expressions, terminal context, index count, universe, +and family constant selected by the executable validator. -/ +theorem checkInductiveTypes_singleton_of_candidate + (indType : InductiveType) + (candidate : CandidateExprTrace context indType.type) + (nparams : Nat) (resultLevel : Level) + (k : InductiveStats → M α) + (hclosed : + context.env.checkNoMVarNoFVar indType.name indType.type = .ok ()) + (hcount : nparams ≤ candidate.spineLength) + (hfuel : candidate.spineLength < context.fuel.inductiveFuel) + (hannotations : candidate.validationAnnotations) + (hterminal : candidate.terminalResult = .sort resultLevel) + (hensure : + TypeChecker.M.run candidate.terminalContext.env + candidate.terminalContext.safety candidate.terminalContext.lctx + candidate.terminalContext.lparams candidate.terminalContext.fuel + (TypeChecker.ensureSort (.sort resultLevel)) = + .ok (.sort resultLevel)) : + checkInductiveTypes nparams #[indType] k context = + k (candidate.singletonCandidateInductiveStats + indType nparams resultLevel) candidate.terminalContext := by + have hcheck := candidate.rootCheck.valid + have hwhnf := candidate.rootWhnf_valid + change TypeChecker.M.run context.env context.safety context.lctx + context.lparams context.fuel (TypeChecker.checkType indType.type) = + .ok candidate.rootCheck.inferred at hcheck + change TypeChecker.M.run context.env context.safety context.lctx + context.lparams context.fuel (TypeChecker.whnf indType.type) = + .ok candidate.rootWhnf at hwhnf + have hterminalForall : candidate.terminalResult.isForall = false := by + rw [hterminal] + rfl + have hterminalLparams : + candidate.terminalContext.lparams = context.lparams := + candidate.terminalContext_lparams + have hparameterLength := candidate.parameterList_length hcount + unfold checkInductiveTypes + simp only [readThe, MonadReader.read, MonadReaderOf.read, ReaderT.read, + ReaderT.bind, Bind.bind, Pure.pure, Except.pure, Except.bind] + rw [checkInductiveTypes.loopInd.eq_1] + have hsize : 0 < #[indType].size := by simp + rw [dif_pos hsize] + rw [show #[indType][0] = indType by rfl] + simp only [readThe, MonadReader.read, MonadReaderOf.read, ReaderT.read, + ReaderT.bind, Bind.bind, Pure.pure, Except.pure, Except.bind, + liftTypeChecker_apply, hclosed, hcheck, hwhnf] + rw [candidate.checkInductiveTypes_loop_of_candidate + (stats := InductiveStats.initial (context.lparams.map .param)) + (nparams := nparams) (i := 0) (nindices := 0) + (fuel := context.fuel.inductiveFuel) (remaining := nparams) + (hi := Nat.zero_add nparams) (hcount := hcount) (hfuel := hfuel) + (hempty := rfl) (hannotations := hannotations) + (hterminal := hterminalForall)] + rw [hterminal] + simp only [ReaderT.bind, Bind.bind, liftTypeChecker_apply] + rw [hensure] + simp only [Except.bind, Expr.sortLevel!] + simp only [InductiveStats.initial, Nat.zero_add] + rw [if_pos (by rfl : #[].isEmpty = true)] + simp only [ReaderT.bind, Bind.bind, ReaderT.pure, Pure.pure, Except.pure, + Except.bind] + rw [checkInductiveTypes.loopInd.eq_1] + have hdone : ¬1 < #[indType].size := by simp + rw [dif_neg hdone] + simp only [readThe, MonadReader.read, MonadReaderOf.read, ReaderT.read, + ReaderT.bind, Bind.bind, Pure.pure, Except.pure, Except.bind] + simp [singletonCandidateInductiveStats, hterminalLparams, + hparameterLength] + +/-- Exact successful singleton family-validation execution retained at the +candidate selected by `buildNormalizationCandidate`. + +The executable validator owns the parameter/index split, result universe, +statistics, and terminal reader context. Keeping the universally quantified +continuation equation makes this a decomposition of the real +`checkInductiveTypes` call rather than a fixture-specific success flag. The +semantic interpretation of the retained candidate remains in Verify. -/ +structure FamilyValidationRun + (indType : InductiveType) + {context : Context} + (candidate : CandidateExprTrace context indType.type) where + nparams : Nat + resultLevel : Level + stats : InductiveStats + stats_eq : stats = candidate.singletonCandidateInductiveStats + indType nparams resultLevel + terminal_eq : candidate.terminalResult = Expr.sort resultLevel + run : ∀ {α} (k : InductiveStats → M α), + checkInductiveTypes nparams #[indType] k context = + k stats candidate.terminalContext + +/-- The retained singleton validation run exposes exactly the candidate view +parameter expressions selected by the executable family pass. -/ +def FamilyValidationRun.parameters + (run : FamilyValidationRun indType candidate) : List Expr := + candidate.parameterList run.nparams + +/-- The retained singleton validation run exposes the number of candidate +view indices following the selected parameter prefix. -/ +def FamilyValidationRun.numIndices + (run : FamilyValidationRun indType candidate) : Nat := + candidate.spineLength - run.nparams + /-- Candidate expression reconstructed from the traced WHNF/Pi tree. -/ def view : CandidateExprTrace context source → Expr | .terminal _ _ _ result _ _ => result - | .forallE context _ _ name _ _ binderInfo _ _ domain body => + | .forallE context _ _ name _ _ binderInfo _ _ _ _ _ domain body => .forallE name domain.view (body.view.abstract #[context.freshExpr]) binderInfo /-- Preorder list of all retained checker observations. -/ def steps : CandidateExprTrace context source → List CandidateWhnfStep | .terminal context source _ result _ _ => [{ context, source, result }] - | .forallE context source _ name domain body binderInfo _ _ + | .forallE context source _ name domain body binderInfo _ _ _ _ _ domainCandidate bodyCandidate => { context, source, result := .forallE name domain body binderInfo } :: @@ -495,11 +1179,20 @@ def steps : CandidateExprTrace context source → List CandidateWhnfStep def checkSteps : CandidateExprTrace context source → List CandidateCheckTypeStep | .terminal context source inferred _ _ _ => [{ context, source, inferred }] - | .forallE context source inferred _ _ _ _ _ _ + | .forallE context source inferred _ _ _ _ _ _ _ _ _ domainCandidate bodyCandidate => { context, source, inferred } :: domainCandidate.checkSteps ++ bodyCandidate.checkSteps +/-- Preorder list of all retained binder-domain equality observations. -/ +def isDefEqSteps : + CandidateExprTrace context source → List CandidateIsDefEqStep + | .terminal .. => [] + | .forallE context _ _ _ domain _ _ _ annotations _ _ _ + domainCandidate bodyCandidate => + { context, lhs := domain, rhs := annotations.consumed } :: + domainCandidate.isDefEqSteps ++ bodyCandidate.isDefEqSteps + /-- Every retained WHNF observation is an exact checker execution. -/ def allValid : (candidate : CandidateExprTrace context source) → ∀ step ∈ candidate.steps, step.Valid @@ -507,7 +1200,7 @@ def allValid : (candidate : CandidateExprTrace context source) → simp only [steps, List.mem_singleton] at h subst step exact valid - | .forallE _ _ _ _ _ _ _ _ valid domain body, step, h => by + | .forallE _ _ _ _ _ _ _ _ _ _ _ valid domain body, step, h => by simp only [steps, List.mem_cons, List.mem_append] at h rcases h with (rfl | h) | h · exact valid @@ -521,13 +1214,26 @@ def allChecksValid : (candidate : CandidateExprTrace context source) → simp only [checkSteps, List.mem_singleton] at h subst step exact checked - | .forallE _ _ _ _ _ _ _ checked _ domain body, step, h => by + | .forallE _ _ _ _ _ _ _ _ _ _ checked _ domain body, step, h => by simp only [checkSteps, List.mem_cons, List.mem_append] at h rcases h with (rfl | h) | h · exact checked · exact domain.allChecksValid step h · exact body.allChecksValid step h +/-- Every retained binder-domain equality is an exact successful checker +execution. -/ +def allIsDefEqValid : (candidate : CandidateExprTrace context source) → + ∀ step ∈ candidate.isDefEqSteps, step.Valid + | .terminal .., step, h => by simp [isDefEqSteps] at h + | .forallE _ _ _ _ _ _ _ _ _ annotationsEq _ _ domain body, + step, h => by + simp only [isDefEqSteps, List.mem_cons, List.mem_append] at h + rcases h with (rfl | h) | h + · exact annotationsEq + · exact domain.allIsDefEqValid step h + · exact body.allIsDefEqValid step h + end CandidateExprTrace /-- Source-indexed trace for one candidate expression. The tree records the @@ -552,6 +1258,11 @@ def CandidateExpr.checkSteps List CandidateCheckTypeStep := candidate.trace.checkSteps +def CandidateExpr.isDefEqSteps + (candidate : CandidateExpr source) : + List CandidateIsDefEqStep := + candidate.trace.isDefEqSteps + theorem CandidateExpr.step_valid (candidate : CandidateExpr source) (hstep : step ∈ candidate.steps) : @@ -564,11 +1275,19 @@ theorem CandidateExpr.checkStep_valid step.Valid := candidate.trace.allChecksValid step hstep +theorem CandidateExpr.isDefEqStep_valid + (candidate : CandidateExpr source) + (hstep : step ∈ candidate.isDefEqSteps) : + step.Valid := + candidate.trace.allIsDefEqValid step hstep + /-- Normalize exactly the expression positions inspected by inductive analysis. Each node is fully checked and then exposed with the ordinary -checker `whnf`; Pi domains and bodies are traversed under the same raw local -declarations used by kernel checking. The recursion budget is the configured -inductive fuel, while every checker run uses the configured +checker `whnf`; Pi domains retain their raw syntax, while bodies are traversed +under the structurally certified annotation-consumed local declarations used +by kernel checking. Every raw/consumed domain pair is also checked by an exact +successful ordinary-checker `isDefEq` run. The recursion budget is the +configured inductive fuel, while every checker run uses the configured transparency/fuel. The returned trace is only a candidate analysis view and operational @@ -591,17 +1310,86 @@ where | .ok ⟨view, valid⟩ => match view with | .forallE name domain body binderInfo => - let domainCandidate ← loop context domain fuel - let bodyContext := - context.pushLocalDecl name binderInfo - domain.consumeTypeAnnotations - let bodyCandidate ← loop bodyContext - (body.instantiate1 context.freshExpr) fuel - return .forallE context e inferred name domain body - binderInfo checked valid domainCandidate bodyCandidate + match hfresh : context.lctx.find? context.freshFVarId with + | some _ => + throw (Exception.other + "normalization candidate generated a duplicate free variable") + | none => + let annotations ← buildCandidateTypeAnnotations domain + let ⟨annotationsEq⟩ ← observeCandidateIsDefEq + context domain annotations.consumed + let domainCandidate ← loop context domain fuel + let bodyContext := + context.pushLocalDecl name binderInfo + annotations.consumed + let bodyCandidate ← loop bodyContext + (body.instantiate1 context.freshExpr) fuel + return .forallE context e inferred name domain body + binderInfo hfresh annotations annotationsEq checked valid + domainCandidate bodyCandidate | result => return .terminal context e inferred result checked valid +/-- One terminal recursive step of `buildCandidateExpr`, with its traversal +budget made explicit. This is the reusable reduction seam for exact producer +fixtures; all semantic evidence remains the ordinary checker executions +stored in the resulting trace. -/ +theorem buildCandidateExpr_loop_of_whnf_nonForall + (context : Context) (e inferred view : Expr) (fuel : Nat) + (hcheck : CandidateCheckTypeStep.Valid + ⟨context, e, inferred⟩) + (hrun : CandidateWhnfStep.Valid ⟨context, e, view⟩) + (hview : view.isForall = false) : + buildCandidateExpr.loop context e (fuel + 1) = + .ok (.terminal context e inferred view hcheck hrun) := by + unfold buildCandidateExpr.loop + rw [observeCandidateCheckType_of_run context e inferred hcheck] + rw [observeCandidateWhnf_of_run context e view hrun] + cases view <;> + simp_all [Expr.isForall, Pure.pure, Except.pure] + +/-- One forall recursive step of `buildCandidateExpr`, exposing the exact +child executions used at the decremented traversal budget. -/ +theorem buildCandidateExpr_loop_of_whnf_forall + (context : Context) (e inferred : Expr) (fuel : Nat) + (name : Name) (domain body : Expr) (binderInfo : BinderInfo) + (hfresh : context.lctx.find? context.freshFVarId = none) + (annotations : CandidateTypeAnnotations domain) + (hannotations : + buildCandidateTypeAnnotations domain = .ok annotations) + (hannotationsEq : CandidateIsDefEqStep.Valid + ⟨context, domain, annotations.consumed⟩) + (hcheck : CandidateCheckTypeStep.Valid + ⟨context, e, inferred⟩) + (hrun : CandidateWhnfStep.Valid + ⟨context, e, .forallE name domain body binderInfo⟩) + (domainCandidate : CandidateExprTrace context domain) + (bodyCandidate : CandidateExprTrace + (context.pushLocalDecl name binderInfo annotations.consumed) + (body.instantiate1 context.freshExpr)) + (hdomain : + buildCandidateExpr.loop context domain fuel = + .ok domainCandidate) + (hbody : + buildCandidateExpr.loop + (context.pushLocalDecl name binderInfo annotations.consumed) + (body.instantiate1 context.freshExpr) fuel = + .ok bodyCandidate) : + buildCandidateExpr.loop context e (fuel + 1) = + .ok (.forallE context e inferred name domain body binderInfo + hfresh annotations hannotationsEq hcheck hrun + domainCandidate bodyCandidate) := by + unfold buildCandidateExpr.loop + simp only [observeCandidateCheckType_of_run context e inferred hcheck, + observeCandidateWhnf_of_run context e + (.forallE name domain body binderInfo) hrun] + split + · simp_all + · simp [Bind.bind, Except.bind, hannotations, + observeCandidateIsDefEq_of_run context domain + annotations.consumed hannotationsEq, + hdomain, hbody, Pure.pure, Except.pure] + /-- Erase the operational trace and retain only the analysis expression. -/ def normalizeCandidateExpr (e : Expr) : M Expr := do return (← buildCandidateExpr e).view @@ -674,6 +1462,10 @@ def toList (f : (a : α) → F a → β) : | .nil => [] | .cons head tail => f _ head :: tail.toList f +/-- Eliminate a source-indexed singleton without a partial list operation. -/ +def singleton : CandidateList F [source] → F source + | .cons head .nil => head + end CandidateList /-- Candidate for one constructor; its header is always taken from `source`. -/ @@ -736,6 +1528,95 @@ def normalizeCandidateFamilyList : normalizeCandidateConstructorList indType.ctors } (← normalizeCandidateFamilyList tail) +/-- Exact successful traversal of an arbitrary source-indexed family-type +list. The dependent indices prevent a proof for one metadata position from +being reused at another position or from silently truncating the source. -/ +inductive CandidateFamilyTypeListProduced (context : Context) : + {sources : List InductiveType} → + CandidateList CandidateFamilyType sources → Prop where + | nil : CandidateFamilyTypeListProduced context .nil + | cons + (head : normalizeCandidateFamilyType source context = .ok candidate) + (tail : CandidateFamilyTypeListProduced context candidates) : + CandidateFamilyTypeListProduced context (.cons candidate candidates) + +/-- A source-indexed family-type traversal determines the complete executable +list result for any length, without a fixture-specific list reduction. -/ +theorem CandidateFamilyTypeListProduced.normalize + {sources : List InductiveType} + {candidates : CandidateList CandidateFamilyType sources} + (run : CandidateFamilyTypeListProduced context candidates) : + normalizeCandidateFamilyTypeList sources context = .ok candidates := by + induction run with + | nil => rfl + | cons head tail ih => + unfold normalizeCandidateFamilyTypeList + simp only [ReaderT.bind, Bind.bind] + rw [head, ih] + rfl + +/-- Exact successful traversal of an arbitrary source-indexed constructor +list in one post-family context. Every candidate remains indexed by its source +constructor, so ordering, length, and header provenance are preserved by the +type rather than recovered from an erased list equality. -/ +inductive CandidateConstructorListProduced (context : Context) : + {sources : List Constructor} → + CandidateList CandidateConstructor sources → Prop where + | nil : CandidateConstructorListProduced context .nil + | cons + (head : normalizeCandidateConstructor source context = .ok candidate) + (tail : CandidateConstructorListProduced context candidates) : + CandidateConstructorListProduced context (.cons candidate candidates) + +/-- A source-indexed constructor traversal determines the complete executable +list result for any length, with no `zip`, partial lookup, or fixture-specific +cons-chain reduction. -/ +theorem CandidateConstructorListProduced.normalize + {sources : List Constructor} + {candidates : CandidateList CandidateConstructor sources} + (run : CandidateConstructorListProduced context candidates) : + normalizeCandidateConstructorList sources context = .ok candidates := by + induction run with + | nil => rfl + | cons head tail ih => + unfold normalizeCandidateConstructorList + simp only [ReaderT.bind, Bind.bind] + rw [head, ih] + rfl + +/-- Exact successful assembly of complete family candidates from an already +source-indexed family-type list. Each constructor traversal is tied to the +corresponding family source, and the tail remains tied to the remaining family +sources. This is the reusable ordered-list boundary needed before mutual-block +staging. -/ +inductive CandidateFamilyListProduced (context : Context) : + {sources : List InductiveType} → + CandidateList CandidateFamilyType sources → + CandidateList CandidateFamily sources → Prop where + | nil : CandidateFamilyListProduced context .nil .nil + | cons + (constructors : CandidateConstructorListProduced + context family.constructors) + (tail : CandidateFamilyListProduced context familyTypes families) : + CandidateFamilyListProduced context + (.cons family.familyType familyTypes) (.cons family families) + +/-- Source-indexed family assembly determines the exact executable family-list +result for arbitrary list lengths. -/ +theorem CandidateFamilyListProduced.normalize + {sources : List InductiveType} + {familyTypes : CandidateList CandidateFamilyType sources} + {families : CandidateList CandidateFamily sources} + (run : CandidateFamilyListProduced context familyTypes families) : + normalizeCandidateFamilyList familyTypes context = .ok families := by + induction run with + | nil => rfl + | cons constructors tail ih => + unfold normalizeCandidateFamilyList + simp only [ReaderT.bind, Bind.bind] + rw [constructors.normalize, ih] + rfl + /-- Shape-preserving output of the executable normalization-candidate pass. The dependent family/constructor lists prevent positional provenance from being silently reused for a different inductive request. Names, ordering, and @@ -758,17 +1639,28 @@ analyzer and Verify semantic certificate remain separate downstream gates. -/ def buildNormalizationCandidate (nparams : Nat) (types : List InductiveType) (numNested : Nat) (isUnsafe : Bool) : - M (NormalizationCandidate types) := do + M (NormalizationCandidate types) := + -- Family validation retains its parameter/index telescope while invoking + -- the continuation. That context is required by `checkConstructors`, whose + -- parameter checks refer to the free variables recorded in `stats`, but it + -- is not part of the closed metadata being normalized. Snapshot the entry + -- context so both candidate traversals use one stable fresh-name provenance + -- and an empty local context; only the staged kernel environment changes. + fun candidateContext => let indTypes := types.toArray - checkInductiveTypes nparams indTypes fun stats => do + checkInductiveTypes nparams indTypes (fun stats => do let familyTypes ← - withReader (fun c : Context => { c with lctx := {} }) do + withReader (fun _ : Context => { candidateContext with lctx := {} }) do normalizeCandidateFamilyTypeList types let familyEnv ← declareInductiveTypes stats nparams indTypes numNested isUnsafe withEnv familyEnv do checkConstructors indTypes stats isUnsafe - return ⟨← normalizeCandidateFamilyList familyTypes⟩ + let families ← + withReader (fun _ : Context => + { candidateContext with env := familyEnv, lctx := {} }) do + normalizeCandidateFamilyList familyTypes + return ⟨families⟩) candidateContext /-- info: 'Lean4Lean.AddInductive.buildCandidateExpr' depends on axioms: [propext, Classical.choice, Quot.sound] @@ -776,6 +1668,54 @@ info: 'Lean4Lean.AddInductive.buildCandidateExpr' depends on axioms: [propext, C #guard_msgs in #print axioms buildCandidateExpr +/-- +info: 'Lean4Lean.AddInductive.observeCandidateIsDefEq_of_run' depends on axioms: [propext, Classical.choice, Quot.sound] +-/ +#guard_msgs in +#print axioms observeCandidateIsDefEq_of_run + +/-- +info: 'Lean4Lean.AddInductive.buildCandidateExpr_loop_of_whnf_nonForall' depends on axioms: [propext, + Classical.choice, + Quot.sound] +-/ +#guard_msgs in +#print axioms buildCandidateExpr_loop_of_whnf_nonForall + +/-- +info: 'Lean4Lean.AddInductive.buildCandidateExpr_loop_of_whnf_forall' depends on axioms: [propext, + Classical.choice, + Quot.sound] +-/ +#guard_msgs in +#print axioms buildCandidateExpr_loop_of_whnf_forall + +/-- +info: 'Lean4Lean.AddInductive.CandidateTypeAnnotationTrace.build' depends on axioms: [propext, Quot.sound] +-/ +#guard_msgs in +#print axioms CandidateTypeAnnotationTrace.build + +/-- +info: 'Lean4Lean.AddInductive.CandidateTypeAnnotationTrace.build_consumed' depends on axioms: [propext, Quot.sound] +-/ +#guard_msgs in +#print axioms CandidateTypeAnnotationTrace.build_consumed + +/-- +info: 'Lean4Lean.AddInductive.buildCandidateTypeAnnotations' depends on axioms: [propext, Classical.choice, Quot.sound] +-/ +#guard_msgs in +#print axioms buildCandidateTypeAnnotations + +/-- +info: 'Lean4Lean.AddInductive.CandidateTypeAnnotations.matches_of_build' depends on axioms: [propext, + Classical.choice, + Quot.sound] +-/ +#guard_msgs in +#print axioms CandidateTypeAnnotations.matches_of_build + /-- info: 'Lean4Lean.AddInductive.buildCandidateCheckType' depends on axioms: [propext, Classical.choice, Quot.sound] -/ @@ -788,6 +1728,110 @@ info: 'Lean4Lean.AddInductive.buildNormalizationCandidate' depends on axioms: [p #guard_msgs in #print axioms buildNormalizationCandidate +/-- +info: 'Lean4Lean.AddInductive.CandidateFamilyTypeListProduced.normalize' depends on axioms: [propext, + Classical.choice, + Quot.sound] +-/ +#guard_msgs in +#print axioms CandidateFamilyTypeListProduced.normalize + +/-- +info: 'Lean4Lean.AddInductive.CandidateConstructorListProduced.normalize' depends on axioms: [propext, + Classical.choice, + Quot.sound] +-/ +#guard_msgs in +#print axioms CandidateConstructorListProduced.normalize + +/-- +info: 'Lean4Lean.AddInductive.CandidateFamilyListProduced.normalize' depends on axioms: [propext, + Classical.choice, + Quot.sound] +-/ +#guard_msgs in +#print axioms CandidateFamilyListProduced.normalize + +/-- +info: 'Lean4Lean.AddInductive.CandidateList.singleton' does not depend on any axioms +-/ +#guard_msgs in +#print axioms CandidateList.singleton + +/-- +info: 'Lean4Lean.AddInductive.CandidateExprTrace.storedSpine' depends on axioms: [propext, Classical.choice, Quot.sound] +-/ +#guard_msgs in +#print axioms CandidateExprTrace.storedSpine + +/-- +info: 'Lean4Lean.AddInductive.CandidateExprTrace.spineLength' depends on axioms: [propext, Classical.choice, Quot.sound] +-/ +#guard_msgs in +#print axioms CandidateExprTrace.spineLength + +/-- +info: 'Lean4Lean.AddInductive.CandidateExprTrace.rootWhnf_valid' depends on axioms: [propext, Classical.choice, Quot.sound] +-/ +#guard_msgs in +#print axioms CandidateExprTrace.rootWhnf_valid + +/-- +info: 'Lean4Lean.AddInductive.CandidateExprTrace.terminalContext_lparams' depends on axioms: [propext, + Classical.choice, + Quot.sound] +-/ +#guard_msgs in +#print axioms CandidateExprTrace.terminalContext_lparams + +/-- +info: 'Lean4Lean.AddInductive.CandidateExprTrace.parameterList_length' depends on axioms: [propext, + Classical.choice, + Quot.sound] +-/ +#guard_msgs in +#print axioms CandidateExprTrace.parameterList_length + +/-- +info: 'Lean4Lean.AddInductive.CandidateExprTrace.checkInductiveTypes_loop_of_candidate' depends on axioms: [propext, + Classical.choice, + Quot.sound] +-/ +#guard_msgs in +#print axioms CandidateExprTrace.checkInductiveTypes_loop_of_candidate + +/-- +info: 'Lean4Lean.AddInductive.CandidateExprTrace.checkInductiveTypes_singleton_of_candidate' depends on axioms: [propext, + Classical.choice, + Quot.sound] +-/ +#guard_msgs in +#print axioms CandidateExprTrace.checkInductiveTypes_singleton_of_candidate + +/-- +info: 'Lean4Lean.AddInductive.CandidateExprTrace.FamilyValidationRun' depends on axioms: [propext, + Classical.choice, + Quot.sound] +-/ +#guard_msgs in +#print axioms CandidateExprTrace.FamilyValidationRun + +/-- +info: 'Lean4Lean.AddInductive.CandidateExprTrace.FamilyValidationRun.parameters' depends on axioms: [propext, + Classical.choice, + Quot.sound] +-/ +#guard_msgs in +#print axioms CandidateExprTrace.FamilyValidationRun.parameters + +/-- +info: 'Lean4Lean.AddInductive.CandidateExprTrace.FamilyValidationRun.numIndices' depends on axioms: [propext, + Classical.choice, + Quot.sound] +-/ +#guard_msgs in +#print axioms CandidateExprTrace.FamilyValidationRun.numIndices + /-- info: 'Lean4Lean.AddInductive.CandidateExpr.step_valid' depends on axioms: [propext, Classical.choice, Quot.sound] -/ @@ -800,6 +1844,12 @@ info: 'Lean4Lean.AddInductive.CandidateExpr.checkStep_valid' depends on axioms: #guard_msgs in #print axioms CandidateExpr.checkStep_valid +/-- +info: 'Lean4Lean.AddInductive.CandidateExpr.isDefEqStep_valid' depends on axioms: [propext, Classical.choice, Quot.sound] +-/ +#guard_msgs in +#print axioms CandidateExpr.isDefEqStep_valid + /-- info: 'Lean4Lean.AddInductive.CandidateWhnfStep.innerRun' depends on axioms: [propext, Classical.choice, Quot.sound] -/ @@ -812,6 +1862,12 @@ info: 'Lean4Lean.AddInductive.CandidateCheckTypeStep.innerRun' depends on axioms #guard_msgs in #print axioms CandidateCheckTypeStep.innerRun +/-- +info: 'Lean4Lean.AddInductive.CandidateIsDefEqStep.innerRun' depends on axioms: [propext, Classical.choice, Quot.sound] +-/ +#guard_msgs in +#print axioms CandidateIsDefEqStep.innerRun + def declareConstructors (stats : InductiveStats) (indTypes : Array InductiveType) (isUnsafe : Bool) : M Environment := fun c => indTypes.foldlM (init := c.env) fun env indType => do @@ -843,7 +1899,7 @@ def isLargeEliminator (stats : InductiveStats) (indTypes : Array InductiveType) | 0 => throw .deepRecursion | fuel+1 => do if let .forallE name dom body bi := type then - withLocalDecl name bi dom.consumeTypeAnnotations fun arg => do + withLocalDecl name bi (consumeTypeAnnotations dom) fun arg => do let mut toCheck := toCheck if i ≥ stats.params.size then if !(← ensureType dom).sortLevel!.isZero then @@ -888,7 +1944,7 @@ def loopArgs1 (stats : InductiveStats) (type : Expr) (i : Nat) (indices : Array if i < stats.params.size then loopArgs1 stats (← whnf <| body.instantiate1 stats.params[i]!) (i + 1) indices fuel k else - withLocalDecl name bi dom.consumeTypeAnnotations fun arg => do + withLocalDecl name bi (consumeTypeAnnotations dom) fun arg => do loopArgs1 stats (← whnf <| body.instantiate1 arg) i (indices.push arg) fuel k else k indices @@ -899,11 +1955,11 @@ def loopInd1 (dIdx : Nat) (recInfos : Array RecInfo) (k : Array RecInfo → M α let ctx ← readThe Context loopArgs1 stats (← whnf indTypes[dIdx].type) 0 #[] ctx.fuel.inductiveFuel fun indices => let tTy := mkAppN (mkAppN stats.indConsts[dIdx]! stats.params) indices - withLocalDecl `t .default tTy.consumeTypeAnnotations fun major => do + withLocalDecl `t .default (consumeTypeAnnotations tTy) fun major => do let lctx ← getLCtx let motiveTy := lctx.mkForall indices <| lctx.mkForall #[major] <| .sort elimLevel let name := if indTypes.size > 1 then (`motive).appendIndexAfter (dIdx+1) else `motive - withLocalDecl name .default motiveTy.consumeTypeAnnotations fun motive => do + withLocalDecl name .default (consumeTypeAnnotations motiveTy) fun motive => do loopInd1 (dIdx + 1) (recInfos.push { motive, minors := #[], indices, major }) k else k recInfos @@ -920,7 +1976,7 @@ where if let some param := stats.params[i]? then loop (body.instantiate1 param) (i + 1) bu u fuel else - withLocalDecl name bi dom.consumeTypeAnnotations fun arg => do + withLocalDecl name bi (consumeTypeAnnotations dom) fun arg => do let bu := bu.push arg let u := if (← isRecArg stats dom).isSome then u.push arg else u loop (body.instantiate1 arg) (i + 1) bu u fuel @@ -933,7 +1989,7 @@ where | 0 => throw .deepRecursion | fuel+1 => do if let .forallE name dom body bi := uiTy then - withLocalDecl name bi dom.consumeTypeAnnotations fun arg => do + withLocalDecl name bi (consumeTypeAnnotations dom) fun arg => do loop (← whnf <| body.instantiate1 arg) (xs.push arg) fuel else k uiTy xs @@ -947,7 +2003,7 @@ def loopU (i : Nat) (v : Array Expr) (k : Array Expr → M α) : M α := do return (← getLCtx).mkForall xs <| .app (mkAppN recInfos[itIdx]!.motive itIndices) (mkAppN ui xs) let vName := ((← getLCtx).get! ui.fvarId!).userName.appendAfter "_ih" - withLocalDecl vName .default viTy.consumeTypeAnnotations fun vi => do + withLocalDecl vName .default (consumeTypeAnnotations viTy) fun vi => do loopU (i + 1) (v.push vi) k else k v @@ -965,7 +2021,7 @@ def loopCtors (recInfos : Array RecInfo) let lctx ← getLCtx let minorTy := lctx.mkForall bu <| lctx.mkForall v motiveApp let minorName := ctor.name.replacePrefix indTypeName .anonymous - withLocalDecl minorName .default minorTy.consumeTypeAnnotations fun minor => do + withLocalDecl minorName .default (consumeTypeAnnotations minorTy) fun minor => do let recInfos := recInfos.modify dIdx fun s => { s with minors := s.minors.push minor } loopCtors recInfos ctors k | [] => k recInfos @@ -1079,7 +2135,8 @@ structure Result where ngen : NameGenerator nparams : Nat lctx : LocalContext - aux2nested : NameMap Expr -- exprs contain `nparams` loose bvars + params : Array Expr -- the fvars declared in `lctx` + aux2nested : NameMap Expr -- exprs are open over `params`, like the C++ `m_aux2nested` types : List InductiveType instance [MonadStateOf NameGenerator m] : MonadNameGenerator m where @@ -1121,11 +2178,11 @@ def restoreNested (r : Result) (env' : Environment) (e : Expr) if let some nested := r.aux2nested.find? c then let args := t.getAppArgs assert! args.size ≥ r.nparams - return mkAppRange (nested.instantiateRev As) r.nparams args.size args + return mkAppRange ((nested.abstract r.params).instantiateRev As) r.nparams args.size args let (nested, auxI_name) ← r.getNestedIfAuxCtor env' c let args := t.getAppArgs assert! args.size ≥ r.nparams - let nested' := nested.instantiateRev As + let nested' := (nested.abstract r.params).instantiateRev As nested'.withApp fun I I_args => do let .const I_c I_ls := I | unreachable! let c' := .const (c.replacePrefix auxI_name I_c) I_ls @@ -1276,8 +2333,14 @@ def run (fuel nparams : Nat) (types : List InductiveType) : M Result := do modify fun s => { s with newTypes := s.newTypes.set! i { indType with ctors } } loop (i+1) fuel else - let aux2nested := s.nestedAux.foldl (fun m (e, n) => m.insert n (e.abstract params)) {} - return { s with nparams := params.size, lctx, aux2nested, types := s.newTypes.toList } + let aux2nested := s.nestedAux.foldl (fun m (e, n) => m.insert n e) {} + return { + ngen := s.ngen + nparams := params.size + lctx := lctx + params := params + aux2nested := aux2nested + types := s.newTypes.toList } loop 0 fuel end ElimNestedInductive diff --git a/Lean4Lean/Inductive/Reduce.lean b/Lean4Lean/Inductive/Reduce.lean index 3779aca9..deb29292 100644 --- a/Lean4Lean/Inductive/Reduce.lean +++ b/Lean4Lean/Inductive/Reduce.lean @@ -44,11 +44,12 @@ def expandEtaStruct (eType e : Expr) : Expr := pure result def toCtorWhenStruct (inductName : Name) (e : Expr) : m Expr := do - if !env.isStructureLike inductName || (e.isConstructorApp?' env).isSome then + if !env.isNonRecStructure inductName || (e.isConstructorApp?' env).isSome then return e let eType ← whnf (← inferType e) if !eType.getAppFn.isConstOf inductName then return e - if (← whnf (← inferType eType)) == .prop then return e + let .sort u ← whnf (← inferType eType) | unreachable! + unless u.isNeverZero do return e return expandEtaStruct env eType e def getRecRuleFor (rval : RecursorVal) (major : Expr) : Option RecursorRule := do diff --git a/Lean4Lean/Level.lean b/Lean4Lean/Level.lean index ea798f7b..e8b64987 100644 --- a/Lean4Lean/Level.lean +++ b/Lean4Lean/Level.lean @@ -245,7 +245,7 @@ def normalize' (l : Level) : Level := (Normalize.normalize l (paths := true)).to def isEquiv' (u v : Level) : Bool := u == v || Normalize.normalize u == Normalize.normalize v -def isEquivList : List Level → List Level → Bool := List.all2 isEquiv' +def isEquivList : List Level → List Level → Bool := List.all2 isEquiv def geq' (u v : Level) : Bool := (Normalize.normalize v).le (Normalize.normalize u) diff --git a/Lean4Lean/Replay.lean b/Lean4Lean/Replay.lean new file mode 100644 index 00000000..54db0f93 --- /dev/null +++ b/Lean4Lean/Replay.lean @@ -0,0 +1,326 @@ +/- +Copyright (c) 2023 Scott Morrison. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Scott Morrison +-/ +import Lean.CoreM +import Lean.Util.FoldConsts +import Lean4Lean.Environment + +namespace Lean + +def HashMap.keyNameSet (m : Std.HashMap Name α) : NameSet := + m.fold (fun s n _ => s.insert n) {} + +namespace Environment + +def importsOf (env : Environment) (n : Name) : Array Import := + if n = env.header.mainModule then + env.header.imports + else match env.getModuleIdx? n with + | .some idx => env.header.moduleData[idx.toNat]!.imports + | .none => #[] + +end Environment + +/-- Like `Expr.getUsedConstants`, but produce a `NameSet`. -/ +def Expr.getUsedConstants' (e : Expr) : NameSet := + e.foldConsts {} fun c cs => cs.insert c + +namespace ConstantInfo + +/-- Return all names appearing in the type or value of a `ConstantInfo`. -/ +def getUsedConstants (c : ConstantInfo) : NameSet := + -- Replay needs dependencies from theorem proofs and opaque bodies even though + -- `ConstantInfo.value?` hides both by default. + c.type.getUsedConstants' ++ match c.value? (allowOpaque := true) with + | some v => v.getUsedConstants' + | none => match c with + | .inductInfo val => .ofList val.ctors + | .ctorInfo val => ({} : NameSet).insert val.name + | .recInfo val => .ofList val.all + | _ => {} + +end ConstantInfo + +end Lean + +def Lean.Kernel.Exception.mapEnvM [Monad m] + (ex : Exception) (f : Environment → m Environment) : m Exception := do + match ex with + | unknownConstant env c => return .unknownConstant (← f env) c + | alreadyDeclared env c => return .alreadyDeclared (← f env) c + | declTypeMismatch env d t => return .declTypeMismatch env d t + | declHasMVars env c e => return declHasMVars (← f env) c e + | declHasFVars env c e => return declHasFVars (← f env) c e + | funExpected env lctx e => return funExpected (← f env) lctx e + | typeExpected env lctx e => return typeExpected (← f env) lctx e + | letTypeMismatch env lctx n t1 t2 => return letTypeMismatch (← f env) lctx n t1 t2 + | exprTypeMismatch env lctx e t => return exprTypeMismatch (← f env) lctx e t + | appTypeMismatch env lctx e fn arg => return appTypeMismatch (← f env) lctx e fn arg + | invalidProj env lctx e => return invalidProj (← f env) lctx e + | thmTypeIsNotProp env c t => return thmTypeIsNotProp (← f env) c t + | other _ + | deterministicTimeout + | excessiveMemory + | deepRecursion + | interrupted => return ex + +def Lean.Declaration.name : Declaration → String + | .axiomDecl d => s!"axiomDecl {d.name}" + | .defnDecl d => s!"defnDecl {d.name}" + | .thmDecl d => s!"thmDecl {d.name}" + | .opaqueDecl d => s!"opaqueDecl {d.name}" + | .quotDecl => s!"quotDecl" + | .mutualDefnDecl d => s!"mutualDefnDecl {d.map (·.name)}" + | .inductDecl _ _ d _ => s!"inductDecl {d.map (·.name)}" + +def Lean.Expr.hasStrLit (e : Expr) : Bool := (e.find? isStringLit).isSome + +def Lean.ConstantInfo.hasStrLit (ci : ConstantInfo) : Bool := + ci.type.hasStrLit || (ci.value? (allowOpaque := true)).any (·.hasStrLit) + +open Lean hiding Environment Exception +open Kernel + +namespace Lean4Lean.Replay + +structure Context where + newConstants : Std.HashMap Name ConstantInfo + verbose := false + compare := false + checkQuot := true + fuel : Lean4Lean.FuelConfig := {} + +structure State where + env : Environment + remaining : NameSet := {} + pending : NameSet := {} + postponedConstructors : NameSet := {} + postponedRecursors : NameSet := {} + numAdded : Nat := 0 + hasStrings := false + +abbrev M := ReaderT Context <| StateRefT State IO + +/-- Check if a `Name` still needs processing. If so, move it from `remaining` to `pending`. -/ +def isTodo (name : Name) : M Bool := do + let r := (← get).remaining + if r.contains name then + modify fun s => { s with remaining := s.remaining.erase name, pending := s.pending.insert name } + return true + else + return false + + +/-- Use the current `Environment` to throw a `Kernel.Exception`. -/ +def throwKernelException (ex : Exception) : M α := do + let options := pp.match.set (pp.rawOnError.set {} true) false + -- Note: because the environment we are using has no extension state, + -- we cannot safely use it with lean functions like the pretty printer. + -- Here we instead create a fresh environment, which is good enough to get + -- basic pretty printing working. + let env ← mkEmptyEnvironment + let ex ← ex.mapEnvM fun _ => return env.toKernelEnv + Prod.fst <$> (Lean.Core.CoreM.toIO · { fileName := "", options, fileMap := default } { env }) do + Lean.throwKernelException ex + + +/-- Add a declaration, possibly throwing a `KernelException`. -/ +def addDecl (d : Declaration) : M Unit := do + if (← read).verbose then + println! "adding {d.name}" + let t1 ← IO.monoMsNow + match Lean4Lean.addDecl (← get).env d true (fuel := (← read).fuel) with + | .ok env => + let t2 ← IO.monoMsNow + if t2 - t1 > 1000 then + if (← read).compare then + let t3 ← match (← get).env.addDecl {} d with + | .ok _ => IO.monoMsNow + | .error ex => Lean4Lean.Replay.throwKernelException ex + if (t2 - t1) > 2 * (t3 - t2) then + println! + "{(← get).env.header.mainModule}:{d.name}: lean took {t3 - t2}, lean4lean took {t2 - t1}" + else + println! "{(← get).env.header.mainModule}:{d.name}: lean4lean took {t2 - t1}" + else + println! "{(← get).env.header.mainModule}:{d.name}: lean4lean took {t2 - t1}" + modify fun s => { s with env, numAdded := s.numAdded + 1 } + | .error ex => + throwKernelException ex + +deriving instance BEq for ConstantVal +deriving instance BEq for ConstructorVal +deriving instance BEq for RecursorRule +deriving instance BEq for RecursorVal + + + +mutual +/-- +Check if a `Name` still needs to be processed (i.e. is in `remaining`). + +If so, recursively replay any constants it refers to, +to ensure we add declarations in the right order. + +The construct the `Declaration` from its stored `ConstantInfo`, +and add it to the environment. +-/ +partial def replayConstant (name : Name) : M Unit := do + if ← isTodo name then + let some ci := (← read).newConstants[name]? | unreachable! + let mut usedConstants := ci.getUsedConstants + -- We want `String.ofList` to be available when encountering string literals. + -- Presumably faster to first check if we already have it, before traversing + -- the declaration + unless (← get).hasStrings do + if ci.hasStrLit then + usedConstants := usedConstants.insert ``String.ofList + usedConstants := usedConstants.insert ``Char.ofNat + modify ({· with hasStrings := true }) + replayConstants usedConstants + -- Check that this name is still pending: a mutual block may have taken care of it. + if (← get).pending.contains name then + let addDeclAt (d : Declaration) := + try addDecl d catch e => throw <| IO.userError s!"at {name}: {e.toString}" + match ci with + | .defnInfo info => addDeclAt (.defnDecl info) + | .thmInfo info => addDeclAt (.thmDecl info) + | .axiomInfo info => addDeclAt (.axiomDecl info) + | .opaqueInfo info => addDeclAt (.opaqueDecl info) + | .inductInfo info => + let lparams := info.levelParams + let nparams := info.numParams + let all ← info.all.mapM fun n => do pure <| (← read).newConstants[n]! + for o in all do + modify fun s => + { s with remaining := s.remaining.erase o.name, pending := s.pending.erase o.name } + let ctorInfo ← all.mapM fun ci => do + pure (ci, ← ci.inductiveVal!.ctors.mapM fun n => do + pure (← read).newConstants[n]!) + -- Make sure we are really finished with the constructors. + for (_, ctors) in ctorInfo do + for ctor in ctors do + replayConstants ctor.getUsedConstants + let types : List InductiveType := ctorInfo.map fun ⟨ci, ctors⟩ => + { name := ci.name + type := ci.type + ctors := ctors.map fun ci => { name := ci.name, type := ci.type } } + addDeclAt (.inductDecl lparams nparams types false) + -- We postpone checking constructors, + -- and at the end make sure they are identical + -- to the constructors generated when we replay the inductives. + | .ctorInfo info => + modify fun s => { s with postponedConstructors := s.postponedConstructors.insert info.name } + -- Similarly we postpone checking recursors. + | .recInfo info => + modify fun s => { s with postponedRecursors := s.postponedRecursors.insert info.name } + | .quotInfo _ => + replayConstant ``Eq + addDeclAt .quotDecl + modify fun s => { s with pending := s.pending.erase name } + +/-- Replay a set of constants one at a time. -/ +partial def replayConstants (names : NameSet) : M Unit := do + for n in names do replayConstant n + +end + +/-- +Check that all postponed constructors are identical to those generated +when we replayed the inductives. +-/ +def checkPostponedConstructors : M Unit := do + for ctor in (← get).postponedConstructors do + match (← get).env.constants.find? ctor, (← read).newConstants[ctor]? with + | some (.ctorInfo info), some (.ctorInfo info') => + unless info == info' do throw <| IO.userError s!"Invalid constructor {ctor}" + | _, _ => throw <| IO.userError s!"No such constructor {ctor}" + +/-- +Check that all postponed recursors are identical to those generated +when we replayed the inductives. +-/ +def checkPostponedRecursors : M Unit := do + for ctor in (← get).postponedRecursors do + match (← get).env.constants.find? ctor, (← read).newConstants[ctor]? with + | some (.recInfo info), some (.recInfo info') => + unless info == info' do throw <| IO.userError s!"Invalid recursor {ctor}" + | _, _ => throw <| IO.userError s!"No such recursor {ctor}" + +/-- +Check that at the end of (any) file, the quotient module is initialized by the end. +(It will already be initialized at the beginning, unless this is the very first file, +`Init.Core`, which is responsible for initializing it.) +This is needed because it is an assumption in `finalizeImport`. +-/ +def checkQuotInit : M Unit := do + unless (← get).env.quotInit do + throw <| IO.userError s!"initial import (Init.Prelude) didn't initialize quotient module" + +/-- "Replay" some constants into an `Environment`, sending them to the kernel for checking. -/ +def replay (ctx : Context) (env : Environment) (decl : Option Name := none) : + IO (Nat × Environment) := do + let mut remaining : NameSet := ∅ + for (n, ci) in ctx.newConstants.toList do + -- We skip unsafe constants, and also partial constants. + -- Later we may want to handle partial constants. + if !ci.isUnsafe && !ci.isPartial then + remaining := remaining.insert n + let (_, s) ← StateRefT'.run (s := { env, remaining }) do + ReaderT.run (r := ctx) do + match decl with + | some d => replayConstant d + | none => + for n in remaining do + replayConstant n + checkPostponedConstructors + checkPostponedRecursors + if (← read).checkQuot then checkQuotInit + return (s.numAdded, s.env) + +open private ImportedModule.mk from Lean.Environment in +unsafe def replayFromImports (module : Name) (verbose := false) (compare := false) + (fuel : Lean4Lean.FuelConfig := {}) : IO Nat := do + let mFile ← findOLean module + unless (← mFile.pathExists) do + throw <| IO.userError s!"object file '{mFile}' of module {module} does not exist" + let mut fnames := #[mFile] + let sFile := OLeanLevel.server.adjustFileName mFile + if (← sFile.pathExists) then + fnames := fnames.push sFile + let pFile := OLeanLevel.private.adjustFileName mFile + if (← pFile.pathExists) then + fnames := fnames.push pFile + let parts ← readModuleDataParts fnames + let some (mod, _) := parts[parts.size - 1]? | unreachable! -- load private module data + let (_, s) ← (importModulesCore mod.imports).run + let env ← match Kernel.Environment.finalizeImport s mod.imports module 0 with + | .ok env => pure env + | .error e => throw <| .userError <| ← (e.toMessageData {}).toString + let mut newConstants := {} + for name in mod.constNames, ci in mod.constants do + -- Multi-part oleans can materialize the same auto-generated lemma in + -- several parts. `finalizeImport` has already deduplicated names supplied + -- by imports, so replay only the constants genuinely new in this module. + if (env.constants.find? name).isNone then + newConstants := newConstants.insert name ci + let (n, env') ← replay { newConstants, verbose, compare, fuel } env + (Environment.ofKernelEnv env').freeRegions + -- Project out the regions *before* freeing them: `CompactedRegion` is a `USize`, so the + -- projected array holds no pointers into the regions, and `parts` -- whose `ModuleData`s + -- live inside them -- is consumed by the `map` and dead by the time we free. Iterating + -- `parts` directly would leave this frame's own locals dangling, and the decrefs on + -- return would segfault. + parts.map (·.2) |>.forM CompactedRegion.free + pure n + +unsafe def replayFromFresh (module : Name) + (verbose := false) (compare := false) (decl : Option Name := none) + (fuel : Lean4Lean.FuelConfig := {}) : IO Nat := do + Lean.withImportModules #[module] {} (trustLevel := 0) fun env => do + let ctx := { newConstants := env.constants.map₁, verbose, compare, checkQuot := false, fuel } + Prod.fst <$> replay ctx (.empty module) decl + +end Lean4Lean.Replay diff --git a/Lean4Lean/Std/Basic.lean b/Lean4Lean/Std/Basic.lean index 9a353aa4..2a057dbb 100644 --- a/Lean4Lean/Std/Basic.lean +++ b/Lean4Lean/Std/Basic.lean @@ -6,6 +6,20 @@ import Batteries.Tactic.SeqFocus open Std +/- +These are stdlib-shaped lemmas that live in the root namespace upstream (mathlib, or eventually +batteries/core). Declaring them under root here would make `import Mathlib` and `import Lean4Lean` +conflict. + +So instead, we declare them in `namespace Lean4Lean`. Consumers of this file need an +`open Lean4Lean`, which is what keeps `h.length_eq`-style dot notation working. + +Beware also that `Lean4Lean.List` now exists: an `open (scoped) List` under an `open Lean4Lean` +resolves to it, so such opens are written `_root_.List`. +-/ +namespace Lean4Lean +open List Lean4Lean + attribute [simp] Option.bind_eq_some_iff List.filterMap_cons theorem Option.beq_some_iff [BEq α] {a : Option α} {b : α} : @@ -74,7 +88,7 @@ theorem List.Forall₂.zipWith_l {l₁ l₂} (H : ∀ a b, R a b → S a (f a b) theorem List.Forall₂.flip : ∀ {a b}, Forall₂ (flip R) b a → Forall₂ R a b | _, _, .nil => .nil - | _, _, .cons h₁ h₂ => .cons h₁ h₂.flip + | _, _, .cons h₁ h₂ => .cons h₁ (flip h₂) theorem List.Forall₂.forall_exists_l {l₁ l₂} (h : Forall₂ R l₁ l₂) : ∀ a ∈ l₁, ∃ b ∈ l₂, R a b := by induction h with simp [*] | cons _ _ ih => exact fun a h => .inr (ih _ h) @@ -111,7 +125,7 @@ theorem List.map_fst_lookup {f : α → β} [BEq β] (l : List α) (b : β) : def List.All (P : α → Prop) : List α → Prop | [] => True - | a::as => P a ∧ as.All P + | a::as => P a ∧ All P as theorem List.All.imp {P Q : α → Prop} (h : ∀ a, P a → Q a) : ∀ {l : List α}, l.All P → l.All Q | [] => id @@ -215,6 +229,8 @@ instance [BEq α] [PartialEquivBEq α] : PartialEquivBEq (List α) where instance [BEq α] [EquivBEq α] : EquivBEq (List α) where rfl {a} := by simp [(· == ·)]; induction a <;> simp [List.beq, *] +end Lean4Lean + namespace BitVec variable (n : Nat) diff --git a/Lean4Lean/Std/Variable!.lean b/Lean4Lean/Std/VariableBang.lean similarity index 100% rename from Lean4Lean/Std/Variable!.lean rename to Lean4Lean/Std/VariableBang.lean diff --git a/Lean4Lean/Tests.lean b/Lean4Lean/Tests.lean new file mode 100644 index 00000000..dc420f92 --- /dev/null +++ b/Lean4Lean/Tests.lean @@ -0,0 +1 @@ +import Lean4Lean.Tests.Toolchain diff --git a/Lean4Lean/Tests/NestedInductive.lean b/Lean4Lean/Tests/NestedInductive.lean new file mode 100644 index 00000000..9e73c868 --- /dev/null +++ b/Lean4Lean/Tests/NestedInductive.lean @@ -0,0 +1,62 @@ +import Lean4Lean.Environment + +/-! +Regression tests for the nested-inductive parameter check added for +leanprover/lean4#14577. + +When a nested occurrence `I Ds is` is eliminated, the parametric arguments `Ds` are dropped +from the generated auxiliary type, so they escape the ordinary type checking of the +declaration. The kernel checks them separately at the end; so must we. + +Both declarations are built by hand rather than elaborated, so that the environment does +not already contain them and only the kernel path is exercised. +-/ + +namespace Lean4Lean.Tests.NestedInductive + +open Lean + +/-- `inductive Tree0 (α : Type) | node : Array (Tree0 α) → Tree0 α` -/ +def treeDecl : Declaration := + let tree := fun a => mkApp (mkConst `Tree0 []) a + .inductDecl [] 1 + [{ name := `Tree0 + type := .forallE `α (.sort 1) (.sort 1) .default + ctors := [{ + name := `Tree0.node + type := .forallE `α (.sort 1) + (.forallE `es (mkApp (mkConst ``Array [.zero]) (tree (.bvar 0))) + (tree (.bvar 1)) .default) .default }] }] + false + +/-- As above, but the dropped parametric argument `Tree0 Bool.true` is ill typed. -/ +def badDecl : Declaration := + .inductDecl [] 1 + [{ name := `Bad0 + type := .forallE `α (.sort 1) (.sort 1) .default + ctors := [{ + name := `Bad0.node + type := .forallE `α (.sort 1) + (.forallE `es + (mkApp (mkConst ``Array [.zero]) + (mkApp (mkConst `Bad0 []) (mkConst ``Bool.true))) + (mkApp (mkConst `Bad0 []) (.bvar 1)) .default) .default }] }] + false + +run_meta do + let kenv := (← getEnv).toKernelEnv + + -- A well-formed nested inductive must be accepted. Storing `aux2nested` abstracted over + -- the parameters while checking it against a context of free variables regressed this + -- into "type checker does not support loose bound variables" (#17). + match Lean4Lean.addDecl kenv treeDecl with + | .ok _ => pure () + | .error e => + throwError "nested inductive was rejected: {← (e.toMessageData {}).toString}" + + -- ... and an ill-typed dropped parameter must still be caught. + match Lean4Lean.addDecl kenv badDecl with + | .ok _ => throwError "nested inductive with an ill-typed parameter was accepted" + | .error _ => pure () + +end Lean4Lean.Tests.NestedInductive diff --git a/Lean4Lean/Tests/Toolchain.lean b/Lean4Lean/Tests/Toolchain.lean new file mode 100644 index 00000000..47d10f38 --- /dev/null +++ b/Lean4Lean/Tests/Toolchain.lean @@ -0,0 +1,47 @@ +import Lean4Lean.Replay + +namespace Lean4Lean.Tests.Toolchain + +open Lean Lean4Lean TypeChecker TypeChecker.Inner + +theorem theoremDelta : True := trivial + +theorem proofOnlyDependency : True := trivial +theorem dependencyOnlyInProof : True := proofOnlyDependency + +def stringProof (_ : String) : True := trivial +theorem stringOnlyInProof : True := stringProof "audit" + +run_meta + let env ← getEnv + let kenv := env.toKernelEnv + + let some thmInfo := kenv.find? ``theoremDelta + | throwError "theorem-delta test declaration is missing" + -- lean4#12973 flipped `ConstantInfo.hasValue` for theorems, but left + -- `constant_info::has_value()` -- the predicate `type_checker::is_delta` consults -- + -- alone, so the kernel still delta-unfolds theorems. `isDelta` must follow the kernel, + -- not `hasValue`. + unless !thmInfo.hasValue do + throwError "expected `ConstantInfo.hasValue` to exclude theorems as of lean4#12973" + unless thmInfo.deltaValue?.isSome do + throwError "theorem values must remain delta-reducible" + unless (isDelta kenv (.const ``theoremDelta [])).isSome do + throwError "isDelta rejected a theorem, diverging from `type_checker::is_delta`" + + unless (isDelta kenv (.const ``Nat.add [.zero])).isNone do + throwError "isDelta accepted an invalid universe arity" + unless (isDelta kenv (.const ``Nat.add [])).isSome do + throwError "isDelta rejected a valid definition" + + let some depInfo := env.find? ``dependencyOnlyInProof + | throwError "proof-dependency test declaration is missing" + unless depInfo.getUsedConstants.contains ``proofOnlyDependency do + throwError "theorem proof dependency was omitted during replay analysis" + + let some strInfo := env.find? ``stringOnlyInProof + | throwError "string-literal test declaration is missing" + unless strInfo.hasStrLit do + throwError "string literal in theorem proof was omitted during replay analysis" + +end Lean4Lean.Tests.Toolchain diff --git a/Lean4Lean/Theory/Inductive.lean b/Lean4Lean/Theory/Inductive.lean index 181970d9..caf51606 100644 --- a/Lean4Lean/Theory/Inductive.lean +++ b/Lean4Lean/Theory/Inductive.lean @@ -1450,6 +1450,17 @@ structure GenerationChecked.WF {source : VInductDecl} gen.block.sourceType.toVConstant = some envT → ∀ ctor ∈ gen.block.ctorPairs, ctor.WF gen.block envT +/-- Consumer-facing semantic package for one generation-ready inductive +declaration. The executable transaction inspects only `generation`; `wf` is +the ordinary Theory certificate used by preservation and is never a +normalization oracle. + +Verify can erase checker-specific candidate provenance to this boundary +before handing a normalized transaction to downstream consumers. -/ +structure GenerationCertificate (source : VInductDecl) (env : VEnv) where + generation : GenerationChecked source + wf : generation.WF env + end VInductDecl def VInductDecl.WF (env : VEnv) (decl : VInductDecl) : Prop := @@ -1488,6 +1499,24 @@ def VEnv.addInductGeneration {source : VInductDecl} let env ← env.addConst (.str ty.name "rec") gen.recursor return gen.generatedRules.foldl VEnv.addDefEq env +/-- Public proof-carrying wrapper around `addInductGeneration`. + +The certificate's proof is erased and does not influence computation. This +entry point lets a verified producer expose a non-identity normalization +without exposing its checker trace or asking a consumer to remember a +separate preservation premise. -/ +def VEnv.addInductCertified {source : VInductDecl} + (env : VEnv) (certificate : source.GenerationCertificate env) : + Option VEnv := + env.addInductGeneration certificate.generation + +@[simp] theorem VEnv.addInductCertified_eq_addInductGeneration + {source : VInductDecl} (env : VEnv) + (certificate : source.GenerationCertificate env) : + env.addInductCertified certificate = + env.addInductGeneration certificate.generation := + rfl + /-- Exact intermediate states of a successful normalized inductive transaction. Stable lookup, freshness, monotonicity, and preservation consequences are derived from this one trace in the typing layer. -/ diff --git a/Lean4Lean/Theory/InductiveFixtures.lean b/Lean4Lean/Theory/InductiveFixtures.lean index 0d72d1fa..b2fd1e65 100644 --- a/Lean4Lean/Theory/InductiveFixtures.lean +++ b/Lean4Lean/Theory/InductiveFixtures.lean @@ -512,6 +512,158 @@ def accRecCollisionEnv : VEnv := example : accRecCollisionEnv.addInduct accDecl = none := VEnv.addInduct_eq_none_of_rec_present rfl ⟨_, rfl⟩ +/-! ## AnnotatedPi: recursive Pi normalization below a constructor field + +Lean retains `outParam` in the constructor's raw recursive-function domain, +while inductive analysis consumes it before recognizing the recursive target. +This fixture combines the annotation and recursive-Pi seams in one declaration +and keeps the raw binder syntax in generated artifacts. -/ + +inductive AnnotatedPi : Type where + | mk : ((p : outParam Prop) → AnnotatedPi) → AnnotatedPi + +def outParamDefEq : VDefEq := + vdefeq(@outParam ≡ fun (α : Sort u) => α) + +def outParamConstEnv : VEnv := + (VEnv.empty.addConst ``outParam (vconst(type_of% @outParam))).get + (by decide) + +def outParamEnv : VEnv := outParamConstEnv.addDefEq outParamDefEq + +theorem outParamConstant_wf : + (vconst(type_of% @outParam) : VConstant).WF VEnv.empty := by + exact ⟨_, VEnv.HasType.forallE + (VEnv.HasType.sort (by decide)) + (VEnv.HasType.sort (by decide))⟩ + +theorem outParamConstEnv_ordered : outParamConstEnv.Ordered := by + apply VEnv.Ordered.const VEnv.Ordered.empty + (ci := vconst(type_of% @outParam)) + · exact outParamConstant_wf + · rfl + +theorem outParamEnv_ordered : outParamEnv.Ordered := by + apply VEnv.Ordered.defeq outParamConstEnv_ordered + constructor + · exact VEnv.HasType.const0 rfl + (outParamConstant_wf.mono + (VEnv.addConst_le (by rfl : + VEnv.empty.addConst ``outParam (vconst(type_of% @outParam)) = + some outParamConstEnv))) + · exact VEnv.HasType.lam + (VEnv.HasType.sort (by decide)) + (VEnv.HasType.bvar .zero) + +def annotatedPiRawType : VInductiveType where + name := ``AnnotatedPi + uvars := 0 + type := vconst(type_of% @AnnotatedPi).type + ctors := [⟨vconst(type_of% @AnnotatedPi.mk), ``AnnotatedPi.mk⟩] + +def annotatedPiRawDecl : VInductDecl := ⟨0, 0, [annotatedPiRawType]⟩ + +def annotatedPiViewCtor : VConstVal where + name := ``AnnotatedPi.mk + uvars := 0 + type := .forallE + (.forallE (.sort .zero) (.const ``AnnotatedPi [])) + (.const ``AnnotatedPi []) + +def annotatedPiViewType : VInductiveType := + { annotatedPiRawType with ctors := [annotatedPiViewCtor] } + +def annotatedPiViewDecl : VInductDecl := ⟨0, 0, [annotatedPiViewType]⟩ + +example : annotatedPiRawType.ctors[0].type = + .forallE + (.forallE + (.app (.const ``outParam [.succ .zero]) (.sort .zero)) + (.const ``AnnotatedPi [])) + (.const ``AnnotatedPi []) := rfl + +example : annotatedPiViewDecl.checked?.isSome = true := rfl +example : normalizationShape annotatedPiRawDecl annotatedPiViewDecl = true := + rfl + +def annotatedPiNormalization : Normalization annotatedPiRawDecl where + view := annotatedPiViewDecl + shape_eq := rfl + +def annotatedPiViewChecked : annotatedPiViewDecl.Checked := + annotatedPiViewDecl.checked?.get (by decide) + +def annotatedPiBlock : NormalizedChecked annotatedPiRawDecl := + annotatedPiNormalization.check?.get (by decide) + +def annotatedPiGenerationChecked : GenerationChecked annotatedPiRawDecl := + annotatedPiBlock.generation?.get (by decide) + +def annotatedPiRecArg : RecArg where + fieldIndex := 0 + binders := [.sort .zero] + targetType := 0 + indices := [] + +example : annotatedPiViewChecked.constructors[0].recursive = + [annotatedPiRecArg] := rfl + +example : annotatedPiGenerationChecked.block.ctorPairs[0].rawFields 0 = + [.forallE + (.app (.const ``outParam [.succ .zero]) (.sort .zero)) + (.const ``AnnotatedPi [])] := rfl + +example : annotatedPiGenerationChecked.recursor = + vconst(type_of% @AnnotatedPi.rec) := rfl + +example : annotatedPiGenerationChecked.generatedRules[0].rhs = + (vdefeq((motive : AnnotatedPi → Sort u) + (mk : (f : (p : outParam Prop) → AnnotatedPi) → + ((p : Prop) → motive (f p)) → motive (@AnnotatedPi.mk f)) + (f : (p : outParam Prop) → AnnotatedPi) => + @AnnotatedPi.rec motive mk (@AnnotatedPi.mk f) ≡ + mk f (fun p => @AnnotatedPi.rec motive mk (f p)))).rhs := rfl + +/-- The normalized recursive-Pi view is semantically well formed without +using the annotation definition; the raw-to-view bridge is supplied later by +the exact checker candidate. -/ +theorem annotatedPiViewDecl_wf : annotatedPiViewDecl.WF VEnv.empty := by + refine ⟨rfl, ?_⟩ + intro ty hty + have hty' : ty = annotatedPiViewType := + List.mem_singleton.1 (by simpa [annotatedPiViewDecl] using hty) + subst ty + refine ⟨by trivial, ?_⟩ + intro c hc + have hc' : c = annotatedPiViewCtor := + List.mem_singleton.1 (by simpa [annotatedPiViewType] using hc) + subst c + constructor + · change fieldsWF 0 ``AnnotatedPi 0 VEnv.empty (.succ .zero) [] [] 0 + [.forallE (.sort .zero) (.const ``AnnotatedPi [])] + refine ⟨?_, ?_, trivial⟩ + · right + left + refine ⟨annotatedPiRecArg, ?_, ?_, ?_⟩ + · rfl + · simp [annotatedPiRecArg] + · exact ⟨⟨⟨_, VEnv.HasType.sort (by decide)⟩, trivial⟩, rfl⟩ + · intro h + change false = true at h + contradiction + · change VEnv.empty.SpineWF 0 + [.forallE (.sort .zero) (.const ``AnnotatedPi [])] + (.sort (.succ .zero)) [] (.sort (.succ .zero)) + rfl + +theorem annotatedPiViewChecked_wf : + annotatedPiViewChecked.WF outParamEnv := by + apply VInductDecl.Checked.WF.mono + ((VEnv.addConst_le (by rfl : + VEnv.empty.addConst ``outParam (vconst(type_of% @outParam)) = + some outParamConstEnv)).trans VEnv.addDefEq_le) + exact annotatedPiViewChecked.wf_of_decl annotatedPiViewDecl_wf + /-! ## Explicit normalization boundary Lean stores reducible aliases in inductive metadata even though diff --git a/Lean4Lean/Theory/Typing/Basic.lean b/Lean4Lean/Theory/Typing/Basic.lean index 62ae8f86..c7ae89a9 100644 --- a/Lean4Lean/Theory/Typing/Basic.lean +++ b/Lean4Lean/Theory/Typing/Basic.lean @@ -1,6 +1,7 @@ import Lean4Lean.Theory.VEnv namespace Lean4Lean +open Lean4Lean inductive Lookup : List VExpr → Nat → VExpr → Prop where | zero : Lookup (ty::Γ) 0 ty.lift diff --git a/Lean4Lean/Theory/Typing/ChurchRosser.lean b/Lean4Lean/Theory/Typing/ChurchRosser.lean index 8c6d2a01..83e0215f 100644 --- a/Lean4Lean/Theory/Typing/ChurchRosser.lean +++ b/Lean4Lean/Theory/Typing/ChurchRosser.lean @@ -3,6 +3,8 @@ import Lean4Lean.Theory.Typing.Strong import Lean4Lean.Theory.Typing.UniqueTyping namespace Lean4Lean +open Lean4Lean + namespace VEnv open VExpr diff --git a/Lean4Lean/Theory/Typing/HeadReduction.lean b/Lean4Lean/Theory/Typing/HeadReduction.lean index fbef3e73..e452edb7 100644 --- a/Lean4Lean/Theory/Typing/HeadReduction.lean +++ b/Lean4Lean/Theory/Typing/HeadReduction.lean @@ -11,6 +11,8 @@ Ryo Kashima, "A Proof of the Standardization Theorem in λ-Calculus" -/ namespace Lean4Lean +open Lean4Lean + namespace VEnv open VExpr diff --git a/Lean4Lean/Theory/Typing/InductiveLemmas.lean b/Lean4Lean/Theory/Typing/InductiveLemmas.lean index 025c4b6e..7040f4cd 100644 --- a/Lean4Lean/Theory/Typing/InductiveLemmas.lean +++ b/Lean4Lean/Theory/Typing/InductiveLemmas.lean @@ -4,6 +4,12 @@ import Lean4Lean.Theory.Typing.Meta namespace Lean4Lean +/- Lean 4.31 no longer unfolds these structural recursors implicitly in a +number of `simp`/`simpa` calls below. Keep the compatibility normalization +local to this proof module: all rules only reduce on a visible constructor. -/ +attribute [local simp] VExpr.appN VExpr.bvarRevRange VExpr.forallN VExpr.lamN + VExpr.liftTelN VExpr.liftN VExpr.inst VExpr.instL VLevel.inst + /-! ## Basic facts about the stage-1 generation helpers -/ namespace VLevel @@ -304,6 +310,8 @@ def instTelN (a : VExpr) : List VExpr → Nat → List VExpr | [], _ => [] | A :: As, k => A.inst a k :: instTelN a As (k+1) +attribute [local simp] instTelN + theorem instTelN_length (a : VExpr) : ∀ (tel : List VExpr) (k : Nat), (instTelN a tel k).length = tel.length | [], _ => rfl @@ -336,7 +344,9 @@ theorem instRev_bvar_ge : ∀ (es : List VExpr) {i : Nat}, es.length ≤ i → instRev (.bvar i) es = .bvar (i - es.length) | [], i, _ => by simp [instRev] | e :: es, i, h => by - have h' : es.length < i := by simpa using h + have h' : es.length < i := by + simp only [List.length_cons] at h + omega show instRev ((VExpr.bvar i).inst e es.length) es = _ rw [show (VExpr.bvar i).inst e es.length = .bvar (i-1) from by show VExpr.instVar i e es.length = _ @@ -853,6 +863,38 @@ theorem GenerationChecked.viewCtors_eq {source : VInductDecl} theorem Normalization.identity_checked? (source : VInductDecl) : (Normalization.identity source).checked? = source.checked? := rfl +/-- A successful normalized analysis retains the exact normalization that was +analyzed; callers do not need to restate this projection as an unrelated +equality. -/ +theorem Normalization.check?_normalization + {source : VInductDecl} {norm : Normalization source} + {block : NormalizedChecked source} + (h : norm.check? = some block) : + block.normalization = norm := by + unfold Normalization.check? at h + split at h <;> try contradiction + split at h <;> try contradiction + cases h + rfl + +/-- A successful generation analysis is indexed by the same normalization +retained in its checked block. -/ +theorem Normalization.generation?_normalization + {source : VInductDecl} {norm : Normalization source} + {generation : GenerationChecked source} + (h : norm.generation? = some generation) : + generation.block.normalization = norm := by + unfold Normalization.generation? at h + obtain ⟨block, hblock, hgeneration⟩ := + Option.bind_eq_some_iff.mp h + have hnorm := Normalization.check?_normalization hblock + unfold NormalizedChecked.generation? at hgeneration + split at hgeneration + · have hgeneration' := Option.some.inj hgeneration + rw [← hgeneration'] + exact hnorm + · contradiction + theorem identityChecked?_isSome (source : VInductDecl) : (identityChecked? source).isSome = source.checked?.isSome := by obtain ⟨U, np, types⟩ := source @@ -906,6 +948,18 @@ info: 'Lean4Lean.VInductDecl.GenerationChecked.viewCtors_eq' depends on axioms: #guard_msgs in #print axioms GenerationChecked.viewCtors_eq +/-- +info: 'Lean4Lean.VInductDecl.Normalization.check?_normalization' depends on axioms: [propext, Quot.sound] +-/ +#guard_msgs in +#print axioms Normalization.check?_normalization + +/-- +info: 'Lean4Lean.VInductDecl.Normalization.generation?_normalization' depends on axioms: [propext, Quot.sound] +-/ +#guard_msgs in +#print axioms Normalization.generation?_normalization + /-- info: 'Lean4Lean.VInductDecl.identityChecked?_isSome' depends on axioms: [propext, Classical.choice, Quot.sound] -/ @@ -1340,7 +1394,6 @@ theorem HasType.appN_selfSpine {env : VEnv} {U : Nat} : rw [VExpr.liftN_succ_inst_bvar] at happ have := HasType.appN_selfSpine (As := As) (B := B) (Δ := Δ) (Γ := A :: Γ) (f := f.app (.bvar (Δ.length + As.length))) (by simpa [List.append_assoc] using happ) - simp only [VExpr.appN] at this ⊢ simpa [List.append_assoc, VExpr.bvarRevRange] using this /-- The closed-telescope entry point for `appN_selfSpine`. -/ @@ -2404,6 +2457,18 @@ theorem Checked.WF.mono {decl : VInductDecl} {checked : decl.Checked} refine ⟨h.1.mono henv, fun c hc => ?_⟩ exact ⟨fieldsWF_mono henv (h.2 c hc).1, (h.2 c hc).2.mono henv⟩ +/-- Exact syntactic decomposition of an accepted family view into its +parameter telescope, index telescope, and terminal sort. -/ +theorem Checked.type_eq + {source : VInductDecl} (checked : source.Checked) : + checked.type.type = + VExpr.forallN checked.params + (VExpr.forallN checked.indices (.sort checked.resultLevel)) := by + rw [← VExpr.forallN_telN_dropN source.nparams checked.type.type, + ← forallN_ctorFields_resultOf + (VExpr.dropN source.nparams checked.type.type), + checked.result_eq, checked.params_eq, checked.indices_eq] + /-- The semantic checker contract types the family before that family is inserted. This is the exact premise needed by the first transaction step. -/ theorem Checked.WF.family_isType @@ -2418,6 +2483,116 @@ theorem Checked.WF.family_isType (by simpa [checked.params_eq, checked.indices_eq] using h.1) ⟨_, HasType.sort checked.direct_anatomy.2.2.1⟩ +/-- Once the retained family constant has the checked family type, the +checked constructor-result spine types the exact normalized family +application. This fact depends only on analyzer semantics and the constant's +ordinary typing judgment; callers do not need to restate result typing for +each constructor candidate. -/ +theorem GenerationChecked.checkedResultTarget_hasType + {source : VInductDecl} (gen : GenerationChecked source) + {env : VEnv} (henv : env.Ordered) + (hchecked : gen.block.checked.WF env) + (familyConst : env.HasType source.uvars [] + (.const gen.block.sourceType.name (VLevel.params source.uvars)) + gen.block.checked.type.type) + {ctor : NormalizedCtor} (hctor : ctor ∈ gen.block.ctorPairs) : + env.HasType source.uvars (ctor.viewBinders gen.block).reverse + (ctor.resultTarget gen.block) + (.sort gen.block.checked.resultLevel) := by + have htype := gen.block.checked.type_eq + have hfamily : env.HasType source.uvars + (ctor.view.fields.reverse ++ gen.block.checked.params.reverse) + (VExpr.appN + (.const gen.block.sourceType.name (VLevel.params source.uvars)) + (VExpr.bvarRevRange ctor.view.fields.length + gen.block.checked.params.length)) + (VExpr.forallN + (VExpr.liftTelN ctor.view.fields.length + gen.block.checked.indices 0) + (.sort gen.block.checked.resultLevel)) := by + have hconst : env.HasType source.uvars + (ctor.view.fields.reverse ++ + gen.block.checked.params.reverse ++ []) + (.const gen.block.sourceType.name (VLevel.params source.uvars)) + (VExpr.forallN gen.block.checked.params + (VExpr.forallN gen.block.checked.indices + (.sort gen.block.checked.resultLevel))) := by + simpa only [htype] using familyConst.weak0 henv + have happ := HasType.appN_selfSpine' + (As := gen.block.checked.params) + (B := VExpr.forallN gen.block.checked.indices + (.sort gen.block.checked.resultLevel)) + (Δ := ctor.view.fields.reverse) (Γ := []) + (by simpa only [← htype] using gen.block.checked.type_closed) + hconst + rw [List.length_reverse, VExpr.liftN_forallN] at happ + simpa using happ + have hspine : env.SpineWF source.uvars + (ctor.view.fields.reverse ++ gen.block.checked.params.reverse) + (VExpr.forallN + (VExpr.liftTelN ctor.view.fields.length + gen.block.checked.indices 0) + (.sort gen.block.checked.resultLevel)) + ctor.view.resultIndices + (.sort gen.block.checked.resultLevel) := by + obtain ⟨c, hc, hview⟩ := gen.viewCtor_ofDirect hctor + have h := (hchecked.2 c hc).2 + rw [hview] + simpa [CheckedCtor.ofDirect, gen.block.uvars_eq, + gen.block.nparams_eq] using h + have hresult := hspine.hasType_appN hfamily + rw [← VExpr.appN_append] at hresult + have hparams : gen.block.checked.params.length = source.nparams := + gen.shape.2.1.symm.trans gen.shape.1 + have hfields := (gen.shape.2.2.2.2.2 ctor hctor).2.2.2 + rw [hparams, ← hfields] at hresult + simpa [NormalizedCtor.viewBinders, + NormalizedCtor.resultTarget] using hresult + +/-- A paired checked constructor's stored view type is exactly its analyzed +binder telescope followed by the normalized family result application. -/ +theorem GenerationChecked.viewCtorType_eq + {source : VInductDecl} (gen : GenerationChecked source) + {ctor : NormalizedCtor} (hctor : ctor ∈ gen.block.ctorPairs) : + ctor.view.value.type = + VExpr.forallN (ctor.viewBinders gen.block) + (ctor.resultTarget gen.block) := by + obtain ⟨c, hc, hview⟩ := gen.viewCtor_ofDirect hctor + have hcAn := gen.block.checked.direct_anatomy.2.2.2.2.2 c hc + have htype := VExpr.forallN_telN_dropN + gen.block.normalization.view.nparams c.type + rw [hcAn.2.1, (stage3Ctor_eq hcAn.2.2).1] at htype + have hfields := (gen.shape.2.2.2.2.2 ctor hctor).2.2.2 + have hfields' : + (ctor.rawFields gen.block.normalization.view.nparams).length = + (ctorFields (VExpr.dropN + gen.block.normalization.view.nparams c.type)).length := by + simpa [gen.block.nparams_eq, hview, + CheckedCtor.ofDirect] using hfields + simpa [← VExpr.forallN_append, NormalizedCtor.viewBinders, + NormalizedCtor.resultTarget, hview, hfields', + CheckedCtor.ofDirect, gen.block.uvars_eq, + gen.block.nparams_eq, gen.block.sourceType_name_eq, + gen.block.checked.params_eq, Nat.zero_add] using htype.symm + +/-- +info: 'Lean4Lean.VInductDecl.Checked.type_eq' depends on axioms: [propext, Quot.sound] +-/ +#guard_msgs in +#print axioms Checked.type_eq + +/-- +info: 'Lean4Lean.VInductDecl.GenerationChecked.viewCtorType_eq' depends on axioms: [propext, Quot.sound] +-/ +#guard_msgs in +#print axioms GenerationChecked.viewCtorType_eq + +/-- +info: 'Lean4Lean.VInductDecl.GenerationChecked.checkedResultTarget_hasType' depends on axioms: [propext, Quot.sound] +-/ +#guard_msgs in +#print axioms GenerationChecked.checkedResultTarget_hasType + /-- Final-environment invariant for mixed raw/view generation. It contains only facts stable after the raw family and constructors have been inserted; the staged pre-family/post-family split remains in `GenerationChecked.WF`. -/ @@ -2608,7 +2783,7 @@ theorem ctorApp_emitted_decl {ctor : NormalizedCtor} (S.ctorWF ctor hctor).emittedResult.hasType.2 obtain ⟨_, hemit⟩ := (S.ctorWF ctor hctor).emittedTel.forallN_defeq - (by simpa [E] using hresult) + (by simpa [E, VEnv.HasType] using hresult) have hcE₀ : env.HasType source.uvars [] (.const ctor.raw.name (VLevel.params source.uvars)) (VExpr.forallN E (ctor.resultTarget gen.block)) := by @@ -3338,7 +3513,8 @@ theorem recArgMinor_isType {ctor : NormalizedCtor} dsimp only [j] at ht hctx have htel : env.OnTel (source.uvars + 1) Γ As := by rw [hctx] at ht - simpa [r, As, m, j, Bs, RecArg.instL] using ht.1 + simpa [r, As, m, j, Bs, RecArg.instL, + RecArg.minorBinders] using ht.1 have hsp : env.SpineWF (source.uvars + 1) (As.reverse ++ Γ) (VExpr.forallN @@ -3349,6 +3525,7 @@ theorem recArgMinor_isType {ctor : NormalizedCtor} (.sort (gen.block.checked.resultLevel.inst ls)) := by rw [hctx] at ht simpa [r, As, idxs, m, j, Bs, ls, RecArg.instL, + RecArg.minorBinders, List.append_assoc, show j + r₀.binders.length + 1 + (m-j+p) = m+p+r₀.binders.length+1 from by omega] using ht.2 @@ -3426,21 +3603,14 @@ theorem recArgMinor_isType {ctor : NormalizedCtor} List.nil_append] at hmajor have hAsLen : As.length = r.binders.length := by simp [As, RecArg.minorBinders, VExpr.liftTelN_length] - have hmajorHead : - (VExpr.bvar (m-1-r.fieldIndex+p)).liftN As.length = - .bvar (m-1-r.fieldIndex+p+r.binders.length) := by - simp only [VExpr.liftN, liftVar_base] - congr 1 - rw [hAsLen] - omega change env.HasType (source.uvars + 1) (As.reverse ++ Γ) - (((VExpr.bvar (m-1-r.fieldIndex+p)).liftN As.length).appN + ((VExpr.bvar (m-1-r.fieldIndex+p+As.length)).appN (VExpr.bvarRevRange 0 As.length)) (VExpr.appN (.const gen.block.sourceType.name ls) (VExpr.bvarRevRange (m+p+r.binders.length+1) source.nparams ++ idxs)) at hmajor - rw [hmajorHead, hAsLen] at hmajor + rw [hAsLen] at hmajor have hMget : (As.reverse ++ Γ)[m+p+r.binders.length]? = some gen.motiveType := by @@ -4439,7 +4609,7 @@ theorem hasType_appN_ihs {env : VEnv} {U : Nat} {Γ : List VExpr} {m k : Nat} [.bvar (m-1-q.1)]))) → env.HasType U Γ g (VExpr.forallN (ihsR m k rs 0) (Dfin.liftN rs.length)) → env.HasType U Γ (g.appN (rs.map argOf)) Dfin - | [], g, _, _, hg => by simpa using hg + | [], g, _, _, hg => by simpa [ihsR] using hg | (j, idxs) :: rs, g, hm, hargs, hg => by have happ := VEnv.HasType.app hg (hargs (j, idxs) (.head _)) simp only [List.length_cons] at happ @@ -4461,7 +4631,7 @@ theorem hasType_appN_ruleIHs {env : VEnv} {U : Nat} {Γ : List VExpr} {m k : Nat env.HasType U Γ g (VExpr.forallN (ruleIHs m k rs 0) (Dfin.liftN rs.length)) → env.HasType U Γ (g.appN (rs.map argOf)) Dfin - | [], g, _, hg => by simpa using hg + | [], g, _, hg => by simpa [ruleIHs] using hg | r :: rs, g, hargs, hg => by have happ := VEnv.HasType.app hg (by simpa [ruleIHs] using hargs r (.head _)) @@ -5357,19 +5527,10 @@ theorem ruleCall_hasType {ctor : NormalizedCtor} As.length = r.binders.length := by simp [As, RecArg.ruleBinders, VExpr.liftTelN_length] - have hmajorHead : - (VExpr.bvar - (m-1-r.fieldIndex)).liftN As.length = - .bvar - (m-1-r.fieldIndex+r.binders.length) := by - simp only [VExpr.liftN, liftVar_base] - congr 1 - rw [hAsLen] - omega change env.HasType (source.uvars + 1) (As.reverse ++ Γ) - (((VExpr.bvar - (m-1-r.fieldIndex)).liftN As.length).appN + ((VExpr.bvar + (m-1-r.fieldIndex+As.length)).appN (VExpr.bvarRevRange 0 As.length)) (VExpr.appN (.const gen.block.sourceType.name ls) @@ -5377,7 +5538,7 @@ theorem ruleCall_hasType {ctor : NormalizedCtor} (m+k+r.binders.length+1) source.nparams ++ idxs)) at hmajor - rw [hmajorHead, hAsLen] at hmajor + rw [hAsLen] at hmajor have hlen : idxs.length = gen.idxTel.length := by simpa [idxs, r, RecArg.instL, GenerationChecked.idxTel] using @@ -5394,7 +5555,7 @@ theorem ruleCall_hasType {ctor : NormalizedCtor} simpa [Γ, List.append_assoc, hAsLen, hFsLen, Nat.add_comm, Nat.add_left_comm, Nat.add_assoc] using hmajor) - have hbase : + have hbaseLift : (VExpr.appN (.const (.str gen.block.sourceType.name "rec") @@ -5418,6 +5579,28 @@ theorem ruleCall_hasType {ctor : NormalizedCtor} apply congrArg (VExpr.appN _) apply VExpr.bvarRevRange_congr omega + have hbaseRange : + VExpr.appN + ((VExpr.const + (.str gen.block.sourceType.name "rec") + (VLevel.params (source.uvars + 1))).app + (VExpr.bvar + (source.nparams + + (k + (m + r.binders.length))))) + (VExpr.bvarRevRange + (m+r.binders.length) + (source.nparams+k)) = + VExpr.appN + (.const + (.str gen.block.sourceType.name "rec") + (VLevel.params (source.uvars + 1))) + (VExpr.bvarRevRange + (m+r.binders.length) + (source.nparams+(1+k))) := by + rw [show source.nparams + (k + (m + r.binders.length)) = + (m+r.binders.length) + (source.nparams+k) by omega, + show source.nparams+(1+k) = (source.nparams+k)+1 by omega] + rfl have hlam := HasType.lamN htel (by simpa [Γ, Fs, hAsLen, hFsLen, List.append_assoc, VExpr.liftN_appN, @@ -5425,8 +5608,10 @@ theorem ruleCall_hasType {ctor : NormalizedCtor} (Nat.zero_le _), Nat.add_comm, Nat.add_left_comm, Nat.add_assoc] using hcall) - simpa [RecArg.ruleCall, RecArg.ruleIH, - r, Bs, ls, As, idxs, m, k, Γ, Fs, hbase, + simp only [VExpr.liftTelN_length] at hlam + rw [hbaseRange] at hlam + simpa only [RecArg.ruleCall, RecArg.ruleIH, + r, Bs, ls, As, idxs, m, k, Γ, Fs, hbaseLift, VExpr.liftTelN_length, List.append_assoc, Nat.add_assoc] using hlam @@ -6176,7 +6361,7 @@ theorem DirectFamilyEnv.recAppPi_hasType_decl (Δ : List VExpr) : exact S.tconst_decl have hout := HasType.appN_selfSpine (env := env) (U := U) hf rw [S.hlen] at hout - simpa [List.append_nil] using hout + simpa [recApp, List.append_nil] using hout /-- Checked constructor fields form a telescope as soon as the family is available; no constructor lookup is needed for recursive occurrences. -/ @@ -6377,7 +6562,7 @@ theorem Stage3Env.recAppPi_hasType_decl (Δ : List VExpr) : exact S.tconst_decl have := HasType.appN_selfSpine (env := env) (U := U) hf rw [S.hlen] at this - simpa [List.append_nil] using this + simpa [recApp, List.append_nil] using this /-- The parameter spine at the recursor universes: the index pi. -/ theorem Stage3Env.recAppPi_hasType (Δ : List VExpr) : @@ -6396,7 +6581,7 @@ theorem Stage3Env.recAppPi_hasType (Δ : List VExpr) : have := HasType.appN_selfSpine (env := env) (U := U+1) hf rw [show (paramsTel U np ty).length = np from by simp [paramsTel, List.length_map, S.hlen]] at this - simpa [List.append_nil] using this + simpa [recApp', List.append_nil] using this /-- The block applied to the full parameter-and-index self-spine is a sort, in the context of the indices over the parameters. -/ @@ -6626,7 +6811,6 @@ theorem Stage3Env.recArg_transport {c : VConstVal} (hc : c ∈ ty.ctors) (List.getElem?_eq_some_iff.1 hB).1 have hsem := fieldsWF_recArg (S.hfields c hc) r₀.fieldIndex B r₀ hB (by simpa [idxTel_length] using hr) - simp only [Nat.zero_add] at hsem have htel₁ := hsem.1.instL (U' := U+1) VLevel.params'_one_wf have hsp₁ := hsem.2.instL (U' := U+1) VLevel.params'_one_wf have hctx : @@ -6759,14 +6943,16 @@ theorem Stage3Env.recArgMinor_isType {c : VConstVal} (hc : c ∈ ty.ctors) dsimp only [j] at ht hctx have htel : OnTel env (U+1) Γ As := by rw [hctx] at ht - simpa [r, As, m, j, RecArg.instL] using ht.1 + simpa [r, As, m, j, RecArg.instL, + RecArg.minorBinders] using ht.1 have hsp : env.SpineWF (U+1) (As.reverse ++ Γ) (VExpr.forallN (VExpr.liftTelN (m+p+r.binders.length+1) (idxTel U np ty) 0) (.sort (l.inst (VLevel.params' U 1)))) idxs (.sort (l.inst (VLevel.params' U 1))) := by rw [hctx] at ht - simpa [r, As, idxs, m, j, RecArg.instL, List.append_assoc, + simpa [r, As, idxs, m, j, RecArg.instL, + RecArg.minorBinders, List.append_assoc, show j + r₀.binders.length + 1 + (m-j+p) = m+p+r₀.binders.length+1 from by omega] using ht.2 have hF : Γ[m-1-j+p]? = @@ -6800,19 +6986,12 @@ theorem Stage3Env.recArgMinor_isType {c : VConstVal} (hc : c ∈ ty.ctors) simp only [List.length_nil, VExpr.liftN_zero, List.nil_append] at hmajor have hAsLen : As.length = r.binders.length := by simp [As, RecArg.minorBinders, VExpr.liftTelN_length] - have hmajorHead : - (VExpr.bvar (m-1-r.fieldIndex+p)).liftN As.length = - .bvar (m-1-r.fieldIndex+p+r.binders.length) := by - simp only [VExpr.liftN, liftVar_base] - congr 1 - rw [hAsLen] - omega change env.HasType (U+1) (As.reverse ++ Γ) - (((VExpr.bvar (m-1-r.fieldIndex+p)).liftN As.length).appN + ((VExpr.bvar (m-1-r.fieldIndex+p+As.length)).appN (VExpr.bvarRevRange 0 As.length)) (VExpr.appN (.const T (VLevel.params' U 1)) (VExpr.bvarRevRange (m+p+r.binders.length+1) np ++ idxs)) at hmajor - rw [hmajorHead, hAsLen] at hmajor + rw [hAsLen] at hmajor have hMget : (As.reverse ++ Γ)[m+p+r.binders.length]? = some (motiveType U T np ty) := by have hM0 := getElem?_rstack3 As.reverse (Δ ++ Fs.reverse) @@ -7151,7 +7330,7 @@ theorem Stage3Env.minor_isType {c : VConstVal} (hc : c ∈ ty.ctors) : refine IsType.forallN ?_ ?_ · have h0 := S.fieldsWF_onTel _ [] 0 rfl (by simpa using S.hfields c hc) have h1 := h0.weakN S.ord (.zero [motiveType U T np ty]) - simpa [List.map_reverse, paramsTel] using h1 + simpa [ctorFieldsR, List.map_reverse, paramsTel] using h1 · refine IsType.forallN (S.ihs_onTel hc _ (fun q hq => hq) [] 0 rfl) ?_ have hml2 : (VExpr.liftTelN 1 (ctorFieldsR U np c) 0).length = (ctorFieldsR U np c).length := VExpr.liftTelN_length .. @@ -7284,7 +7463,7 @@ theorem Stage3Env.minor_isTypeRec {c : VConstVal} (hc : c ∈ ty.ctors) : refine IsType.forallN ?_ ?_ · have h0 := S.fieldsWF_onTel _ [] 0 rfl (by simpa using S.hfields c hc) have h1 := h0.weakN S.ord (.zero [motiveType U T np ty]) - simpa [List.map_reverse, paramsTel] using h1 + simpa [ctorFieldsR, List.map_reverse, paramsTel] using h1 · refine IsType.forallN (S.ihsRec_onTel hc _ (fun q hq => hq) [] 0 rfl) ?_ have hml2 : (VExpr.liftTelN 1 (ctorFieldsR U np c) 0).length = (ctorFieldsR U np c).length := VExpr.liftTelN_length .. @@ -8258,7 +8437,8 @@ theorem Stage3Env.ruleBinders_onTel {c : VConstVal} (hc : c ∈ ty.ctors) : [motiveType U T np ty]).length = ty.ctors.length + 1 from by simp only [List.length_append, List.length_reverse, minorTypes_length, List.length_singleton])] at h1 - simpa [List.map_reverse, paramsTel, List.append_assoc] using h1 + simpa [ctorFieldsR, List.map_reverse, paramsTel, + List.append_assoc] using h1 refine OnTel.append (OnTel.append hP ⟨?_, ?_⟩) ?_ · simpa only [List.append_nil] using S.motive_isType · have := S.minorTypes_onTel ty.ctors (fun _ h => h) [] 0 rfl @@ -8284,7 +8464,8 @@ theorem Stage3Env.ruleBindersRec_onTel {c : VConstVal} (hc : c ∈ ty.ctors) : [motiveType U T np ty]).length = ty.ctors.length + 1 from by simp only [List.length_append, List.length_reverse, minorTypesRec_length, List.length_singleton])] at h1 - simpa [List.map_reverse, paramsTel, List.append_assoc] using h1 + simpa [ctorFieldsR, List.map_reverse, paramsTel, + List.append_assoc] using h1 refine OnTel.append (OnTel.append hP ⟨?_, ?_⟩) ?_ · simpa only [List.append_nil] using S.motive_isType · have := S.minorTypesRec_onTel ty.ctors (fun _ h => h) [] 0 rfl @@ -8668,19 +8849,12 @@ theorem Stage3Env.ruleCallRec_hasType {c : VConstVal} (hc : c ∈ ty.ctors) simp only [List.length_nil, VExpr.liftN_zero, List.nil_append] at hmajor have hAsLen : As.length = r.binders.length := by simp [As, RecArg.ruleBinders, VExpr.liftTelN_length] - have hmajorHead : - (VExpr.bvar (m-1-r.fieldIndex)).liftN As.length = - .bvar (m-1-r.fieldIndex+r.binders.length) := by - simp only [VExpr.liftN, liftVar_base] - congr 1 - rw [hAsLen] - omega change env.HasType (U+1) (As.reverse ++ Γ) - (((VExpr.bvar (m-1-r.fieldIndex)).liftN As.length).appN + ((VExpr.bvar (m-1-r.fieldIndex+As.length)).appN (VExpr.bvarRevRange 0 As.length)) (VExpr.appN (.const T (VLevel.params' U 1)) (VExpr.bvarRevRange (m+k+r.binders.length+1) np ++ idxs)) at hmajor - rw [hmajorHead, hAsLen] at hmajor + rw [hAsLen] at hmajor have hlen : idxs.length = (idxTel U np ty).length := by simpa [idxs, r, RecArg.instL] using (recArg?_eq hr₀).2.2.2.1 have hcall := S.recAppRec_hasType hrec (As.reverse ++ Fs.reverse) @@ -8689,7 +8863,7 @@ theorem Stage3Env.ruleCallRec_hasType {c : VConstVal} (hc : c ∈ ty.ctors) hlen (by simpa [Γ, List.append_assoc, hAsLen, hFsLen, Nat.add_comm, Nat.add_left_comm, Nat.add_assoc] using hmajor) - have hbase : + have hbaseLift : (VExpr.appN (.const (.str T "rec") (VLevel.params (U+1))) (VExpr.bvarRevRange m (np+(k+1)))).liftN r.binders.length = VExpr.appN (.const (.str T "rec") (VLevel.params (U+1))) @@ -8700,12 +8874,25 @@ theorem Stage3Env.ruleCallRec_hasType {c : VConstVal} (hc : c ∈ ty.ctors) apply congrArg (VExpr.appN _) apply VExpr.bvarRevRange_congr omega + have hbaseRange : + VExpr.appN + ((VExpr.const (.str T "rec") (VLevel.params (U+1))).app + (VExpr.bvar (np + (k + (m + r.binders.length))))) + (VExpr.bvarRevRange (m+r.binders.length) (np+k)) = + VExpr.appN + (.const (.str T "rec") (VLevel.params (U+1))) + (VExpr.bvarRevRange (m+r.binders.length) (np+(k+1))) := by + rw [show np + (k + (m + r.binders.length)) = + (m+r.binders.length) + (np+k) by omega, + show np+(k+1) = (np+k)+1 by omega] + rfl have hlam := HasType.lamN htel (by simpa [Γ, Fs, hAsLen, hFsLen, List.append_assoc, VExpr.liftN_appN, bvarRevRange_liftN_ge _ _ _ _ (Nat.zero_le _), Nat.add_comm, Nat.add_left_comm, Nat.add_assoc] using hcall) - simpa [RecArg.ruleCall, RecArg.ruleIH, r, As, idxs, m, k, Γ, Fs, hbase, - List.append_assoc, Nat.add_assoc] using hlam + rw [hbaseRange] at hlam + simpa only [RecArg.ruleCall, RecArg.ruleIH, r, As, idxs, m, k, Γ, Fs, + hbaseLift, List.append_assoc, Nat.add_assoc] using hlam /-- The right-hand side of an indexed iota rule: the constructor's minor @@ -8903,7 +9090,7 @@ theorem Stage3Env.minorApp_hasType {i : Nat} {c : VConstVal} rw [hargs] exact hr) hfields - simpa only [hrs] using hres + simpa only [hrs, List.nil_append] using hres /-- Generalized iota RHS: apply the selected constructor minor to every field and then to the direct or functional recursive call generated for each @@ -9425,11 +9612,13 @@ theorem Checked.WF.identityCtorWF · simpa [NormalizedCtor.emittedBinders, NormalizedCtor.rawFields, NormalizedCtor.viewBinders, CheckedCtor.ofDirect, - checked.params_eq] using htelRefl + Checked.identityGeneration, Checked.identityBlock, + NormalizedChecked.rawParams, checked.params_eq] using htelRefl · simpa [NormalizedCtor.emittedBinders, NormalizedCtor.rawFields, NormalizedCtor.rawResult, NormalizedCtor.resultTarget, CheckedCtor.ofDirect, - checked.params_eq] using hresultDF + Checked.identityGeneration, Checked.identityBlock, + NormalizedChecked.rawParams, checked.params_eq] using hresultDF omit S in /-- Every semantically checked direct declaration admits the identity mixed @@ -9880,6 +10069,39 @@ theorem addInductGeneration_WF {source : VInductDecl} SR.generatedRulesFold_ordered (addConst_self H.addRec) simpa only [H.addRules] using hout +/-- Recover the ordinary normalized transaction trace from the +proof-carrying public entry point. The conclusion contains only Theory data; +the producer that established the certificate is deliberately absent. -/ +theorem addInductCertified_trace {source : VInductDecl} + {certificate : source.GenerationCertificate env} + (hadd : addInductCertified env certificate = some env') : + Nonempty + (AddInductGenerationTrace env env' certificate.generation) := by + apply addInductGeneration_trace + simpa only [addInductCertified_eq_addInductGeneration] using hadd + +/-- The proof-carrying wrapper has the same atomic success/failure behavior as +the underlying normalized transaction. -/ +theorem addInductCertified_atomic {source : VInductDecl} + (env : VEnv) (certificate : source.GenerationCertificate env) : + addInductCertified env certificate = none ∨ + ∃ env', addInductCertified env certificate = some env' ∧ + Nonempty + (AddInductGenerationTrace env env' certificate.generation) := by + simpa only [addInductCertified_eq_addInductGeneration] using + addInductGeneration_atomic env certificate.generation + +/-- Ordering preservation for the public certified transaction. Its +semantic premise is carried by the certificate rather than repeated at every +call site. -/ +theorem addInductCertified_WF {source : VInductDecl} + {certificate : source.GenerationCertificate env} + (henv : env.Ordered) + (hadd : addInductCertified env certificate = some env') : + env'.Ordered := by + apply addInductGeneration_WF henv certificate.wf + simpa only [addInductCertified_eq_addInductGeneration] using hadd + /-- info: 'Lean4Lean.VEnv.addInductGeneration_trace' depends on axioms: [propext, Quot.sound] -/ @@ -9928,6 +10150,30 @@ info: 'Lean4Lean.VEnv.addInductGeneration_WF' depends on axioms: [propext, Class #guard_msgs in #print axioms addInductGeneration_WF +/-- +info: 'Lean4Lean.VEnv.addInductCertified_eq_addInductGeneration' depends on axioms: [propext, Quot.sound] +-/ +#guard_msgs in +#print axioms addInductCertified_eq_addInductGeneration + +/-- +info: 'Lean4Lean.VEnv.addInductCertified_trace' depends on axioms: [propext, Quot.sound] +-/ +#guard_msgs in +#print axioms addInductCertified_trace + +/-- +info: 'Lean4Lean.VEnv.addInductCertified_atomic' depends on axioms: [propext, Quot.sound] +-/ +#guard_msgs in +#print axioms addInductCertified_atomic + +/-- +info: 'Lean4Lean.VEnv.addInductCertified_WF' depends on axioms: [propext, Classical.choice, Quot.sound] +-/ +#guard_msgs in +#print axioms addInductCertified_WF + /-- info: 'Lean4Lean.VEnv.addInduct_eq_addInductGeneration' depends on axioms: [propext, Classical.choice, Quot.sound] -/ diff --git a/Lean4Lean/Theory/Typing/Lemmas.lean b/Lean4Lean/Theory/Typing/Lemmas.lean index 605c8427..f7691e6d 100644 --- a/Lean4Lean/Theory/Typing/Lemmas.lean +++ b/Lean4Lean/Theory/Typing/Lemmas.lean @@ -1,9 +1,9 @@ import Lean4Lean.Theory.Typing.Basic -import Lean4Lean.Std.Variable! +import Lean4Lean.Std.VariableBang namespace Lean4Lean -open VExpr +open Lean4Lean VExpr inductive Ctx.LiftN (n : Nat) : Nat → List VExpr → List VExpr → Prop where | zero (As) (h : As.length = n := by rfl) : Ctx.LiftN n 0 Γ (As ++ Γ) diff --git a/Lean4Lean/Theory/Typing/Strong.lean b/Lean4Lean/Theory/Typing/Strong.lean index 3695e893..368aa47a 100644 --- a/Lean4Lean/Theory/Typing/Strong.lean +++ b/Lean4Lean/Theory/Typing/Strong.lean @@ -1,6 +1,8 @@ import Lean4Lean.Theory.Typing.Lemmas namespace Lean4Lean +open Lean4Lean + namespace VEnv open VExpr @@ -320,10 +322,11 @@ theorem IsDefEqStrong.instL (H : env.IsDefEqStrong U Γ e1 e2 A) : exact .defeqDF (.inst hls) ih1 ih2 | beta _ _ _ _ _ _ _ _ ih1 ih2 ih3 ih4 ih5 ih6 => simpa using .beta (.inst hls) (.inst hls) ih1 ih2 ih3 ih4 - (by simpa using ih5) (by simpa using ih6) + (by simpa [VExpr.instL] using ih5) (by simpa [VExpr.instL] using ih6) | eta _ _ _ _ _ _ _ _ ih1 ih2 ih3 ih4 ih5 ih6 => simpa [VExpr.instL] using .eta (.inst hls) (.inst hls) ih1 ih2 - (by simpa using ih3) ih4 (by simpa [VExpr.instL] using ih5) (by simpa [VExpr.instL] using ih6) + (by simpa [VExpr.instL] using ih3) ih4 + (by simpa [VExpr.instL] using ih5) (by simpa [VExpr.instL] using ih6) | proofIrrel _ _ _ ih1 ih2 ih3 => exact .proofIrrel ih1 ih2 ih3 | extra h1 h2 h3 _ _ _ _ _ _ ih1 ih2 ih3 ih4 ih5 => diff --git a/Lean4Lean/Theory/VExpr.lean b/Lean4Lean/Theory/VExpr.lean index ab1797c6..cdf8ed38 100644 --- a/Lean4Lean/Theory/VExpr.lean +++ b/Lean4Lean/Theory/VExpr.lean @@ -2,6 +2,7 @@ import Lean import Lean4Lean.Theory.VLevel namespace Lean4Lean +open Lean4Lean inductive VExpr where | bvar (deBruijnIndex : Nat) diff --git a/Lean4Lean/Theory/VLevel.lean b/Lean4Lean/Theory/VLevel.lean index 51ec2732..7816d0f4 100644 --- a/Lean4Lean/Theory/VLevel.lean +++ b/Lean4Lean/Theory/VLevel.lean @@ -1,6 +1,7 @@ import Lean4Lean.Std.Basic namespace Lean4Lean +open Lean4Lean export Lean (Name) diff --git a/Lean4Lean/TypeChecker.lean b/Lean4Lean/TypeChecker.lean index ed380744..3182efcf 100644 --- a/Lean4Lean/TypeChecker.lean +++ b/Lean4Lean/TypeChecker.lean @@ -153,6 +153,11 @@ def inferForall (e : Expr) (inferOnly : Bool) : RecM Expr := loop #[] #[] e wher def isDefEqCore (t s : Expr) : RecM Bool := fun m => m.isDefEqCore t s def isDefEq (t s : Expr) : RecM Bool := do + -- Syntactically equivalent expressions are definitionally equal without + -- consulting or mutating the equivalence manager. Besides avoiding + -- needless work, this keeps exact checker executions compositional when an + -- application argument has precisely the declared domain type. + if t == s then return true let r ← isDefEqCore t s if r then modify fun st => { st with eqvManager := st.eqvManager.addEquiv t s } @@ -189,8 +194,11 @@ def inferLet (e : Expr) (inferOnly : Bool) : RecM Expr := loop #[] e where let r := r.cheapBetaReduce return (← getLCtx).mkForall fvars r -def isProp (e : Expr) : RecM Bool := - return (← whnf (← inferType e)) == .prop +def getSortLevel (e : Expr) : RecM Level := do + let .sort u ← ensureSortCore (← inferType e) e | unreachable! + return u + +def isProp (e : Expr) : RecM Bool := return (← getSortLevel e).isAlwaysZero def inferProj (typeName : Name) (idx : Nat) (struct structType : Expr) : RecM Expr := do let e := Expr.proj typeName idx struct @@ -208,16 +216,16 @@ def inferProj (typeName : Name) (idx : Nat) (struct structType : Expr) : RecM Ex for i in [:I_val.numParams] do let .forallE _ _ b _ ← whnf r | fail r := b.instantiate1 args[i]! - let isPropType ← isProp type + let maybePropType := !(← getSortLevel type).isNeverZero for i in [:idx] do let .forallE _ dom b _ ← whnf r | fail if b.hasLooseBVars then - if isPropType then if !(← isProp dom) then fail + if maybePropType then if !(← isProp dom) then fail r := b.instantiate1 (.proj I_name i struct) else r := b let .forallE _ dom _ _ ← whnf r | fail - if isPropType then if !(← isProp dom) then fail + if maybePropType then if !(← isProp dom) then fail return dom def inferType' (e : Expr) (inferOnly : Bool) : RecM Expr := do @@ -345,20 +353,22 @@ def whnfCore' (e : Expr) (cheapRec := false) (cheapProj := false) : RecM Expr := save e def isDelta (env : Environment) (e : Expr) : Option ConstantInfo := do - if let .const c _ := e.getAppFn then + if let .const c ls := e.getAppFn then if let some ci := env.find? c then - if ci.hasValue then + if ci.deltaValue?.isSome && ls.length == ci.numLevelParams then return ci none +def instantiateDeltaValue (ci : ConstantInfo) (ls : List Level) : Expr := + ci.deltaValue?.get!.instantiateLevelParams ci.levelParams ls + def unfoldDefinitionCore (e : Expr) : RecM (Option Expr) := do let .const _ ls := e | return none let env ← getEnv let some d := isDelta env e | return none - unless ls.length == d.numLevelParams do return none - unless 0 < ls.length do return some (d.instantiateValueLevelParams! ls) + unless 0 < ls.length do return some (instantiateDeltaValue d ls) if let some r := (← get).unfold[e]? then return some r - let r := d.instantiateValueLevelParams! ls + let r := instantiateDeltaValue d ls modify fun s => { s with unfold := s.unfold.insert e r } return some r @@ -490,7 +500,7 @@ def quickIsDefEq (t s : Expr) (useHash := false) : RecM LBool := do match t, s with | .lam .., .lam .. => toLBoolM <| isDefEqLambda t s | .forallE .., .forallE .. => toLBoolM <| isDefEqForall t s - | .sort a1, .sort a2 => pure (a1.isEquiv' a2).toLBool + | .sort a1, .sort a2 => pure (a1.isEquiv a2).toLBool | .mdata _ a1, .mdata _ a2 => toLBoolM <| isDefEq a1 a2 | .mvar .., .mvar .. => unreachable! | .lit a1, .lit a2 => pure (a1 == a2).toLBool @@ -518,7 +528,7 @@ def tryEtaStructCore (t s : Expr) : RecM Bool := do let env ← getEnv let .ctorInfo fInfo ← env.get f | return false unless s.getAppNumArgs == fInfo.numParams + fInfo.numFields do return false - unless env.isStructureLike fInfo.induct do return false + unless env.isNonRecStructure fInfo.induct do return false unless ← isDefEq (← inferType t) (← inferType s) do return false let args := s.getAppArgs for h : i in [fInfo.numParams:args.size] do diff --git a/Lean4Lean/Verify/Axioms.lean b/Lean4Lean/Verify/Axioms.lean index b18475d0..c145291d 100644 --- a/Lean4Lean/Verify/Axioms.lean +++ b/Lean4Lean/Verify/Axioms.lean @@ -12,7 +12,7 @@ axiom all_eq_all_toList {p : α → β → Bool} : end Std.TreeMap -open scoped List +open scoped _root_.List namespace Lean noncomputable def PersistentArrayNode.toList' : PersistentArrayNode α → List α := @@ -81,12 +81,6 @@ axiom findAux_isSome {α β} [BEq α] {node : Node α β} (i : USize) (a : α) : end PersistentHashMap --- FIXME: lean4#8464 -open private mkAppRangeAux from Lean.Expr in -axiom Expr.mkAppRangeAux.eq_def (n : Nat) (args : Array Expr) (i : Nat) (e : Expr) : - mkAppRangeAux n args i e = - if i < n then mkAppRangeAux n args (i + 1) (mkApp e args[i]!) else e - namespace Syntax def structEq' : Syntax → Syntax → Bool @@ -137,7 +131,8 @@ def hasParam' : Level → Bool | .succ l => l.hasParam' | .max l₁ l₂ | .imax l₁ l₂ => l₁.hasParam' || l₂.hasParam' -/-- This is currently false, see bug lean4#8554 -/ +/-- This was false prior to the fix of lean4#8554; it should now be provable +using `mkData_eq` and friends, but this has not been done yet -/ @[simp] axiom hasParam_eq (l : Level) : l.hasParam = l.hasParam' def hasMVar' : Level → Bool @@ -146,7 +141,8 @@ def hasMVar' : Level → Bool | .succ l => l.hasMVar' | .max l₁ l₂ | .imax l₁ l₂ => l₁.hasMVar' || l₂.hasMVar' -/-- This is currently false, see bug lean4#8554 -/ +/-- This was false prior to the fix of lean4#8554; it should now be provable +using `mkData_eq` and friends, but this has not been done yet -/ @[simp] axiom hasMVar_eq (l : Level) : l.hasMVar = l.hasMVar' /-- This is because the `BEq` instance is implemented in C++ -/ @@ -202,74 +198,6 @@ axiom mkData_eq : @mkData = @mkData' in the main results, which use the functions below instead -/ axiom mkAppData_eq : @mkAppData = @mkAppData' -def hasFVar' : Expr → Bool - | .fvar _ => true - | .const .. - | .bvar _ - | .sort _ - | .mvar _ - | .lit _ => false - | .mdata _ e => e.hasFVar' - | .proj _ _ e => e.hasFVar' - | .app e1 e2 - | .lam _ e1 e2 _ - | .forallE _ e1 e2 _ => e1.hasFVar' || e2.hasFVar' - | .letE _ t v b _ => t.hasFVar' || v.hasFVar' || b.hasFVar' - -/-- This is currently false, see bug lean4#8554 -/ -axiom hasFVar_eq (e : Expr) : e.hasFVar = e.hasFVar' - -def hasExprMVar' : Expr → Bool - | .mvar _ => true - | .const .. - | .bvar _ - | .sort _ - | .fvar _ - | .lit _ => false - | .mdata _ e => e.hasExprMVar' - | .proj _ _ e => e.hasExprMVar' - | .app e1 e2 - | .lam _ e1 e2 _ - | .forallE _ e1 e2 _ => e1.hasExprMVar' || e2.hasExprMVar' - | .letE _ t v b _ => t.hasExprMVar' || v.hasExprMVar' || b.hasExprMVar' - -/-- This is currently false, see bug lean4#8554 -/ -@[simp] axiom hasExprMVar_eq (e : Expr) : e.hasExprMVar = e.hasExprMVar' - -def hasLevelMVar' : Expr → Bool - | .const _ ls => ls.any (·.hasMVar) - | .sort u => u.hasMVar - | .bvar _ - | .fvar _ - | .mvar _ - | .lit _ => false - | .mdata _ e => e.hasLevelMVar' - | .proj _ _ e => e.hasLevelMVar' - | .app e1 e2 - | .lam _ e1 e2 _ - | .forallE _ e1 e2 _ => e1.hasLevelMVar' || e2.hasLevelMVar' - | .letE _ t v b _ => t.hasLevelMVar' || v.hasLevelMVar' || b.hasLevelMVar' - -/-- This is currently false, see bug lean4#8554 -/ -@[simp] axiom hasLevelMVar_eq (e : Expr) : e.hasLevelMVar = e.hasLevelMVar' - -def hasLevelParam' : Expr → Bool - | .const _ ls => ls.any (·.hasParam) - | .sort u => u.hasParam - | .bvar _ - | .fvar _ - | .mvar _ - | .lit _ => false - | .mdata _ e => e.hasLevelParam' - | .proj _ _ e => e.hasLevelParam' - | .app e1 e2 - | .lam _ e1 e2 _ - | .forallE _ e1 e2 _ => e1.hasLevelParam' || e2.hasLevelParam' - | .letE _ t v b _ => t.hasLevelParam' || v.hasLevelParam' || b.hasLevelParam' - -/-- This is currently false, see bug lean4#8554 -/ -@[simp] axiom hasLevelParam_eq (e : Expr) : e.hasLevelParam = e.hasLevelParam' - def looseBVarRange' : Expr → Nat | .bvar i => i + 1 | .const .. @@ -284,7 +212,8 @@ def looseBVarRange' : Expr → Nat | .forallE _ e1 e2 _ => max e1.looseBVarRange' (e2.looseBVarRange' - 1) | .letE _ e1 e2 e3 _ => max (max e1.looseBVarRange' e2.looseBVarRange') (e3.looseBVarRange' - 1) -/-- This is currently false, see bug lean4#8554 -/ +/-- This was false prior to the fix of lean4#8554; it should now be provable +using `mkData_eq` and friends, but this has not been done yet -/ @[simp] axiom looseBVarRange_eq (e : Expr) : e.looseBVarRange = e.looseBVarRange' /-- This could be an `@[implemented_by]` -/ diff --git a/Lean4Lean/Verify/Environment.lean b/Lean4Lean/Verify/Environment.lean new file mode 100644 index 00000000..1e85a11c --- /dev/null +++ b/Lean4Lean/Verify/Environment.lean @@ -0,0 +1,20 @@ +import Lean4Lean.Verify.TypeChecker +import Lean4Lean.Environment + +namespace Lean4Lean + +open Lean hiding Environment Exception +open Kernel + +/-- The intended main theorem of the `Verify` development, currently unproved: +if `env` is well-formed and `addDecl env decl` (in checking mode) succeeds, +then the resulting environment is also well-formed, and it extends `env`. + +None of the pieces of this theorem exist yet: nothing relates +`Lean.Kernel.Environment.add` to the `TrEnv` relation, and nothing repackages +the `checkType.WF`/`isDefEq.WF` postconditions at the empty local context into +the abstract `VDecl.WF` premises needed to extend `TrEnv`. -/ +theorem addDecl.WF {env : Environment} {ves : VEnvs} (wf : ves.WF env) (decl : Declaration) : + (addDecl env decl).WF fun env' => + ∃ ves' : VEnvs, ves'.WF env' ∧ ∀ safety, ves.venv safety ≤ ves'.venv safety := + sorry diff --git a/Lean4Lean/Verify/Environment/IndexedVecCandidate.lean b/Lean4Lean/Verify/Environment/IndexedVecCandidate.lean new file mode 100644 index 00000000..0ec1c658 --- /dev/null +++ b/Lean4Lean/Verify/Environment/IndexedVecCandidate.lean @@ -0,0 +1,1394 @@ +import Lean4Lean.Verify.Environment.InductiveFixtures + +namespace Lean4Lean.InductiveReplayFixtures +open Lean Meta +open Lean4Lean.InductiveFixtures + +def indexedVecKernelEnv : Kernel.Environment := + Kernel.Environment.ofConstants `_indexedVecCandidate natMap + +def indexedVecFamilyCandidateContext : + Lean4Lean.AddInductive.Context where + env := indexedVecKernelEnv + lparams := indexedVecInfo.levelParams + safety := .safe + allowPrimitive := false + +private theorem indexedVecKernel_lookup_nat : + indexedVecKernelEnv.find? ``Nat = some natInfo := by + change natMap.find?' ``Nat = some natInfo + rw [natMap_wf.find?'_eq_find?, nat_type_map_lookup] + +@[simp] private theorem indexedVecKernel_get_nat : + indexedVecKernelEnv.get ``Nat = .ok natInfo := by + simp only [Kernel.Environment.get, indexedVecKernel_lookup_nat, + Pure.pure, Except.pure] + +private def indexedVecParamName : Name := + indexedVecInfo.type.bindingName! + +private def indexedVecIndexName : Name := + indexedVecInfo.type.bindingBody!.bindingName! + +private def indexedVecParamCandidateContext : + Lean4Lean.AddInductive.Context := + indexedVecFamilyCandidateContext.pushLocalDecl + indexedVecParamName .default (.sort (.succ (.param `u))) + +private def indexedVecIndexCandidateContext : + Lean4Lean.AddInductive.Context := + indexedVecParamCandidateContext.pushLocalDecl + indexedVecIndexName .default (.const ``Nat []) + +private def indexedVecInnerKernel : Expr := + .forallE indexedVecIndexName (.const ``Nat []) + (.sort (.succ (.param `u))) .default + +private def indexedVecTerminalKernel : Expr := + .sort (.succ (.param `u)) + +@[simp] private theorem indexedVecInnerKernel_instantiate1 (arg : Expr) : + indexedVecInnerKernel.instantiate1 arg = indexedVecInnerKernel := by + simp [indexedVecInnerKernel, Expr.instantiate1_eq, Expr.instantiate1'] + +@[simp] private theorem indexedVecTerminalKernel_instantiate1 (arg : Expr) : + indexedVecTerminalKernel.instantiate1 arg = + indexedVecTerminalKernel := by + simp [indexedVecTerminalKernel, Expr.instantiate1_eq, + Expr.instantiate1'] + +@[simp] private theorem indexedVecInfo_levelParams : + indexedVecInfo.levelParams = [`u] := rfl + +/-- Reflexive binder-domain equality is an exact successful ordinary-checker +run in any candidate context with positive recursive fuel. -/ +theorem candidateIsDefEqSelfValid + (context : Lean4Lean.AddInductive.Context) (e : Expr) + (fuel : Nat) (hfuel : context.fuel.recDepth = fuel + 1) : + Lean4Lean.AddInductive.CandidateIsDefEqStep.Valid ⟨context, e, e⟩ := by + unfold Lean4Lean.AddInductive.CandidateIsDefEqStep.Valid + unfold Lean4Lean.TypeChecker.M.run Lean4Lean.TypeChecker.isDefEq + Lean4Lean.TypeChecker.RecM.run + simp [readThe, MonadReaderOf.read, ReaderT.read, + ReaderT.bind, StateT.bind, Except.bind, Bind.bind, + StateT.pure, Except.pure, Pure.pure, + StateT.run', Functor.map, Except.map] + rw [hfuel] + change Except.map (fun x : Bool × Lean4Lean.TypeChecker.State => x.1) + (Lean4Lean.TypeChecker.Inner.isDefEq e e + (Lean4Lean.TypeChecker.Methods.withFuel (fuel + 1)) + context.toTypeChecker ({} : Lean4Lean.TypeChecker.State)) = .ok true + unfold Lean4Lean.TypeChecker.Inner.isDefEq + rw [if_pos (Expr.eqv_refl e)] + rfl + +private def indexedVecTypeCheckerContext + (lctx : LocalContext) : Lean4Lean.TypeChecker.Context where + env := indexedVecKernelEnv + lctx := lctx + lparams := [`u] + +@[simp] private theorem indexedVecFamily_checkLevel : + Lean4Lean.TypeChecker.Inner.checkLevel + indexedVecFamilyCandidateContext.toTypeChecker + (.succ (.param `u)) = .ok () := by + simp [Lean4Lean.TypeChecker.Inner.checkLevel, + indexedVecFamilyCandidateContext, indexedVecInfo, + Lean4Lean.AddInductive.Context.toTypeChecker, + Level.getUndefParam, Level.forEach, + Level.hasParam_eq, Level.hasParam'] + rfl + +@[simp] private theorem indexedVec_checkLevel + (lctx : LocalContext) : + Lean4Lean.TypeChecker.Inner.checkLevel + (indexedVecTypeCheckerContext lctx) + (.succ (.param `u)) = .ok () := by + simp [Lean4Lean.TypeChecker.Inner.checkLevel, + indexedVecTypeCheckerContext, + Level.getUndefParam, Level.forEach, + Level.hasParam_eq, Level.hasParam'] + rfl + +@[simp] private theorem indexedVecRecMGet (methods context state) : + (get : Lean4Lean.TypeChecker.RecM Lean4Lean.TypeChecker.State) + methods context state = .ok (state, state) := rfl + +@[simp] private theorem indexedVecRecMReadContext + (methods context state) : + (readThe Lean4Lean.TypeChecker.Context : + Lean4Lean.TypeChecker.RecM Lean4Lean.TypeChecker.Context) + methods context state = .ok (context, state) := rfl + +@[simp] private theorem indexedVecRecMModify + (f : Lean4Lean.TypeChecker.State → Lean4Lean.TypeChecker.State) + (methods context state) : + (modify f : Lean4Lean.TypeChecker.RecM PUnit) + methods context state = .ok (.unit, f state) := rfl + +@[simp] private theorem indexedVecRecMPure + {α} (a : α) (methods context state) : + (pure a : Lean4Lean.TypeChecker.RecM α) + methods context state = .ok (a, state) := rfl + +@[simp] private theorem indexedVecRecMBind + {α β} (x : Lean4Lean.TypeChecker.RecM α) + (f : α → Lean4Lean.TypeChecker.RecM β) + (methods context state) : + (x >>= f) methods context state = + match x methods context state with + | .error e => .error e + | .ok (a, state') => f a methods context state' := by + simp [Bind.bind, ReaderT.bind, StateT.bind, Except.bind] + cases h : x methods context state with + | error => rfl + | ok value => cases value; rfl + +@[simp] private theorem indexedVecRecMLiftExceptOk + {α} (a : α) (methods context state) : + (liftM (.ok a : Except Kernel.Exception α) : + Lean4Lean.TypeChecker.RecM α) methods context state = + .ok (a, state) := rfl + +@[simp] private theorem indexedVecGetNGen + (context : Lean4Lean.TypeChecker.Context) + (state : Lean4Lean.TypeChecker.State) : + (getNGen : Lean4Lean.TypeChecker.M NameGenerator) context state = + .ok (state.ngen, state) := rfl + +@[simp] private theorem indexedVecSetNGen + (ngen : NameGenerator) (context : Lean4Lean.TypeChecker.Context) + (state : Lean4Lean.TypeChecker.State) : + (setNGen ngen : Lean4Lean.TypeChecker.M PUnit) context state = + .ok (.unit, { state with ngen }) := rfl + +@[simp] private theorem indexedVecMPure + {α} (a : α) (context : Lean4Lean.TypeChecker.Context) + (state : Lean4Lean.TypeChecker.State) : + (pure a : Lean4Lean.TypeChecker.M α) context state = + .ok (a, state) := rfl + +@[simp] private theorem indexedVecRecMWithReader + {α} (f : LocalContext → LocalContext) + (x : Lean4Lean.TypeChecker.RecM α) + (methods : Lean4Lean.TypeChecker.Methods) + (context : Lean4Lean.TypeChecker.Context) + (state : Lean4Lean.TypeChecker.State) : + (MonadWithReaderOf.withReader (m := Lean4Lean.TypeChecker.RecM) f x) + methods context state = + x methods { context with lctx := f context.lctx } state := rfl + +private theorem indexedVecWithLocalDecl + {α} (name : Name) (bi : BinderInfo) (ty : Expr) + (k : Expr → Lean4Lean.TypeChecker.RecM α) + (methods : Lean4Lean.TypeChecker.Methods) + (context : Lean4Lean.TypeChecker.Context) + (state : Lean4Lean.TypeChecker.State) : + (withLocalDecl (m := Lean4Lean.TypeChecker.RecM) name bi ty k) + methods context state = + k (.fvar ⟨state.ngen.curr⟩) methods + { context with lctx := + (context.lctx.mkLocalDecl ⟨state.ngen.curr⟩ name ty bi) } + { state with ngen := state.ngen.next } := rfl + +@[simp] private theorem indexedVecEnsureSort + (u : Level) (source : Expr) + (methods : Lean4Lean.TypeChecker.Methods) + (context : Lean4Lean.TypeChecker.Context) + (state : Lean4Lean.TypeChecker.State) : + Lean4Lean.TypeChecker.Inner.ensureSortCore (.sort u) source + methods context state = .ok (.sort u, state) := by + rfl + +private theorem indexedVecInferTypeFuel + (n e inferOnly context state) : + Lean4Lean.TypeChecker.Inner.inferType e inferOnly + (Lean4Lean.TypeChecker.Methods.withFuel (n + 1)) context state = + Lean4Lean.TypeChecker.Inner.inferType' e inferOnly + (Lean4Lean.TypeChecker.Methods.withFuel n) context state := rfl + +@[simp] private theorem indexedVecInferTypeSortCore + (n : Nat) (lctx : LocalContext) + (state : Lean4Lean.TypeChecker.State) + (hcache : state.inferTypeC[(.sort (.succ (.param `u)) : Expr)]? = none) : + Lean4Lean.TypeChecker.Inner.inferType' + (.sort (.succ (.param `u))) false + (Lean4Lean.TypeChecker.Methods.withFuel n) + (indexedVecTypeCheckerContext lctx) + state = + .ok (.sort (.succ (.succ (.param `u))), + { state with inferTypeC := + (state.inferTypeC.insert (.sort (.succ (.param `u))) + (.sort (.succ (.succ (.param `u))))) }) := by + unfold Lean4Lean.TypeChecker.Inner.inferType' + simp [Expr.hasLooseBVars, Expr.looseBVarRange', hcache, + Bind.bind, ReaderT.bind, StateT.bind, Except.bind] + +@[simp] private theorem indexedVecInferTypeSortCachedCore + (n : Nat) (lctx : LocalContext) + (state : Lean4Lean.TypeChecker.State) + (hcache : state.inferTypeC[(.sort (.succ (.param `u)) : Expr)]? = + some (.sort (.succ (.succ (.param `u))))) : + Lean4Lean.TypeChecker.Inner.inferType' + (.sort (.succ (.param `u))) false + (Lean4Lean.TypeChecker.Methods.withFuel n) + (indexedVecTypeCheckerContext lctx) + state = .ok (.sort (.succ (.succ (.param `u))), state) := by + unfold Lean4Lean.TypeChecker.Inner.inferType' + simp [Expr.hasLooseBVars, Expr.looseBVarRange', hcache] + +@[simp] private theorem indexedVecInferConstantNat + (lctx : LocalContext) : + Lean4Lean.TypeChecker.Inner.inferConstant + (indexedVecTypeCheckerContext lctx) ``Nat [] false = + .ok (.sort (.succ .zero)) := by + unfold Lean4Lean.TypeChecker.Inner.inferConstant + simp [indexedVecTypeCheckerContext, indexedVecKernel_get_nat, + natInfo, ConstantInfo.levelParams, ConstantInfo.isUnsafe, + ConstantInfo.instantiateTypeLevelParams, ConstantInfo.toConstantVal, + ConstantVal.instantiateTypeLevelParams, + Expr.instantiateLevelParams_eq, Expr.instantiateLevelParamsCore', + Level.substParams', Bind.bind, Except.bind, + Pure.pure, Except.pure] + +@[simp] private theorem indexedVecInferTypeNatCore + (n : Nat) (lctx : LocalContext) + (state : Lean4Lean.TypeChecker.State) + (hcache : state.inferTypeC[(.const ``Nat [] : Expr)]? = none) : + Lean4Lean.TypeChecker.Inner.inferType' (.const ``Nat []) false + (Lean4Lean.TypeChecker.Methods.withFuel n) + (indexedVecTypeCheckerContext lctx) + state = + .ok (.sort (.succ .zero), + { state with inferTypeC := + (state.inferTypeC.insert (.const ``Nat []) + (.sort (.succ .zero))) }) := by + unfold Lean4Lean.TypeChecker.Inner.inferType' + simp [Expr.hasLooseBVars, Expr.looseBVarRange', hcache, + indexedVecInferConstantNat, + Bind.bind, ReaderT.bind, StateT.bind, Except.bind] + +private def indexedVecRootSortState : Lean4Lean.TypeChecker.State := + { ({} : Lean4Lean.TypeChecker.State) with inferTypeC := + (({} : Lean4Lean.TypeChecker.State).inferTypeC.insert + (.sort (.succ (.param `u))) + (.sort (.succ (.succ (.param `u))))) } + +@[simp] private theorem indexedVecRootSortCore : + Lean4Lean.TypeChecker.Inner.inferType' + (.sort (.succ (.param `u))) false + (Lean4Lean.TypeChecker.Methods.withFuel 9998) + indexedVecFamilyCandidateContext.toTypeChecker + ({} : Lean4Lean.TypeChecker.State) = + .ok (.sort (.succ (.succ (.param `u))), + indexedVecRootSortState) := by + simpa [indexedVecFamilyCandidateContext, + Lean4Lean.AddInductive.Context.toTypeChecker, + indexedVecInfo, ConstantInfo.levelParams, + ConstantInfo.toConstantVal, indexedVecTypeCheckerContext, + indexedVecRootSortState] using + (indexedVecInferTypeSortCore 9998 ({} : LocalContext) + ({} : Lean4Lean.TypeChecker.State) Std.HashMap.getElem?_empty) + +private def indexedVecParamLctx : LocalContext := + ({} : LocalContext).mkLocalDecl + ⟨indexedVecRootSortState.ngen.curr⟩ indexedVecParamName + (.sort (.succ (.param `u))) .default + +private def indexedVecAfterParamState : Lean4Lean.TypeChecker.State := + { indexedVecRootSortState with + ngen := indexedVecRootSortState.ngen.next } + +private def indexedVecNatState : Lean4Lean.TypeChecker.State := + { indexedVecAfterParamState with + inferTypeC := indexedVecAfterParamState.inferTypeC.insert + (.const ``Nat []) (.sort (.succ .zero)) } + +private def indexedVecIndexLctx : LocalContext := + indexedVecParamLctx.mkLocalDecl + ⟨indexedVecNatState.ngen.curr⟩ indexedVecIndexName + (.const ``Nat []) .default + +private def indexedVecAfterIndexState : Lean4Lean.TypeChecker.State := + { indexedVecNatState with ngen := indexedVecNatState.ngen.next } + +private theorem indexedVecOuterWithLocalDecl + {α} (k : Expr → Lean4Lean.TypeChecker.RecM α) + (methods : Lean4Lean.TypeChecker.Methods) : + (withLocalDecl (m := Lean4Lean.TypeChecker.RecM) + indexedVecParamName .default (.sort (.succ (.param `u))) k) + methods indexedVecFamilyCandidateContext.toTypeChecker + indexedVecRootSortState = + k (.fvar ⟨indexedVecRootSortState.ngen.curr⟩) methods + { indexedVecFamilyCandidateContext.toTypeChecker with + lctx := indexedVecParamLctx } + indexedVecAfterParamState := by + simpa [indexedVecParamLctx, indexedVecAfterParamState, + indexedVecFamilyCandidateContext, + Lean4Lean.AddInductive.Context.toTypeChecker] using + (indexedVecWithLocalDecl indexedVecParamName .default + (.sort (.succ (.param `u))) k methods + indexedVecFamilyCandidateContext.toTypeChecker indexedVecRootSortState) + +private theorem indexedVecInnerWithLocalDecl + {α} (k : Expr → Lean4Lean.TypeChecker.RecM α) + (methods : Lean4Lean.TypeChecker.Methods) : + (withLocalDecl (m := Lean4Lean.TypeChecker.RecM) + indexedVecIndexName .default (.const ``Nat []) k) + methods + { indexedVecFamilyCandidateContext.toTypeChecker with + lctx := indexedVecParamLctx } + indexedVecNatState = + k (.fvar ⟨indexedVecNatState.ngen.curr⟩) methods + { indexedVecFamilyCandidateContext.toTypeChecker with + lctx := indexedVecIndexLctx } + indexedVecAfterIndexState := by + simpa [indexedVecIndexLctx, indexedVecAfterIndexState] using + (indexedVecWithLocalDecl indexedVecIndexName .default + (.const ``Nat []) k methods + { indexedVecFamilyCandidateContext.toTypeChecker with + lctx := indexedVecParamLctx } + indexedVecNatState) + +@[simp] private theorem indexedVecNat_beq_sort : + ((.const ``Nat [] : Expr) == .sort (.succ (.param `u))) = false := by + change Expr.eqv (.const ``Nat []) (.sort (.succ (.param `u))) = false + rw [Expr.eqv_eq] + rfl + +@[simp] private theorem indexedVecAfterIndexState_sort_cache : + indexedVecAfterIndexState.inferTypeC[ + (.sort (.succ (.param `u)) : Expr)]? = + some (.sort (.succ (.succ (.param `u)))) := by + change + (((({} : Lean4Lean.InferCache).insert + (.sort (.succ (.param `u))) + (.sort (.succ (.succ (.param `u))))).insert + (.const ``Nat []) (.sort (.succ .zero)))[ + (.sort (.succ (.param `u)) : Expr)]?) = _ + rw [Std.HashMap.getElem?_insert, indexedVecNat_beq_sort] + exact Std.HashMap.getElem?_insert_self + +@[simp] private theorem indexedVecParamNatCore : + Lean4Lean.TypeChecker.Inner.inferType' (.const ``Nat []) false + (Lean4Lean.TypeChecker.Methods.withFuel 9998) + { indexedVecFamilyCandidateContext.toTypeChecker with + lctx := indexedVecParamLctx } + indexedVecAfterParamState = + .ok (.sort (.succ .zero), indexedVecNatState) := by + simpa [indexedVecFamilyCandidateContext, + Lean4Lean.AddInductive.Context.toTypeChecker, + indexedVecInfo, ConstantInfo.levelParams, + ConstantInfo.toConstantVal, indexedVecTypeCheckerContext, + indexedVecAfterParamState, indexedVecRootSortState, + indexedVecNatState] using + (indexedVecInferTypeNatCore 9998 indexedVecParamLctx + indexedVecAfterParamState (by + simp [indexedVecAfterParamState, indexedVecRootSortState])) + +@[simp] private theorem indexedVecTerminalSortCore : + Lean4Lean.TypeChecker.Inner.inferType' + (.sort (.succ (.param `u))) false + (Lean4Lean.TypeChecker.Methods.withFuel 9998) + { indexedVecFamilyCandidateContext.toTypeChecker with + lctx := indexedVecIndexLctx } + indexedVecAfterIndexState = + .ok (.sort (.succ (.succ (.param `u))), + indexedVecAfterIndexState) := by + simpa [indexedVecFamilyCandidateContext, + Lean4Lean.AddInductive.Context.toTypeChecker, + indexedVecInfo, ConstantInfo.levelParams, + ConstantInfo.toConstantVal, indexedVecTypeCheckerContext, + indexedVecAfterIndexState, indexedVecNatState, + indexedVecAfterParamState, indexedVecRootSortState] using + (indexedVecInferTypeSortCachedCore 9998 indexedVecIndexLctx + indexedVecAfterIndexState indexedVecAfterIndexState_sort_cache) + +private def indexedVecFamilyInferredLevel : Level := + mkLevelIMax' (.succ (.succ (.param `u))) + (mkLevelIMax' (.succ .zero) (.succ (.succ (.param `u)))) + +private theorem indexedVecFamilyInferForall : + Lean4Lean.TypeChecker.Inner.inferForall + (.forallE indexedVecParamName (.sort (.succ (.param `u))) + (.forallE indexedVecIndexName (.const ``Nat []) + (.sort (.succ (.param `u))) .default) .default) + false + (Lean4Lean.TypeChecker.Methods.withFuel 9999) + indexedVecFamilyCandidateContext.toTypeChecker + ({} : Lean4Lean.TypeChecker.State) = + .ok (.sort indexedVecFamilyInferredLevel, + indexedVecAfterIndexState) := by + unfold Lean4Lean.TypeChecker.Inner.inferForall + simp only [Lean4Lean.TypeChecker.Inner.inferForall.loop] + rw [show + (.sort (.succ (.param `u)) : Expr).instantiateRev #[] = + .sort (.succ (.param `u)) by + simp [Expr.instantiateRev_eq, Expr.instantiate_eq]] + simp only [Bind.bind, ReaderT.bind, StateT.bind, Except.bind] + rw [indexedVecInferTypeFuel 9998] + rw [indexedVecRootSortCore] + simp only + rw [indexedVecEnsureSort] + simp only + rw [indexedVecOuterWithLocalDecl] + rw [show + (.const ``Nat [] : Expr).instantiateRev + (#[] |>.push (.fvar ⟨indexedVecRootSortState.ngen.curr⟩)) = + .const ``Nat [] by + simp [Expr.instantiateRev_eq, Expr.instantiate_eq, + Expr.instantiate1']] + simp only [Bind.bind, ReaderT.bind, StateT.bind, Except.bind] + rw [indexedVecInferTypeFuel 9998] + rw [indexedVecParamNatCore] + simp only + rw [indexedVecEnsureSort] + simp only + rw [indexedVecInnerWithLocalDecl] + rw [show + (.sort (.succ (.param `u)) : Expr).instantiateRev + ((#[] |>.push + (.fvar ⟨indexedVecRootSortState.ngen.curr⟩)).push + (.fvar ⟨indexedVecNatState.ngen.curr⟩)) = + .sort (.succ (.param `u)) by + simp [Expr.instantiateRev_eq, Expr.instantiate_eq, + Expr.instantiate1']] + simp only [Bind.bind, ReaderT.bind, StateT.bind, Except.bind] + rw [indexedVecInferTypeFuel 9998] + rw [indexedVecTerminalSortCore] + simp only + rw [indexedVecEnsureSort] + simp [indexedVecFamilyInferredLevel, Expr.sortLevel!, + Pure.pure, ReaderT.pure, + StateT.pure, Except.pure] + +private def indexedVecFamilyCheckedState : Lean4Lean.TypeChecker.State := + { indexedVecAfterIndexState with + inferTypeC := indexedVecAfterIndexState.inferTypeC.insert + (.forallE indexedVecParamName (.sort (.succ (.param `u))) + (.forallE indexedVecIndexName (.const ``Nat []) + (.sort (.succ (.param `u))) .default) .default) + (.sort indexedVecFamilyInferredLevel) } + +private theorem indexedVecFamilyCheckTypeInner : + Lean4Lean.TypeChecker.Inner.inferType indexedVecInfo.type false + (Lean4Lean.TypeChecker.Methods.withFuel 10000) + indexedVecFamilyCandidateContext.toTypeChecker + ({} : Lean4Lean.TypeChecker.State) = + .ok (.sort indexedVecFamilyInferredLevel, + indexedVecFamilyCheckedState) := by + change Lean4Lean.TypeChecker.Inner.inferType' + (.forallE indexedVecParamName (.sort (.succ (.param `u))) + (.forallE indexedVecIndexName (.const ``Nat []) + (.sort (.succ (.param `u))) .default) .default) + false (Lean4Lean.TypeChecker.Methods.withFuel 9999) + indexedVecFamilyCandidateContext.toTypeChecker + ({} : Lean4Lean.TypeChecker.State) = _ + unfold Lean4Lean.TypeChecker.Inner.inferType' + simp [Expr.hasLooseBVars, Expr.looseBVarRange', + indexedVecFamilyInferForall, indexedVecFamilyCheckedState, + Bind.bind, ReaderT.bind, StateT.bind, Except.bind] + +private theorem indexedVecFamily_whnfM : + Lean4Lean.TypeChecker.M.run + indexedVecFamilyCandidateContext.env + indexedVecFamilyCandidateContext.safety + indexedVecFamilyCandidateContext.lctx + indexedVecFamilyCandidateContext.lparams + indexedVecFamilyCandidateContext.fuel + (Lean4Lean.TypeChecker.whnf indexedVecInfo.type) = + .ok indexedVecInfo.type := by + rfl + +private theorem indexedVecSort_checkTypeM (lctx : LocalContext) : + Lean4Lean.TypeChecker.M.run indexedVecKernelEnv .safe lctx [`u] + ({} : FuelConfig) + (Lean4Lean.TypeChecker.checkType (.sort (.succ (.param `u)))) = + .ok (.sort (.succ (.succ (.param `u)))) := by + change Except.map + (fun x : Expr × Lean4Lean.TypeChecker.State => x.1) + (Lean4Lean.TypeChecker.Inner.inferType + (.sort (.succ (.param `u))) false + (Lean4Lean.TypeChecker.Methods.withFuel 10000) + (indexedVecTypeCheckerContext lctx) + ({} : Lean4Lean.TypeChecker.State)) = _ + rw [indexedVecInferTypeFuel 9999] + rw [indexedVecInferTypeSortCore 9999 lctx + ({} : Lean4Lean.TypeChecker.State) Std.HashMap.getElem?_empty] + rfl + +private theorem indexedVecSort_whnfM (lctx : LocalContext) : + Lean4Lean.TypeChecker.M.run indexedVecKernelEnv .safe lctx [`u] + ({} : FuelConfig) + (Lean4Lean.TypeChecker.whnf (.sort (.succ (.param `u)))) = + .ok (.sort (.succ (.param `u))) := by + rfl + +private theorem indexedVecNat_checkTypeM (lctx : LocalContext) : + Lean4Lean.TypeChecker.M.run indexedVecKernelEnv .safe lctx [`u] + ({} : FuelConfig) + (Lean4Lean.TypeChecker.checkType (.const ``Nat [])) = + .ok (.sort (.succ .zero)) := by + change Except.map + (fun x : Expr × Lean4Lean.TypeChecker.State => x.1) + (Lean4Lean.TypeChecker.Inner.inferType (.const ``Nat []) false + (Lean4Lean.TypeChecker.Methods.withFuel 10000) + (indexedVecTypeCheckerContext lctx) + ({} : Lean4Lean.TypeChecker.State)) = _ + rw [indexedVecInferTypeFuel 9999] + rw [indexedVecInferTypeNatCore 9999 lctx + ({} : Lean4Lean.TypeChecker.State) Std.HashMap.getElem?_empty] + rfl + +private theorem indexedVecUnfoldNat (lctx methods state) : + Lean4Lean.TypeChecker.Inner.unfoldDefinition (.const ``Nat []) + methods (indexedVecTypeCheckerContext lctx) state = + .ok (none, state) := by + change Lean4Lean.TypeChecker.Inner.unfoldDefinitionCore + (.const ``Nat []) methods (indexedVecTypeCheckerContext lctx) state = _ + simp [Lean4Lean.TypeChecker.Inner.unfoldDefinitionCore, + Lean4Lean.TypeChecker.Inner.isDelta, Expr.getAppFn, + indexedVecTypeCheckerContext, indexedVecKernel_lookup_nat, + natInfo, ConstantInfo.deltaValue?, + Bind.bind, ReaderT.bind, StateT.bind, Except.bind] + +private theorem indexedVecWhnfLoopNat (lctx methods state n) : + Lean4Lean.TypeChecker.Inner.whnf'.loop (.const ``Nat []) (n + 1) + methods (indexedVecTypeCheckerContext lctx) state = + .ok (.const ``Nat [], state) := by + unfold Lean4Lean.TypeChecker.Inner.whnf'.loop + simp [indexedVecUnfoldNat] + +private theorem indexedVecNat_whnfM (lctx : LocalContext) : + Lean4Lean.TypeChecker.M.run indexedVecKernelEnv .safe lctx [`u] + ({} : FuelConfig) + (Lean4Lean.TypeChecker.whnf (.const ``Nat [])) = + .ok (.const ``Nat []) := by + change Except.map + (fun x : Expr × Lean4Lean.TypeChecker.State => x.1) + (Lean4Lean.TypeChecker.Inner.whnf' (.const ``Nat []) + (Lean4Lean.TypeChecker.Methods.withFuel 9999) + (indexedVecTypeCheckerContext lctx) + ({} : Lean4Lean.TypeChecker.State)) = _ + unfold Lean4Lean.TypeChecker.Inner.whnf' + simp + rw [show + (if (indexedVecTypeCheckerContext lctx).eagerReduce then + (indexedVecTypeCheckerContext lctx).fuel.whnfEager + else (indexedVecTypeCheckerContext lctx).fuel.whnf) = 100000 by rfl] + rw [show 100000 = 99999 + 1 by rfl] + rw [indexedVecWhnfLoopNat] + simp [Functor.map, StateT.map, Except.map] + +private def indexedVecInnerInferredLevel : Level := + mkLevelIMax' (.succ .zero) (.succ (.succ (.param `u))) + +private def indexedVecInnerNatState : Lean4Lean.TypeChecker.State := + { ({} : Lean4Lean.TypeChecker.State) with + inferTypeC := ({} : Lean4Lean.TypeChecker.State).inferTypeC.insert + (.const ``Nat []) (.sort (.succ .zero)) } + +private def indexedVecInnerCheckerLctx : LocalContext := + indexedVecParamCandidateContext.lctx.mkLocalDecl + ⟨indexedVecInnerNatState.ngen.curr⟩ indexedVecIndexName + (.const ``Nat []) .default + +private def indexedVecInnerAfterIndexState : + Lean4Lean.TypeChecker.State := + { indexedVecInnerNatState with + ngen := indexedVecInnerNatState.ngen.next } + +private def indexedVecInnerSortState : Lean4Lean.TypeChecker.State := + { indexedVecInnerAfterIndexState with + inferTypeC := indexedVecInnerAfterIndexState.inferTypeC.insert + (.sort (.succ (.param `u))) + (.sort (.succ (.succ (.param `u)))) } + +private def indexedVecInnerCheckedState : Lean4Lean.TypeChecker.State := + { indexedVecInnerSortState with + inferTypeC := indexedVecInnerSortState.inferTypeC.insert + indexedVecInnerKernel (.sort indexedVecInnerInferredLevel) } + +@[simp] private theorem indexedVecInnerNatCore : + Lean4Lean.TypeChecker.Inner.inferType' (.const ``Nat []) false + (Lean4Lean.TypeChecker.Methods.withFuel 9998) + indexedVecParamCandidateContext.toTypeChecker + ({} : Lean4Lean.TypeChecker.State) = + .ok (.sort (.succ .zero), indexedVecInnerNatState) := by + simpa [indexedVecParamCandidateContext, + indexedVecFamilyCandidateContext, + Lean4Lean.AddInductive.Context.pushLocalDecl, + Lean4Lean.AddInductive.Context.toTypeChecker, + indexedVecInfo, ConstantInfo.levelParams, + ConstantInfo.toConstantVal, indexedVecTypeCheckerContext, + indexedVecInnerNatState] using + (indexedVecInferTypeNatCore 9998 + indexedVecParamCandidateContext.lctx + ({} : Lean4Lean.TypeChecker.State) Std.HashMap.getElem?_empty) + +private theorem indexedVecInnerCheckerWithLocalDecl + {α} (k : Expr → Lean4Lean.TypeChecker.RecM α) + (methods : Lean4Lean.TypeChecker.Methods) : + (withLocalDecl (m := Lean4Lean.TypeChecker.RecM) + indexedVecIndexName .default (.const ``Nat []) k) + methods indexedVecParamCandidateContext.toTypeChecker + indexedVecInnerNatState = + k (.fvar ⟨indexedVecInnerNatState.ngen.curr⟩) methods + { indexedVecParamCandidateContext.toTypeChecker with + lctx := indexedVecInnerCheckerLctx } + indexedVecInnerAfterIndexState := by + simpa [indexedVecInnerCheckerLctx, + indexedVecInnerAfterIndexState, + indexedVecParamCandidateContext, + indexedVecFamilyCandidateContext, + Lean4Lean.AddInductive.Context.pushLocalDecl, + Lean4Lean.AddInductive.Context.toTypeChecker] using + (indexedVecWithLocalDecl indexedVecIndexName .default + (.const ``Nat []) k methods + indexedVecParamCandidateContext.toTypeChecker + indexedVecInnerNatState) + +@[simp] private theorem indexedVecInnerTerminalSortCore : + Lean4Lean.TypeChecker.Inner.inferType' + (.sort (.succ (.param `u))) false + (Lean4Lean.TypeChecker.Methods.withFuel 9998) + { indexedVecParamCandidateContext.toTypeChecker with + lctx := indexedVecInnerCheckerLctx } + indexedVecInnerAfterIndexState = + .ok (.sort (.succ (.succ (.param `u))), + indexedVecInnerSortState) := by + simpa [indexedVecParamCandidateContext, + indexedVecFamilyCandidateContext, + Lean4Lean.AddInductive.Context.pushLocalDecl, + Lean4Lean.AddInductive.Context.toTypeChecker, + indexedVecInfo, ConstantInfo.levelParams, + ConstantInfo.toConstantVal, indexedVecTypeCheckerContext, + indexedVecInnerAfterIndexState, indexedVecInnerNatState, + indexedVecInnerSortState] using + (indexedVecInferTypeSortCore 9998 indexedVecInnerCheckerLctx + indexedVecInnerAfterIndexState (by + simp [indexedVecInnerAfterIndexState, + indexedVecInnerNatState])) + +private theorem indexedVecInnerInferForall : + Lean4Lean.TypeChecker.Inner.inferForall indexedVecInnerKernel false + (Lean4Lean.TypeChecker.Methods.withFuel 9999) + indexedVecParamCandidateContext.toTypeChecker + ({} : Lean4Lean.TypeChecker.State) = + .ok (.sort indexedVecInnerInferredLevel, + indexedVecInnerSortState) := by + unfold indexedVecInnerKernel + unfold Lean4Lean.TypeChecker.Inner.inferForall + simp only [Lean4Lean.TypeChecker.Inner.inferForall.loop] + rw [show (.const ``Nat [] : Expr).instantiateRev #[] = + .const ``Nat [] by + simp [Expr.instantiateRev_eq, Expr.instantiate_eq]] + simp only [Bind.bind, ReaderT.bind, StateT.bind, Except.bind] + rw [indexedVecInferTypeFuel 9998] + rw [indexedVecInnerNatCore] + simp only + rw [indexedVecEnsureSort] + simp only + rw [indexedVecInnerCheckerWithLocalDecl] + rw [show + (.sort (.succ (.param `u)) : Expr).instantiateRev + (#[] |>.push (.fvar ⟨indexedVecInnerNatState.ngen.curr⟩)) = + .sort (.succ (.param `u)) by + simp [Expr.instantiateRev_eq, Expr.instantiate_eq, + Expr.instantiate1']] + simp only [Bind.bind, ReaderT.bind, StateT.bind, Except.bind] + rw [indexedVecInferTypeFuel 9998] + rw [indexedVecInnerTerminalSortCore] + simp only + rw [indexedVecEnsureSort] + simp [indexedVecInnerInferredLevel, Expr.sortLevel!, + Pure.pure, ReaderT.pure, StateT.pure, Except.pure] + +private theorem indexedVecInner_checkTypeM : + Lean4Lean.TypeChecker.M.run indexedVecKernelEnv .safe + indexedVecParamCandidateContext.lctx [`u] ({} : FuelConfig) + (Lean4Lean.TypeChecker.checkType indexedVecInnerKernel) = + .ok (.sort indexedVecInnerInferredLevel) := by + change Except.map + (fun x : Expr × Lean4Lean.TypeChecker.State => x.1) + (Lean4Lean.TypeChecker.Inner.inferType indexedVecInnerKernel false + (Lean4Lean.TypeChecker.Methods.withFuel 10000) + indexedVecParamCandidateContext.toTypeChecker + ({} : Lean4Lean.TypeChecker.State)) = _ + change Except.map + (fun x : Expr × Lean4Lean.TypeChecker.State => x.1) + (Lean4Lean.TypeChecker.Inner.inferType' indexedVecInnerKernel false + (Lean4Lean.TypeChecker.Methods.withFuel 9999) + indexedVecParamCandidateContext.toTypeChecker + ({} : Lean4Lean.TypeChecker.State)) = _ + unfold Lean4Lean.TypeChecker.Inner.inferType' + simp [indexedVecInnerKernel, Expr.hasLooseBVars, + Expr.looseBVarRange', + Bind.bind, ReaderT.bind, StateT.bind, Except.bind] + rw [show + Lean4Lean.TypeChecker.Inner.inferForall + (.forallE indexedVecIndexName (.const ``Nat []) + (.sort (.succ (.param `u))) .default) + false (Lean4Lean.TypeChecker.Methods.withFuel 9999) + indexedVecParamCandidateContext.toTypeChecker + ({} : Lean4Lean.TypeChecker.State) = + .ok (.sort indexedVecInnerInferredLevel, + indexedVecInnerSortState) by + simpa [indexedVecInnerKernel] using indexedVecInnerInferForall] + rfl + +private theorem indexedVecInner_whnfM : + Lean4Lean.TypeChecker.M.run indexedVecKernelEnv .safe + indexedVecParamCandidateContext.lctx [`u] ({} : FuelConfig) + (Lean4Lean.TypeChecker.whnf indexedVecInnerKernel) = + .ok indexedVecInnerKernel := by + rfl + +private theorem indexedVecFamilyCandidateFresh : + indexedVecFamilyCandidateContext.lctx.find? + indexedVecFamilyCandidateContext.freshFVarId = none := by + have h := LocalContext.WF.find?_eq_find?_toList + (fv := indexedVecFamilyCandidateContext.freshFVarId) + LocalContext.WF.nil + change + ({ fvarIdToDecl := PersistentHashMap.empty, + decls := PersistentArray.empty, + auxDeclToFullName := Std.TreeMap.empty } : LocalContext).find? + indexedVecFamilyCandidateContext.freshFVarId = none + rw [h] + simp [LocalContext.toList] + +private theorem indexedVecParamCandidateFresh : + indexedVecParamCandidateContext.lctx.find? + indexedVecParamCandidateContext.freshFVarId = none := by + have hroot := indexedVecFamilyCandidateFresh + have hwf : indexedVecParamCandidateContext.lctx.WF := by + change (({} : LocalContext).mkLocalDecl + indexedVecFamilyCandidateContext.freshFVarId + indexedVecParamName (.sort (.succ (.param `u))) .default).WF + exact LocalContext.WF.mkLocalDecl LocalContext.WF.nil (by + simpa [indexedVecFamilyCandidateContext] using hroot) + have h := LocalContext.WF.find?_eq_find?_toList + (fv := indexedVecParamCandidateContext.freshFVarId) hwf + rw [h] + simp only [indexedVecParamCandidateContext, + indexedVecFamilyCandidateContext, + Lean4Lean.AddInductive.Context.pushLocalDecl, + Lean4Lean.AddInductive.Context.freshFVarId] + rw [LocalContext.mkLocalDecl_toList] + rw [show ({} : LocalContext).toList = [] by rfl] + simp [NameGenerator.next, NameGenerator.curr] + intro heq + injection heq with hname + injection hname with hidx + omega + +private theorem indexedVecFamily_checkTypeM : + Lean4Lean.TypeChecker.M.run + indexedVecFamilyCandidateContext.env + indexedVecFamilyCandidateContext.safety + indexedVecFamilyCandidateContext.lctx + indexedVecFamilyCandidateContext.lparams + indexedVecFamilyCandidateContext.fuel + (Lean4Lean.TypeChecker.checkType indexedVecInfo.type) = + .ok (.sort indexedVecFamilyInferredLevel) := by + change Except.map + (fun x : Expr × Lean4Lean.TypeChecker.State => x.1) + (Lean4Lean.TypeChecker.Inner.inferType indexedVecInfo.type false + (Lean4Lean.TypeChecker.Methods.withFuel 10000) + indexedVecFamilyCandidateContext.toTypeChecker + ({} : Lean4Lean.TypeChecker.State)) = _ + rw [indexedVecFamilyCheckTypeInner] + rfl + +private def indexedVecParamAnnotations : + Lean4Lean.AddInductive.CandidateTypeAnnotations + indexedVecTerminalKernel where + consumed := indexedVecTerminalKernel + trace := .identity _ + +private def indexedVecIndexAnnotations : + Lean4Lean.AddInductive.CandidateTypeAnnotations (.const ``Nat []) where + consumed := .const ``Nat [] + trace := .identity _ + +private theorem indexedVecParamAnnotationTrace_build : + Lean4Lean.AddInductive.CandidateTypeAnnotationTrace.build + indexedVecTerminalKernel = + ⟨indexedVecTerminalKernel, .identity _⟩ := by + simp [Lean4Lean.AddInductive.CandidateTypeAnnotationTrace.build, + indexedVecTerminalKernel] + +private theorem indexedVecIndexAnnotationTrace_build : + Lean4Lean.AddInductive.CandidateTypeAnnotationTrace.build + (.const ``Nat []) = ⟨.const ``Nat [], .identity _⟩ := by + simp [Lean4Lean.AddInductive.CandidateTypeAnnotationTrace.build] + +private theorem indexedVecParamAnnotations_build : + Lean4Lean.AddInductive.buildCandidateTypeAnnotations + indexedVecTerminalKernel = .ok indexedVecParamAnnotations := by + unfold Lean4Lean.AddInductive.buildCandidateTypeAnnotations + rw [indexedVecParamAnnotationTrace_build] + rfl + +private theorem indexedVecIndexAnnotations_build : + Lean4Lean.AddInductive.buildCandidateTypeAnnotations + (.const ``Nat []) = .ok indexedVecIndexAnnotations := by + unfold Lean4Lean.AddInductive.buildCandidateTypeAnnotations + rw [indexedVecIndexAnnotationTrace_build] + rfl + +private theorem indexedVecParamAnnotations_match : + indexedVecParamAnnotations.Matches := + Lean4Lean.AddInductive.CandidateTypeAnnotations.matches_of_build + indexedVecParamAnnotations indexedVecParamAnnotations_build + +private theorem indexedVecIndexAnnotations_match : + indexedVecIndexAnnotations.Matches := + Lean4Lean.AddInductive.CandidateTypeAnnotations.matches_of_build + indexedVecIndexAnnotations indexedVecIndexAnnotations_build + +private theorem indexedVecParamAnnotationsEq : + Lean4Lean.AddInductive.CandidateIsDefEqStep.Valid + ⟨indexedVecFamilyCandidateContext, indexedVecTerminalKernel, + indexedVecParamAnnotations.consumed⟩ := by + simpa [indexedVecParamAnnotations] using + (candidateIsDefEqSelfValid indexedVecFamilyCandidateContext + indexedVecTerminalKernel 9999 rfl) + +private theorem indexedVecIndexAnnotationsEq : + Lean4Lean.AddInductive.CandidateIsDefEqStep.Valid + ⟨indexedVecParamCandidateContext, (.const ``Nat []), + indexedVecIndexAnnotations.consumed⟩ := by + simpa [indexedVecIndexAnnotations] using + (candidateIsDefEqSelfValid indexedVecParamCandidateContext + (.const ``Nat []) 9999 rfl) + +private def indexedVecParamDomainCandidateTrace : + Lean4Lean.AddInductive.CandidateExprTrace + indexedVecFamilyCandidateContext indexedVecTerminalKernel := + .terminal indexedVecFamilyCandidateContext indexedVecTerminalKernel + (.sort (.succ (.succ (.param `u)))) indexedVecTerminalKernel + (by + simpa [Lean4Lean.AddInductive.CandidateCheckTypeStep.Valid, + indexedVecFamilyCandidateContext, indexedVecInfo, + ConstantInfo.levelParams, ConstantInfo.toConstantVal, + indexedVecTerminalKernel] using + indexedVecSort_checkTypeM + indexedVecFamilyCandidateContext.lctx) + (by + simpa [Lean4Lean.AddInductive.CandidateWhnfStep.Valid, + indexedVecFamilyCandidateContext, indexedVecInfo, + ConstantInfo.levelParams, ConstantInfo.toConstantVal, + indexedVecTerminalKernel] using + indexedVecSort_whnfM indexedVecFamilyCandidateContext.lctx) + +private def indexedVecIndexDomainCandidateTrace : + Lean4Lean.AddInductive.CandidateExprTrace + indexedVecParamCandidateContext (.const ``Nat []) := + .terminal indexedVecParamCandidateContext (.const ``Nat []) + (.sort (.succ .zero)) (.const ``Nat []) + (by + simpa [Lean4Lean.AddInductive.CandidateCheckTypeStep.Valid, + indexedVecParamCandidateContext, + indexedVecFamilyCandidateContext, indexedVecInfo, + ConstantInfo.levelParams, ConstantInfo.toConstantVal, + Lean4Lean.AddInductive.Context.pushLocalDecl] using + indexedVecNat_checkTypeM indexedVecParamCandidateContext.lctx) + (by + simpa [Lean4Lean.AddInductive.CandidateWhnfStep.Valid, + indexedVecParamCandidateContext, + indexedVecFamilyCandidateContext, indexedVecInfo, + ConstantInfo.levelParams, ConstantInfo.toConstantVal, + Lean4Lean.AddInductive.Context.pushLocalDecl] using + indexedVecNat_whnfM indexedVecParamCandidateContext.lctx) + +private def indexedVecTerminalCandidateTrace : + Lean4Lean.AddInductive.CandidateExprTrace + indexedVecIndexCandidateContext + (indexedVecTerminalKernel.instantiate1 + indexedVecParamCandidateContext.freshExpr) := + .terminal indexedVecIndexCandidateContext + (indexedVecTerminalKernel.instantiate1 + indexedVecParamCandidateContext.freshExpr) + (.sort (.succ (.succ (.param `u)))) indexedVecTerminalKernel + (by + simpa [Lean4Lean.AddInductive.CandidateCheckTypeStep.Valid, + indexedVecIndexCandidateContext, + indexedVecParamCandidateContext, + indexedVecFamilyCandidateContext, indexedVecInfo, + ConstantInfo.levelParams, ConstantInfo.toConstantVal, + Lean4Lean.AddInductive.Context.pushLocalDecl, + indexedVecTerminalKernel] using + indexedVecSort_checkTypeM indexedVecIndexCandidateContext.lctx) + (by + simpa [Lean4Lean.AddInductive.CandidateWhnfStep.Valid, + indexedVecIndexCandidateContext, + indexedVecParamCandidateContext, + indexedVecFamilyCandidateContext, indexedVecInfo, + ConstantInfo.levelParams, ConstantInfo.toConstantVal, + Lean4Lean.AddInductive.Context.pushLocalDecl, + indexedVecTerminalKernel] using + indexedVecSort_whnfM indexedVecIndexCandidateContext.lctx) + +private def indexedVecInnerCandidateTrace : + Lean4Lean.AddInductive.CandidateExprTrace + indexedVecParamCandidateContext + (indexedVecInnerKernel.instantiate1 + indexedVecFamilyCandidateContext.freshExpr) := + .forallE indexedVecParamCandidateContext + (indexedVecInnerKernel.instantiate1 + indexedVecFamilyCandidateContext.freshExpr) + (.sort indexedVecInnerInferredLevel) + indexedVecIndexName (.const ``Nat []) indexedVecTerminalKernel + .default indexedVecParamCandidateFresh indexedVecIndexAnnotations + indexedVecIndexAnnotationsEq + (by + simpa [Lean4Lean.AddInductive.CandidateCheckTypeStep.Valid, + indexedVecParamCandidateContext, + indexedVecFamilyCandidateContext, indexedVecInfo, + ConstantInfo.levelParams, ConstantInfo.toConstantVal, + Lean4Lean.AddInductive.Context.pushLocalDecl, + indexedVecInnerKernel, indexedVecTerminalKernel, + Expr.instantiate1'] using + indexedVecInner_checkTypeM) + (by + simpa [Lean4Lean.AddInductive.CandidateWhnfStep.Valid, + indexedVecParamCandidateContext, + indexedVecFamilyCandidateContext, indexedVecInfo, + ConstantInfo.levelParams, ConstantInfo.toConstantVal, + Lean4Lean.AddInductive.Context.pushLocalDecl, + indexedVecInnerKernel, indexedVecTerminalKernel, + Expr.instantiate1'] using + indexedVecInner_whnfM) + indexedVecIndexDomainCandidateTrace indexedVecTerminalCandidateTrace + +private def indexedVecFamilyCandidateTrace : + Lean4Lean.AddInductive.CandidateExprTrace + indexedVecFamilyCandidateContext indexedVecInfo.type := + .forallE indexedVecFamilyCandidateContext indexedVecInfo.type + (.sort indexedVecFamilyInferredLevel) + indexedVecParamName indexedVecTerminalKernel indexedVecInnerKernel + .default indexedVecFamilyCandidateFresh indexedVecParamAnnotations + indexedVecParamAnnotationsEq + indexedVecFamily_checkTypeM + (by + change Lean4Lean.TypeChecker.M.run + indexedVecFamilyCandidateContext.env + indexedVecFamilyCandidateContext.safety + indexedVecFamilyCandidateContext.lctx + indexedVecFamilyCandidateContext.lparams + indexedVecFamilyCandidateContext.fuel + (Lean4Lean.TypeChecker.whnf indexedVecInfo.type) = + .ok indexedVecInfo.type + exact indexedVecFamily_whnfM) + indexedVecParamDomainCandidateTrace indexedVecInnerCandidateTrace + +def indexedVecFamilyCandidate : + Lean4Lean.AddInductive.CandidateExpr indexedVecInfo.type := + ⟨indexedVecFamilyCandidateContext, indexedVecFamilyCandidateTrace⟩ + +theorem indexedVecFamilyCandidate_view_eq : + indexedVecFamilyCandidate.view = indexedVecInfo.type := by + have habstract (context : Lean4Lean.AddInductive.Context) (e : Expr) : + e.abstract #[context.freshExpr] = + Expr.abstract1 context.freshFVarId e := by + rw [show #[context.freshExpr] = + ⟨[context.freshFVarId].map Expr.fvar⟩ by rfl] + simp only [Expr.abstract_eq, Expr.abstractList] + simp only [indexedVecFamilyCandidate, + Lean4Lean.AddInductive.CandidateExpr.view, + indexedVecFamilyCandidateTrace, + indexedVecInnerCandidateTrace, indexedVecParamDomainCandidateTrace, + indexedVecIndexDomainCandidateTrace, indexedVecTerminalCandidateTrace, + Lean4Lean.AddInductive.CandidateExprTrace.view] + rw [habstract, habstract] + simp [Expr.abstract1, indexedVecTerminalKernel, + indexedVecFamilyCandidateContext, + Lean4Lean.AddInductive.Context.pushLocalDecl, + Lean4Lean.AddInductive.Context.freshFVarId, + NameGenerator.next, NameGenerator.curr, + indexedVecInfo, ConstantInfo.type, ConstantInfo.toConstantVal] + constructor <;> rfl + +/-- Every retained family-type candidate node preserves its kernel source. +This is the structural premise used by the semantic spine interpreter; it is +stronger than the root `view` equality because it covers both Pi domains and +the instantiated body under their exact candidate contexts. -/ +theorem indexedVecFamilyCandidate_identity : + Lean4Lean.TypeChecker.CandidateExprIdentity + indexedVecFamilyCandidate.trace := by + change Lean4Lean.TypeChecker.CandidateExprIdentity + indexedVecFamilyCandidateTrace + unfold indexedVecFamilyCandidateTrace + refine .forallE (name := indexedVecParamName) (binderInfo := .default) + (body := indexedVecInnerKernel) + (annotations := indexedVecParamAnnotations) + indexedVecParamDomainCandidateTrace indexedVecInnerCandidateTrace + ?_ rfl (.terminal rfl) ?_ + · rfl + · unfold indexedVecInnerCandidateTrace + refine .forallE (name := indexedVecIndexName) (binderInfo := .default) + (body := indexedVecTerminalKernel) + (annotations := indexedVecIndexAnnotations) + indexedVecIndexDomainCandidateTrace indexedVecTerminalCandidateTrace + ?_ rfl (.terminal rfl) ?_ + · simpa only [Expr.instantiate1_eq, indexedVecInnerKernel, + indexedVecTerminalKernel] using + indexedVecInnerKernel_instantiate1 + indexedVecFamilyCandidateContext.freshExpr + · exact .terminal (by + simpa only [Expr.instantiate1_eq] using + (indexedVecTerminalKernel_instantiate1 + indexedVecParamCandidateContext.freshExpr).symm) + +private theorem indexedVecParamDomainCandidateTrace_loop (fuel : Nat) : + Lean4Lean.AddInductive.buildCandidateExpr.loop + indexedVecFamilyCandidateContext indexedVecTerminalKernel + (fuel + 1) = .ok indexedVecParamDomainCandidateTrace := by + simpa only [indexedVecParamDomainCandidateTrace] using + Lean4Lean.AddInductive.buildCandidateExpr_loop_of_whnf_nonForall + indexedVecFamilyCandidateContext indexedVecTerminalKernel + (.sort (.succ (.succ (.param `u)))) indexedVecTerminalKernel fuel + indexedVecParamDomainCandidateTrace.rootCheck.valid + indexedVecParamDomainCandidateTrace.rootWhnf_valid rfl + +private theorem indexedVecIndexDomainCandidateTrace_loop (fuel : Nat) : + Lean4Lean.AddInductive.buildCandidateExpr.loop + indexedVecParamCandidateContext (.const ``Nat []) (fuel + 1) = + .ok indexedVecIndexDomainCandidateTrace := by + simpa only [indexedVecIndexDomainCandidateTrace] using + Lean4Lean.AddInductive.buildCandidateExpr_loop_of_whnf_nonForall + indexedVecParamCandidateContext (.const ``Nat []) + (.sort (.succ .zero)) (.const ``Nat []) fuel + indexedVecIndexDomainCandidateTrace.rootCheck.valid + indexedVecIndexDomainCandidateTrace.rootWhnf_valid rfl + +private theorem indexedVecTerminalCandidateTrace_loop (fuel : Nat) : + Lean4Lean.AddInductive.buildCandidateExpr.loop + indexedVecIndexCandidateContext + (indexedVecTerminalKernel.instantiate1 + indexedVecParamCandidateContext.freshExpr) + (fuel + 1) = .ok indexedVecTerminalCandidateTrace := by + simpa only [indexedVecTerminalCandidateTrace] using + Lean4Lean.AddInductive.buildCandidateExpr_loop_of_whnf_nonForall + indexedVecIndexCandidateContext + (indexedVecTerminalKernel.instantiate1 + indexedVecParamCandidateContext.freshExpr) + (.sort (.succ (.succ (.param `u)))) indexedVecTerminalKernel fuel + indexedVecTerminalCandidateTrace.rootCheck.valid + indexedVecTerminalCandidateTrace.rootWhnf_valid rfl + +private theorem indexedVecInnerCandidateTrace_loop : + Lean4Lean.AddInductive.buildCandidateExpr.loop + indexedVecParamCandidateContext + (indexedVecInnerKernel.instantiate1 + indexedVecFamilyCandidateContext.freshExpr) 999 = + .ok indexedVecInnerCandidateTrace := by + rw [show 999 = 998 + 1 by rfl] + simpa only [indexedVecInnerCandidateTrace, + indexedVecIndexCandidateContext] using + (Lean4Lean.AddInductive.buildCandidateExpr_loop_of_whnf_forall + (context := indexedVecParamCandidateContext) + (e := indexedVecInnerKernel.instantiate1 + indexedVecFamilyCandidateContext.freshExpr) + (inferred := .sort indexedVecInnerInferredLevel) + (fuel := 998) (name := indexedVecIndexName) + (domain := .const ``Nat []) (body := indexedVecTerminalKernel) + (binderInfo := .default) (hfresh := indexedVecParamCandidateFresh) + (annotations := indexedVecIndexAnnotations) + (hannotations := indexedVecIndexAnnotations_build) + (hannotationsEq := indexedVecIndexAnnotationsEq) + (hcheck := indexedVecInnerCandidateTrace.rootCheck.valid) + (hrun := indexedVecInnerCandidateTrace.rootWhnf_valid) + (domainCandidate := indexedVecIndexDomainCandidateTrace) + (bodyCandidate := indexedVecTerminalCandidateTrace) + (hdomain := by + simpa using indexedVecIndexDomainCandidateTrace_loop 997) + (hbody := by + simpa [indexedVecIndexCandidateContext, + indexedVecIndexAnnotations] using + indexedVecTerminalCandidateTrace_loop 997)) + +private theorem indexedVecFamilyCandidateTrace_loop : + Lean4Lean.AddInductive.buildCandidateExpr.loop + indexedVecFamilyCandidateContext indexedVecInfo.type + indexedVecFamilyCandidateContext.fuel.inductiveFuel = + .ok indexedVecFamilyCandidateTrace := by + change Lean4Lean.AddInductive.buildCandidateExpr.loop + indexedVecFamilyCandidateContext indexedVecInfo.type (999 + 1) = _ + simpa only [indexedVecFamilyCandidateTrace, + indexedVecParamCandidateContext] using + (Lean4Lean.AddInductive.buildCandidateExpr_loop_of_whnf_forall + (context := indexedVecFamilyCandidateContext) + (e := indexedVecInfo.type) + (inferred := .sort indexedVecFamilyInferredLevel) + (fuel := 999) (name := indexedVecParamName) + (domain := indexedVecTerminalKernel) (body := indexedVecInnerKernel) + (binderInfo := .default) (hfresh := indexedVecFamilyCandidateFresh) + (annotations := indexedVecParamAnnotations) + (hannotations := indexedVecParamAnnotations_build) + (hannotationsEq := indexedVecParamAnnotationsEq) + (hcheck := indexedVecFamilyCandidateTrace.rootCheck.valid) + (hrun := indexedVecFamilyCandidateTrace.rootWhnf_valid) + (domainCandidate := indexedVecParamDomainCandidateTrace) + (bodyCandidate := indexedVecInnerCandidateTrace) + (hdomain := by + simpa using indexedVecParamDomainCandidateTrace_loop 998) + (hbody := by + simpa [indexedVecParamCandidateContext, + indexedVecParamAnnotations, indexedVecTerminalKernel] using + indexedVecInnerCandidateTrace_loop)) + +/-- The executable candidate traversal preserves the real IndexedVec family +telescope and classifies its first binder as a parameter and its second as an +index in the subsequent family-validation pass. -/ +theorem indexedVecFamily_candidateTrace : + Lean4Lean.AddInductive.buildCandidateExpr indexedVecInfo.type + indexedVecFamilyCandidateContext = .ok indexedVecFamilyCandidate := by + unfold Lean4Lean.AddInductive.buildCandidateExpr + simp only [readThe, MonadReaderOf.read, ReaderT.read, + ReaderT.bind, Bind.bind, ReaderT.pure, Pure.pure, + Except.bind, Except.pure] + rw [indexedVecFamilyCandidateTrace_loop] + rfl + +/-- The executable IndexedVec family candidate retains its parameter and +index binders in order. -/ +theorem indexedVecFamilyCandidate_spineLength : + indexedVecFamilyCandidate.trace.spineLength = 2 := by + rfl + +theorem indexedVecFamilyCandidate_validationAnnotations : + indexedVecFamilyCandidate.trace.validationAnnotations := by + exact ⟨indexedVecParamAnnotations_match, + indexedVecIndexAnnotations_match, trivial⟩ + +theorem indexedVecFamilyCandidate_terminalResult : + indexedVecFamilyCandidate.trace.terminalResult = + .sort (.succ (.param `u)) := by + rfl + +def indexedVecKernelNil : Constructor where + name := indexedVecNilInfo.name + type := indexedVecNilInfo.type + +def indexedVecKernelCons : Constructor where + name := indexedVecConsInfo.name + type := indexedVecConsInfo.type + +def indexedVecKernelType : InductiveType where + name := indexedVecInfo.name + type := indexedVecInfo.type + ctors := [indexedVecKernelNil, indexedVecKernelCons] + +def indexedVecCandidateInductiveStats : + Lean4Lean.AddInductive.InductiveStats := + indexedVecFamilyCandidate.trace.singletonCandidateInductiveStats + indexedVecKernelType 1 (.succ (.param `u)) + +private theorem indexedVecFamily_data_hasExprMVar_false : + indexedVecInfo.type.data.hasExprMVar = false := by + change indexedVecInfo.type.hasExprMVar = false + rw [Expr.hasExprMVar_eq] + rfl + +private theorem indexedVecFamily_data_hasLevelMVar_false : + indexedVecInfo.type.data.hasLevelMVar = false := by + change indexedVecInfo.type.hasLevelMVar = false + rw [Expr.hasLevelMVar_eq] + simp [indexedVecInfo, ConstantInfo.type, ConstantInfo.toConstantVal, + Expr.hasLevelMVar', Level.hasMVar_eq, Level.hasMVar'] + +private theorem indexedVecFamily_data_hasFVar_false : + indexedVecInfo.type.data.hasFVar = false := by + change indexedVecInfo.type.hasFVar = false + rw [Expr.hasFVar_eq] + rfl + +private theorem indexedVecFamily_hasMVar_false : + indexedVecInfo.type.hasMVar = false := by + change (indexedVecInfo.type.data.hasExprMVar || + indexedVecInfo.type.data.hasLevelMVar) = false + rw [indexedVecFamily_data_hasExprMVar_false, + indexedVecFamily_data_hasLevelMVar_false] + rfl + +private theorem indexedVecFamily_hasFVar_false : + indexedVecInfo.type.hasFVar = false := by + exact indexedVecFamily_data_hasFVar_false + +private theorem indexedVecFamily_closed : + indexedVecFamilyCandidateContext.env.checkNoMVarNoFVar + indexedVecKernelType.name indexedVecKernelType.type = .ok () := by + unfold Kernel.Environment.checkNoMVarNoFVar + Kernel.Environment.checkNoMVar Kernel.Environment.checkNoFVar + rw [show indexedVecKernelType.type.hasMVar = false by + simpa [indexedVecKernelType] using indexedVecFamily_hasMVar_false] + rw [show indexedVecKernelType.type.hasFVar = false by + simpa [indexedVecKernelType] using indexedVecFamily_hasFVar_false] + rfl + +private theorem indexedVecTerminal_ensureSortM : + Lean4Lean.TypeChecker.M.run + indexedVecFamilyCandidate.trace.terminalContext.env + indexedVecFamilyCandidate.trace.terminalContext.safety + indexedVecFamilyCandidate.trace.terminalContext.lctx + indexedVecFamilyCandidate.trace.terminalContext.lparams + indexedVecFamilyCandidate.trace.terminalContext.fuel + (Lean4Lean.TypeChecker.ensureSort + (.sort (.succ (.param `u)))) = + .ok (.sort (.succ (.param `u))) := by + rfl + +/-- The real IndexedVec family telescope drives the complete singleton +family-validation pass with one parameter and one index. -/ +theorem indexedVec_checkInductiveTypes + (k : Lean4Lean.AddInductive.InductiveStats → + Lean4Lean.AddInductive.M α) : + Lean4Lean.AddInductive.checkInductiveTypes 1 + #[indexedVecKernelType] k indexedVecFamilyCandidateContext = + k indexedVecCandidateInductiveStats + indexedVecFamilyCandidate.trace.terminalContext := by + change Lean4Lean.AddInductive.checkInductiveTypes 1 + #[indexedVecKernelType] k indexedVecFamilyCandidate.context = + k indexedVecCandidateInductiveStats + indexedVecFamilyCandidate.trace.terminalContext + exact + Lean4Lean.AddInductive.CandidateExprTrace.checkInductiveTypes_singleton_of_candidate + (indType := indexedVecKernelType) + (candidate := indexedVecFamilyCandidate.trace) + (nparams := 1) (resultLevel := .succ (.param `u)) (k := k) + indexedVecFamily_closed (by decide) (by decide) + ⟨indexedVecParamAnnotations_match, + indexedVecIndexAnnotations_match, trivial⟩ + rfl indexedVecTerminal_ensureSortM + +theorem indexedVecCandidateInductiveStats_nindices : + indexedVecCandidateInductiveStats.nindices = #[1] := by + rfl + +theorem indexedVecCandidateInductiveStats_params : + indexedVecCandidateInductiveStats.params = + #[indexedVecFamilyCandidateContext.freshExpr] := by + rfl + +theorem indexedVecCandidateInductiveStats_resultLevel : + indexedVecCandidateInductiveStats.resultLevel = + .succ (.param `u) := by + rfl + +theorem indexedVecCandidateInductiveStats_indConsts : + indexedVecCandidateInductiveStats.indConsts = + #[.const ``IndexedVec [.param `u]] := by + rfl + +/-- +info: 'Lean4Lean.InductiveReplayFixtures.candidateIsDefEqSelfValid' depends on axioms: [propext, + Classical.choice, + Quot.sound, + Expr.eqv_eq, + Level.instLawfulBEqLevel, + Syntax.structEq_eq] +-/ +#guard_msgs in +#print axioms candidateIsDefEqSelfValid + +/-- +info: 'Lean4Lean.InductiveReplayFixtures.indexedVecFamily_candidateTrace' depends on axioms: [propext, + sorryAx, + Classical.choice, + Quot.sound, + Expr.eqv_eq, + Expr.instantiate1_eq, + Expr.instantiateRev_eq, + Expr.instantiate_eq, + Expr.looseBVarRange_eq, + Expr.mkAppData_eq, + Expr.mkData_eq, + Expr.replace_eq, + Level.hasParam_eq, + Level.instLawfulBEqLevel, + PersistentArray.toList'_push, + PersistentHashMap.findAux_isSome, + Syntax.structEq_eq, + PersistentHashMap.WF.find?_eq, + PersistentHashMap.WF.toList'_insert] +-/ +#guard_msgs in +#print axioms indexedVecFamily_candidateTrace + +/-- +info: 'Lean4Lean.InductiveReplayFixtures.indexedVec_checkInductiveTypes' depends on axioms: [propext, + sorryAx, + Classical.choice, + Quot.sound, + Expr.eqv_eq, + Expr.instantiate1_eq, + Expr.instantiateRev_eq, + Expr.instantiate_eq, + Expr.looseBVarRange_eq, + Expr.mkAppData_eq, + Expr.mkData_eq, + Expr.replace_eq, + Level.hasMVar_eq, + Level.hasParam_eq, + Level.instLawfulBEqLevel, + PersistentArray.toList'_push, + PersistentHashMap.findAux_isSome, + Syntax.structEq_eq, + PersistentHashMap.WF.find?_eq, + PersistentHashMap.WF.toList'_insert] +-/ +#guard_msgs in +#print axioms indexedVec_checkInductiveTypes + +/-- +info: 'Lean4Lean.InductiveReplayFixtures.indexedVecCandidateInductiveStats_nindices' depends on axioms: [propext, + sorryAx, + Classical.choice, + Quot.sound, + Expr.eqv_eq, + Expr.instantiate1_eq, + Expr.instantiateRev_eq, + Expr.instantiate_eq, + Expr.looseBVarRange_eq, + Expr.mkAppData_eq, + Expr.mkData_eq, + Expr.replace_eq, + Level.hasParam_eq, + Level.instLawfulBEqLevel, + PersistentArray.toList'_push, + PersistentHashMap.findAux_isSome, + Syntax.structEq_eq, + PersistentHashMap.WF.find?_eq, + PersistentHashMap.WF.toList'_insert] +-/ +#guard_msgs in +#print axioms indexedVecCandidateInductiveStats_nindices + +/-- +info: 'Lean4Lean.InductiveReplayFixtures.indexedVecCandidateInductiveStats_params' depends on axioms: [propext, + sorryAx, + Classical.choice, + Quot.sound, + Expr.eqv_eq, + Expr.instantiate1_eq, + Expr.instantiateRev_eq, + Expr.instantiate_eq, + Expr.looseBVarRange_eq, + Expr.mkAppData_eq, + Expr.mkData_eq, + Expr.replace_eq, + Level.hasParam_eq, + Level.instLawfulBEqLevel, + PersistentArray.toList'_push, + PersistentHashMap.findAux_isSome, + Syntax.structEq_eq, + PersistentHashMap.WF.find?_eq, + PersistentHashMap.WF.toList'_insert] +-/ +#guard_msgs in +#print axioms indexedVecCandidateInductiveStats_params + +end Lean4Lean.InductiveReplayFixtures diff --git a/Lean4Lean/Verify/Environment/IndexedVecConsReplay.lean b/Lean4Lean/Verify/Environment/IndexedVecConsReplay.lean new file mode 100644 index 00000000..a5b06902 --- /dev/null +++ b/Lean4Lean/Verify/Environment/IndexedVecConsReplay.lean @@ -0,0 +1,2933 @@ +import Lean4Lean.Verify.Environment.IndexedVecConstructors + +namespace Lean4Lean.InductiveReplayFixtures +open Lean Meta +open Lean4Lean.InductiveFixtures + +namespace IndexedVecConsReplay + + + + + + +def replayInsert (state : TypeChecker.State) (e type : Expr) : + TypeChecker.State := + { state with inferTypeC := state.inferTypeC.insert e type } + +open private mkLevelIMaxCore mkLevelMaxCore from Lean.Level in +@[simp] theorem replayMkLevelIMaxSuccParamSelf : + mkLevelIMax' (.succ (.param `u)) (.succ (.param `u)) = + .succ (.param `u) := by + simp [mkLevelIMax', mkLevelIMaxCore, mkLevelMax', mkLevelMaxCore] + +def replayFirstApp (alpha : Expr) : Expr := + .app (.const ``IndexedVec [.param `u]) alpha + +@[simp] theorem replayAppBeqFVar (fn arg : Expr) (id : FVarId) : + ((.app fn arg : Expr) == .fvar id) = false := by + change Expr.eqv (.app fn arg) (.fvar id) = false + rw [Expr.eqv_eq] + rfl + +@[simp] theorem replayFVarBeqApp (id : FVarId) (fn arg : Expr) : + ((.fvar id : Expr) == .app fn arg) = false := by + change Expr.eqv (.fvar id) (.app fn arg) = false + rw [Expr.eqv_eq] + rfl + +@[simp] theorem replayConstBeqApp + (name : Name) (levels : List Level) (fn arg : Expr) : + ((.const name levels : Expr) == .app fn arg) = false := by + change Expr.eqv (.const name levels) (.app fn arg) = false + rw [Expr.eqv_eq] + rfl + +@[simp] theorem replayAppBeqConst + (fn arg : Expr) (name : Name) (levels : List Level) : + ((.app fn arg : Expr) == .const name levels) = false := by + change Expr.eqv (.app fn arg) (.const name levels) = false + rw [Expr.eqv_eq] + rfl + +@[simp] theorem replayIndexedVecConstBeqSucc : + ((.const ``IndexedVec [.param `u] : Expr) == + .const ``Nat.succ []) = false := by + change Expr.eqv (.const ``IndexedVec [.param `u]) + (.const ``Nat.succ []) = false + rw [Expr.eqv_eq] + simp [Expr.eqv'] + +@[simp] theorem replayAlphaBeqN : + ((consAlphaExpr : Expr) == consNExpr) = false := by + change Expr.eqv consAlphaExpr consNExpr = false + rw [Expr.eqv_eq] + simp [Expr.eqv', consAlphaExpr, consNExpr, consAlphaId, consNId, + consAlphaContext, consRootContext, ctorContext, + AddInductive.Context.pushLocalDecl, + AddInductive.Context.freshExpr, + AddInductive.Context.freshFVarId, + NameGenerator.next, NameGenerator.curr] + +@[simp] theorem replayAlphaIdBeqNId : + ((.fvar consAlphaId : Expr) == .fvar consNId) = false := by + simpa using replayAlphaBeqN + +theorem replayInferFirstAppFVarCore + (fuel : Nat) (lctx : LocalContext) (state : TypeChecker.State) + (id : FVarId) + (hfamily : state.inferTypeC[ + (.const ``IndexedVec [.param `u] : Expr)]? = none) + (halpha : (replayInsert state + (.const ``IndexedVec [.param `u]) indexedVecInfo.type).inferTypeC[ + (.fvar id : Expr)]? = none) + (happ : state.inferTypeC[replayFirstApp (.fvar id)]? = none) + (hfind : lctx.find? id = some (.cdecl index id name + (.sort (.succ (.param `u))) bi kind)) : + TypeChecker.Inner.inferType' (replayFirstApp (.fvar id)) false + (TypeChecker.Methods.withFuel fuel) (tcContext lctx) state = + .ok (vecFamilyTail, + replayInsert + (replayInsert + (replayInsert state + (.const ``IndexedVec [.param `u]) indexedVecInfo.type) + (.fvar id) (.sort (.succ (.param `u)))) + (replayFirstApp (.fvar id)) vecFamilyTail) := by + have hfamilyRun := inferTypeFamilyCore fuel lctx state hfamily + have halphaRun := inferTypeFVarCore fuel lctx + (replayInsert state (.const ``IndexedVec [.param `u]) indexedVecInfo.type) + id (.sort (.succ (.param `u))) halpha hfind + have happRun := inferAppCoreOf fuel (tcContext lctx) + state + (replayInsert state (.const ``IndexedVec [.param `u]) indexedVecInfo.type) + (replayInsert + (replayInsert state (.const ``IndexedVec [.param `u]) indexedVecInfo.type) + (.fvar id) (.sort (.succ (.param `u)))) + (.const ``IndexedVec [.param `u]) (.fvar id) + (.sort (.succ (.param `u))) vecFamilyTail `α .default + (by simp [Expr.hasLooseBVars, Expr.looseBVarRange']) + happ + (by simpa [replayInsert, indexedVecInfoTypeShape] using hfamilyRun) + (by simpa [replayInsert] using halphaRun) + (by rfl) + simpa [replayInsert, replayFirstApp, vecFamilyTail, + Expr.instantiate1'] using happRun + +def replaySuccApp (n : Expr) : Expr := + .app (.const ``Nat.succ []) n + +@[simp] theorem replayFirstAppBeqSuccApp (alpha n : Expr) : + (replayFirstApp alpha == replaySuccApp n) = false := by + change Expr.eqv (replayFirstApp alpha) (replaySuccApp n) = false + rw [Expr.eqv_eq] + simp [Expr.eqv', replayFirstApp, replaySuccApp] + +@[simp] theorem replayFirstAppBeqSuccLiteral (alpha n : Expr) : + (replayFirstApp alpha == .app (.const ``Nat.succ []) n) = false := by + simpa [replaySuccApp] using replayFirstAppBeqSuccApp alpha n + +theorem replayInferSuccFVarCore + (fuel : Nat) (lctx : LocalContext) (state : TypeChecker.State) + (id : FVarId) + (hsucc : state.inferTypeC[(.const ``Nat.succ [] : Expr)]? = none) + (hn : (replayInsert state (.const ``Nat.succ []) + (.forallE `n (.const ``Nat []) (.const ``Nat []) .default)).inferTypeC[ + (.fvar id : Expr)]? = none) + (happ : state.inferTypeC[replaySuccApp (.fvar id)]? = none) + (hfind : lctx.find? id = some (.cdecl index id name + (.const ``Nat []) bi kind)) : + TypeChecker.Inner.inferType' (replaySuccApp (.fvar id)) false + (TypeChecker.Methods.withFuel fuel) (tcContext lctx) state = + .ok (.const ``Nat [], + replayInsert + (replayInsert + (replayInsert state (.const ``Nat.succ []) + (.forallE `n (.const ``Nat []) (.const ``Nat []) .default)) + (.fvar id) (.const ``Nat [])) + (replaySuccApp (.fvar id)) (.const ``Nat [])) := by + have hsuccRun := inferTypeSuccCore fuel lctx state hsucc + have hnRun := inferTypeFVarCore fuel lctx + (replayInsert state (.const ``Nat.succ []) + (.forallE `n (.const ``Nat []) (.const ``Nat []) .default)) + id (.const ``Nat []) hn hfind + have happRun := inferAppCoreOf fuel (tcContext lctx) + state + (replayInsert state (.const ``Nat.succ []) + (.forallE `n (.const ``Nat []) (.const ``Nat []) .default)) + (replayInsert + (replayInsert state (.const ``Nat.succ []) + (.forallE `n (.const ``Nat []) (.const ``Nat []) .default)) + (.fvar id) (.const ``Nat [])) + (.const ``Nat.succ []) (.fvar id) (.const ``Nat []) + (.const ``Nat []) `n .default + (by simp [Expr.hasLooseBVars, Expr.looseBVarRange']) + happ + (by simpa [replayInsert] using hsuccRun) + (by simpa [replayInsert] using hnRun) + (by rfl) + simpa [replayInsert, replaySuccApp, Expr.instantiate1_eq, + Expr.instantiate1'] using happRun + +theorem replayInferIndexedVecAppCore + (fuel : Nat) (lctx : LocalContext) + (state stateFn stateArg : TypeChecker.State) + (alpha indexExpr : Expr) + (hclosed : (ctorIndexedVecApp alpha indexExpr).hasLooseBVars = false) + (hcache : state.inferTypeC[ctorIndexedVecApp alpha indexExpr]? = none) + (hfn : TypeChecker.Inner.inferType' (replayFirstApp alpha) false + (TypeChecker.Methods.withFuel fuel) (tcContext lctx) state = + .ok (vecFamilyTail, stateFn)) + (harg : TypeChecker.Inner.inferType' indexExpr false + (TypeChecker.Methods.withFuel fuel) (tcContext lctx) stateFn = + .ok (.const ``Nat [], stateArg)) + (heager : indexExpr.isAppOfArity ``eagerReduce 2 = false) : + TypeChecker.Inner.inferType' (ctorIndexedVecApp alpha indexExpr) false + (TypeChecker.Methods.withFuel fuel) (tcContext lctx) state = + .ok (.sort (.succ (.param `u)), + replayInsert stateArg (ctorIndexedVecApp alpha indexExpr) + (.sort (.succ (.param `u)))) := by + have h := inferAppCoreOf fuel (tcContext lctx) state stateFn stateArg + (replayFirstApp alpha) indexExpr (.const ``Nat []) + (.sort (.succ (.param `u))) vecIndexName .default + hclosed hcache + (by simpa [replayFirstApp, vecFamilyTail] using hfn) harg heager + simpa [replayInsert, ctorIndexedVecApp, replayFirstApp, + vecFamilyTail, Expr.instantiate1_eq, Expr.instantiate1'] using h + +theorem replayInferTypeCachedCore + (fuel : Nat) (lctx : LocalContext) (state : TypeChecker.State) + (e type : Expr) + (hclosed : e.hasLooseBVars = false) + (hcache : state.inferTypeC[e]? = some type) : + TypeChecker.Inner.inferType' e false + (TypeChecker.Methods.withFuel fuel) (tcContext lctx) state = + .ok (type, state) := by + unfold TypeChecker.Inner.inferType' + simp [hclosed, hcache] + +theorem replayInferFirstAppAlphaCachedCore + (fuel : Nat) (lctx : LocalContext) (state : TypeChecker.State) + (alphaId : FVarId) + (halpha : state.inferTypeC[(.fvar alphaId : Expr)]? = + some (.sort (.succ (.param `u)))) + (hfamily : state.inferTypeC[ + (.const ``IndexedVec [.param `u] : Expr)]? = none) + (happ : state.inferTypeC[replayFirstApp (.fvar alphaId)]? = none) : + TypeChecker.Inner.inferType' (replayFirstApp (.fvar alphaId)) false + (TypeChecker.Methods.withFuel fuel) (tcContext lctx) state = + .ok (vecFamilyTail, + replayInsert + (replayInsert state + (.const ``IndexedVec [.param `u]) indexedVecInfo.type) + (replayFirstApp (.fvar alphaId)) vecFamilyTail) := by + let familyState := replayInsert state + (.const ``IndexedVec [.param `u]) indexedVecInfo.type + have hfamilyRun := inferTypeFamilyCore fuel lctx state hfamily + have halphaCache : familyState.inferTypeC[(.fvar alphaId : Expr)]? = + some (.sort (.succ (.param `u))) := by + simp only [familyState, replayInsert, Std.HashMap.getElem?_insert] + rw [constBeqFVar] + exact halpha + have halphaRun := replayInferTypeCachedCore fuel lctx familyState + (.fvar alphaId) (.sort (.succ (.param `u))) + (by simp [Expr.hasLooseBVars, Expr.looseBVarRange']) halphaCache + have hrun := inferAppCoreOf fuel (tcContext lctx) + state familyState familyState + (.const ``IndexedVec [.param `u]) (.fvar alphaId) + (.sort (.succ (.param `u))) vecFamilyTail `α .default + (by simp [Expr.hasLooseBVars, Expr.looseBVarRange']) + happ + (by simpa [familyState, replayInsert, indexedVecInfoTypeShape] using + hfamilyRun) + halphaRun (by rfl) + simpa [familyState, replayInsert, replayFirstApp, vecFamilyTail, + Expr.instantiate1'] using hrun + +theorem replayInferTailDomainAlphaCachedCore + (fuel : Nat) (lctx : LocalContext) (state : TypeChecker.State) + (alphaId nId : FVarId) + (halpha : state.inferTypeC[(.fvar alphaId : Expr)]? = + some (.sort (.succ (.param `u)))) + (hfamily : state.inferTypeC[ + (.const ``IndexedVec [.param `u] : Expr)]? = none) + (hfirstApp : state.inferTypeC[ + replayFirstApp (.fvar alphaId)]? = none) + (hn : (replayInsert + (replayInsert state (.const ``IndexedVec [.param `u]) + indexedVecInfo.type) + (replayFirstApp (.fvar alphaId)) vecFamilyTail).inferTypeC[ + (.fvar nId : Expr)]? = none) + (htail : state.inferTypeC[ + ctorIndexedVecApp (.fvar alphaId) (.fvar nId)]? = none) + (hfind : lctx.find? nId = some (.cdecl index nId name + (.const ``Nat []) bi kind)) : + TypeChecker.Inner.inferType' + (ctorIndexedVecApp (.fvar alphaId) (.fvar nId)) false + (TypeChecker.Methods.withFuel fuel) (tcContext lctx) state = + .ok (.sort (.succ (.param `u)), + replayInsert + (replayInsert + (replayInsert + (replayInsert state (.const ``IndexedVec [.param `u]) + indexedVecInfo.type) + (replayFirstApp (.fvar alphaId)) vecFamilyTail) + (.fvar nId) (.const ``Nat [])) + (ctorIndexedVecApp (.fvar alphaId) (.fvar nId)) + (.sort (.succ (.param `u)))) := by + let firstState := replayInsert + (replayInsert state (.const ``IndexedVec [.param `u]) + indexedVecInfo.type) + (replayFirstApp (.fvar alphaId)) vecFamilyTail + let nState := replayInsert firstState (.fvar nId) (.const ``Nat []) + have hfirstRun := replayInferFirstAppAlphaCachedCore fuel lctx state + alphaId halpha hfamily hfirstApp + have hnRun := inferTypeFVarCore fuel lctx firstState nId + (.const ``Nat []) hn hfind + have hrun := replayInferIndexedVecAppCore fuel lctx state firstState nState + (.fvar alphaId) (.fvar nId) + (by simp [ctorIndexedVecApp, Expr.hasLooseBVars, + Expr.looseBVarRange']) + htail + (by simpa [firstState] using hfirstRun) + (by simpa [firstState, nState, replayInsert] using hnRun) + (by rfl) + simpa [firstState, nState, replayInsert] using hrun + +theorem replayInferSuccFVarCachedCore + (fuel : Nat) (lctx : LocalContext) (state : TypeChecker.State) + (id : FVarId) + (hsucc : state.inferTypeC[(.const ``Nat.succ [] : Expr)]? = none) + (hn : state.inferTypeC[(.fvar id : Expr)]? = some (.const ``Nat [])) + (happ : state.inferTypeC[replaySuccApp (.fvar id)]? = none) : + TypeChecker.Inner.inferType' (replaySuccApp (.fvar id)) false + (TypeChecker.Methods.withFuel fuel) (tcContext lctx) state = + .ok (.const ``Nat [], + replayInsert + (replayInsert state (.const ``Nat.succ []) + (.forallE `n (.const ``Nat []) (.const ``Nat []) .default)) + (replaySuccApp (.fvar id)) (.const ``Nat [])) := by + let succState := replayInsert state (.const ``Nat.succ []) + (.forallE `n (.const ``Nat []) (.const ``Nat []) .default) + have hsuccRun := inferTypeSuccCore fuel lctx state hsucc + have hnCache : succState.inferTypeC[(.fvar id : Expr)]? = + some (.const ``Nat []) := by + simp only [succState, replayInsert, Std.HashMap.getElem?_insert] + rw [constBeqFVar] + exact hn + have hnRun := replayInferTypeCachedCore fuel lctx succState + (.fvar id) (.const ``Nat []) + (by simp [Expr.hasLooseBVars, Expr.looseBVarRange']) hnCache + have happRun := inferAppCoreOf fuel (tcContext lctx) + state succState succState + (.const ``Nat.succ []) (.fvar id) (.const ``Nat []) + (.const ``Nat []) `n .default + (by simp [Expr.hasLooseBVars, Expr.looseBVarRange']) + happ + (by simpa [succState, replayInsert] using hsuccRun) + hnRun (by rfl) + simpa [succState, replayInsert, replaySuccApp, + Expr.instantiate1_eq, Expr.instantiate1'] using happRun + +theorem replayInferIndexedVecSuccFromCacheCore + (fuel : Nat) (lctx : LocalContext) (state : TypeChecker.State) + (alphaId nId : FVarId) + (hfirst : state.inferTypeC[replayFirstApp (.fvar alphaId)]? = + some vecFamilyTail) + (hsucc : state.inferTypeC[(.const ``Nat.succ [] : Expr)]? = none) + (hn : state.inferTypeC[(.fvar nId : Expr)]? = some (.const ``Nat [])) + (hsuccApp : state.inferTypeC[replaySuccApp (.fvar nId)]? = none) + (hresult : state.inferTypeC[ + ctorIndexedVecApp (.fvar alphaId) (replaySuccApp (.fvar nId))]? = none) : + TypeChecker.Inner.inferType' + (ctorIndexedVecApp (.fvar alphaId) (replaySuccApp (.fvar nId))) false + (TypeChecker.Methods.withFuel fuel) (tcContext lctx) state = + .ok (.sort (.succ (.param `u)), + replayInsert + (replayInsert + (replayInsert state (.const ``Nat.succ []) + (.forallE `n (.const ``Nat []) (.const ``Nat []) .default)) + (replaySuccApp (.fvar nId)) (.const ``Nat [])) + (ctorIndexedVecApp (.fvar alphaId) + (replaySuccApp (.fvar nId))) + (.sort (.succ (.param `u)))) := by + let succState := replayInsert state (.const ``Nat.succ []) + (.forallE `n (.const ``Nat []) (.const ``Nat []) .default) + let succAppState := replayInsert succState + (replaySuccApp (.fvar nId)) (.const ``Nat []) + have hfirstRun := replayInferTypeCachedCore fuel lctx state + (replayFirstApp (.fvar alphaId)) vecFamilyTail + (by simp [replayFirstApp, Expr.hasLooseBVars, + Expr.looseBVarRange']) hfirst + have hsuccRun := replayInferSuccFVarCachedCore fuel lctx state nId + hsucc hn hsuccApp + have h := replayInferIndexedVecAppCore fuel lctx state state succAppState + (.fvar alphaId) (replaySuccApp (.fvar nId)) + (by simp [ctorIndexedVecApp, replaySuccApp, + Expr.hasLooseBVars, Expr.looseBVarRange']) + hresult hfirstRun + (by simpa [succState, succAppState] using hsuccRun) + (by rfl) + simpa [succState, succAppState, replayInsert] using h + +def consHeadFirstAppState : TypeChecker.State := + replayInsert + (replayInsert + (replayInsert ({} : TypeChecker.State) + (.const ``IndexedVec [.param `u]) indexedVecInfo.type) + consAlphaExpr (.sort (.succ (.param `u)))) + (replayFirstApp consAlphaExpr) vecFamilyTail + +def consHeadNState : TypeChecker.State := + replayInsert consHeadFirstAppState consNExpr (.const ``Nat []) + +def consTailDomainFinalState : TypeChecker.State := + replayInsert consHeadNState consTailDomain + (.sort (.succ (.param `u))) + +theorem replayInferConsHeadFirstApp (fuel : Nat) : + TypeChecker.Inner.inferType' (replayFirstApp consAlphaExpr) false + (TypeChecker.Methods.withFuel fuel) + (tcContext consHeadContext.lctx) ({} : TypeChecker.State) = + .ok (vecFamilyTail, consHeadFirstAppState) := by + simpa [consHeadFirstAppState, consAlphaExprShape] using + (replayInferFirstAppFVarCore fuel consHeadContext.lctx + ({} : TypeChecker.State) consAlphaId + (by simp) + (by simp [replayInsert, Expr.eqv_eq]) + (by simp [replayFirstApp, consAlphaExprShape, + Expr.eqv_eq]) + consAlphaFindInHead) + +theorem replayInferConsHeadN (fuel : Nat) : + TypeChecker.Inner.inferType' consNExpr false + (TypeChecker.Methods.withFuel fuel) + (tcContext consHeadContext.lctx) consHeadFirstAppState = + .ok (.const ``Nat [], consHeadNState) := by + simpa [consHeadNState, consNExprShape, replayInsert] using + (inferTypeFVarCore fuel consHeadContext.lctx + consHeadFirstAppState consNId (.const ``Nat []) + (index := 1) (name := consNName) (bi := .implicit) + (kind := .default) + (by simp [consHeadFirstAppState, replayInsert, + replayFirstApp, replayAlphaBeqN]) + consNFindInHead) + +theorem replayInferConsTailDomainCore (fuel : Nat) : + TypeChecker.Inner.inferType' consTailDomain false + (TypeChecker.Methods.withFuel fuel) + (tcContext consHeadContext.lctx) ({} : TypeChecker.State) = + .ok (.sort (.succ (.param `u)), consTailDomainFinalState) := by + simpa [consTailDomainFinalState, consTailDomain, + ctorIndexedVecApp, replayFirstApp] using + (replayInferIndexedVecAppCore fuel consHeadContext.lctx + ({} : TypeChecker.State) consHeadFirstAppState consHeadNState + consAlphaExpr consNExpr + (by simp [ctorIndexedVecApp, consAlphaExprShape, + consNExprShape, Expr.hasLooseBVars, Expr.looseBVarRange']) + (by simp [ctorIndexedVecApp, consAlphaExprShape, + consNExprShape, Expr.eqv_eq]) + (replayInferConsHeadFirstApp fuel) (replayInferConsHeadN fuel) (by rfl)) + +theorem replayInferConsTailDomain : + TypeChecker.Inner.inferType consTailDomain false + (TypeChecker.Methods.withFuel 10000) + (tcContext consHeadContext.lctx) ({} : TypeChecker.State) = + .ok (.sort (.succ (.param `u)), consTailDomainFinalState) := by + change TypeChecker.Inner.inferType' consTailDomain false + (TypeChecker.Methods.withFuel 9999) + (tcContext consHeadContext.lctx) ({} : TypeChecker.State) = _ + exact replayInferConsTailDomainCore 9999 + +theorem replayConsTailDomainCheckTypeM : + TypeChecker.M.run ctorEnv .safe consHeadContext.lctx [`u] + ({} : FuelConfig) (TypeChecker.checkType consTailDomain) = + .ok (.sort (.succ (.param `u))) := by + change Except.map (fun x : Expr × TypeChecker.State => x.1) + (TypeChecker.Inner.inferType consTailDomain false + (TypeChecker.Methods.withFuel 10000) + (tcContext consHeadContext.lctx) ({} : TypeChecker.State)) = _ + rw [replayInferConsTailDomain] + rfl + +def consTailFirstAppState : TypeChecker.State := + replayInsert + (replayInsert + (replayInsert ({} : TypeChecker.State) + (.const ``IndexedVec [.param `u]) indexedVecInfo.type) + consAlphaExpr (.sort (.succ (.param `u)))) + (replayFirstApp consAlphaExpr) vecFamilyTail + +def consTailSuccState : TypeChecker.State := + replayInsert + (replayInsert + (replayInsert consTailFirstAppState (.const ``Nat.succ []) + (.forallE `n (.const ``Nat []) (.const ``Nat []) .default)) + consNExpr (.const ``Nat [])) + (replaySuccApp consNExpr) (.const ``Nat []) + +def consTerminalFinalState : TypeChecker.State := + replayInsert consTailSuccState consTerminal + (.sort (.succ (.param `u))) + +theorem replayInferConsTailFirstApp : + TypeChecker.Inner.inferType' (replayFirstApp consAlphaExpr) false + (TypeChecker.Methods.withFuel 9999) + (tcContext consTailContext.lctx) ({} : TypeChecker.State) = + .ok (vecFamilyTail, consTailFirstAppState) := by + simpa [consTailFirstAppState, consAlphaExprShape] using + (replayInferFirstAppFVarCore 9999 consTailContext.lctx + ({} : TypeChecker.State) consAlphaId + (by simp) + (by simp [replayInsert, Expr.eqv_eq]) + (by simp [replayFirstApp, Expr.eqv_eq]) + consAlphaFindInTail) + +theorem replayInferConsTailSucc : + TypeChecker.Inner.inferType' (replaySuccApp consNExpr) false + (TypeChecker.Methods.withFuel 9999) + (tcContext consTailContext.lctx) consTailFirstAppState = + .ok (.const ``Nat [], consTailSuccState) := by + simpa [consTailSuccState, consNExprShape] using + (replayInferSuccFVarCore 9999 consTailContext.lctx + consTailFirstAppState consNId + (by simp [consTailFirstAppState, replayInsert, + replayFirstApp, Expr.eqv_eq]) + (by simp [consTailFirstAppState, replayInsert, + replayFirstApp]) + (by simp [consTailFirstAppState, replayInsert, + replaySuccApp, replayFirstAppBeqSuccApp]) + consNFindInTail) + +theorem replayInferConsTerminal : + TypeChecker.Inner.inferType consTerminal false + (TypeChecker.Methods.withFuel 10000) + (tcContext consTailContext.lctx) ({} : TypeChecker.State) = + .ok (.sort (.succ (.param `u)), consTerminalFinalState) := by + change TypeChecker.Inner.inferType' consTerminal false + (TypeChecker.Methods.withFuel 9999) + (tcContext consTailContext.lctx) ({} : TypeChecker.State) = _ + simpa [consTerminalFinalState, consTerminal, + ctorIndexedVecApp, replayFirstApp, replaySuccApp] using + (replayInferIndexedVecAppCore 9999 consTailContext.lctx + ({} : TypeChecker.State) consTailFirstAppState consTailSuccState + consAlphaExpr (replaySuccApp consNExpr) + (by simp [ctorIndexedVecApp, replaySuccApp, + Expr.hasLooseBVars, Expr.looseBVarRange']) + (by simp [ctorIndexedVecApp, replaySuccApp, + Expr.eqv_eq, Expr.eqv']) + replayInferConsTailFirstApp replayInferConsTailSucc + (by rfl)) + +theorem replayConsTerminalCheckTypeM : + TypeChecker.M.run ctorEnv .safe consTailContext.lctx [`u] + ({} : FuelConfig) (TypeChecker.checkType consTerminal) = + .ok (.sort (.succ (.param `u))) := by + change Except.map (fun x : Expr × TypeChecker.State => x.1) + (TypeChecker.Inner.inferType consTerminal false + (TypeChecker.Methods.withFuel 10000) + (tcContext consTailContext.lctx) ({} : TypeChecker.State)) = _ + rw [replayInferConsTerminal] + rfl + +theorem replayConsTailDomainWhnfM : + TypeChecker.M.run ctorEnv .safe consHeadContext.lctx [`u] + ({} : FuelConfig) (TypeChecker.whnf consTailDomain) = + .ok consTailDomain := by + simpa [consTailDomain, ctorIndexedVecApp] using + (ctorIndexedVecWhnfM consHeadContext.lctx consAlphaExpr consNExpr) + +theorem replayConsTerminalWhnfM : + TypeChecker.M.run ctorEnv .safe consTailContext.lctx [`u] + ({} : FuelConfig) (TypeChecker.whnf consTerminal) = + .ok consTerminal := by + simpa [consTerminal, ctorIndexedVecApp, replaySuccApp] using + (ctorIndexedVecWhnfM consTailContext.lctx consAlphaExpr + (replaySuccApp consNExpr)) + +theorem replayConsRootWhnfM : + TypeChecker.M.run ctorEnv .safe {} [`u] ({} : FuelConfig) + (TypeChecker.whnf indexedVecConsInfo.type) = + .ok indexedVecConsInfo.type := by rfl + +theorem replayConsAfterAlphaWhnfM : + TypeChecker.M.run ctorEnv .safe consAlphaContext.lctx [`u] + ({} : FuelConfig) (TypeChecker.whnf consAfterAlpha) = + .ok consAfterAlpha := by rfl + +theorem replayConsAfterNWhnfM : + TypeChecker.M.run ctorEnv .safe consNContext.lctx [`u] + ({} : FuelConfig) (TypeChecker.whnf consAfterN) = + .ok consAfterN := by rfl + +theorem replayConsAfterHeadWhnfM : + TypeChecker.M.run ctorEnv .safe consHeadContext.lctx [`u] + ({} : FuelConfig) (TypeChecker.whnf consAfterHead) = + .ok consAfterHead := by rfl + +def consAfterHeadCheckTailId : FVarId := + ⟨consTailDomainFinalState.ngen.curr⟩ + +def consAfterHeadCheckLctx : LocalContext := + consHeadContext.lctx.mkLocalDecl consAfterHeadCheckTailId + consTailName consTailDomain .default + +def consAfterHeadCheckState : TypeChecker.State := + { consTailDomainFinalState with + ngen := consTailDomainFinalState.ngen.next } + +@[simp] theorem replayTailDomainBeqFirstApp : + (ctorIndexedVecApp (.fvar consAlphaId) (.fvar consNId) == + replayFirstApp (.fvar consAlphaId)) = false := by + change Expr.eqv + (ctorIndexedVecApp (.fvar consAlphaId) (.fvar consNId)) + (replayFirstApp (.fvar consAlphaId)) = false + rw [Expr.eqv_eq] + simp [Expr.eqv', ctorIndexedVecApp, replayFirstApp] + +@[simp] theorem replayTailDomainBeqSuccApp : + (ctorIndexedVecApp (.fvar consAlphaId) (.fvar consNId) == + replaySuccApp (.fvar consNId)) = false := by + change Expr.eqv + (ctorIndexedVecApp (.fvar consAlphaId) (.fvar consNId)) + (replaySuccApp (.fvar consNId)) = false + rw [Expr.eqv_eq] + simp [Expr.eqv', ctorIndexedVecApp, replayFirstApp, replaySuccApp] + +@[simp] theorem replayTailDomainBeqTerminal : + (ctorIndexedVecApp (.fvar consAlphaId) (.fvar consNId) == + ctorIndexedVecApp (.fvar consAlphaId) + (replaySuccApp (.fvar consNId))) = false := by + change Expr.eqv + (ctorIndexedVecApp (.fvar consAlphaId) (.fvar consNId)) + (ctorIndexedVecApp (.fvar consAlphaId) + (replaySuccApp (.fvar consNId))) = false + rw [Expr.eqv_eq] + simp [Expr.eqv', ctorIndexedVecApp, replayFirstApp, replaySuccApp] + +@[simp] theorem replayFirstAppBeqTerminal : + (replayFirstApp (.fvar consAlphaId) == + ctorIndexedVecApp (.fvar consAlphaId) + (replaySuccApp (.fvar consNId))) = false := by + change Expr.eqv (replayFirstApp (.fvar consAlphaId)) + (ctorIndexedVecApp (.fvar consAlphaId) + (replaySuccApp (.fvar consNId))) = false + rw [Expr.eqv_eq] + simp [Expr.eqv', ctorIndexedVecApp, replayFirstApp, replaySuccApp] + +@[simp] theorem replayTailDomainLiteralBeqFirstApp : + (((.const ``IndexedVec [.param `u] : Expr).app (.fvar consAlphaId)).app + (.fvar consNId) == + (.const ``IndexedVec [.param `u] : Expr).app + (.fvar consAlphaId)) = false := by + simpa [ctorIndexedVecApp, replayFirstApp] using + replayTailDomainBeqFirstApp + +@[simp] theorem replayTailDomainLiteralBeqSuccApp : + (((.const ``IndexedVec [.param `u] : Expr).app (.fvar consAlphaId)).app + (.fvar consNId) == + (.const ``Nat.succ [] : Expr).app (.fvar consNId)) = false := by + simpa [ctorIndexedVecApp, replaySuccApp] using + replayTailDomainBeqSuccApp + +@[simp] theorem replayFirstAppLiteralBeqSuccApp : + ((.const ``IndexedVec [.param `u] : Expr).app + (.fvar consAlphaId) == + (.const ``Nat.succ [] : Expr).app (.fvar consNId)) = false := by + simpa only [replayFirstApp, replaySuccApp] using + (replayFirstAppBeqSuccApp (.fvar consAlphaId) (.fvar consNId)) + +@[simp] theorem replayTailDomainLiteralBeqTerminal : + (((.const ``IndexedVec [.param `u] : Expr).app (.fvar consAlphaId)).app + (.fvar consNId) == + ((.const ``IndexedVec [.param `u] : Expr).app + (.fvar consAlphaId)).app + ((.const ``Nat.succ [] : Expr).app (.fvar consNId))) = false := by + simpa [ctorIndexedVecApp, replaySuccApp] using + replayTailDomainBeqTerminal + +@[simp] theorem replayFirstAppLiteralBeqTerminal : + ((.const ``IndexedVec [.param `u] : Expr).app (.fvar consAlphaId) == + ((.const ``IndexedVec [.param `u] : Expr).app + (.fvar consAlphaId)).app + ((.const ``Nat.succ [] : Expr).app (.fvar consNId))) = false := by + simpa [ctorIndexedVecApp, replayFirstApp, replaySuccApp] using + replayFirstAppBeqTerminal + +theorem consAfterHeadCheckFirstCache : + consAfterHeadCheckState.inferTypeC[ + replayFirstApp (.fvar consAlphaId)]? = some vecFamilyTail := by + change consTailDomainFinalState.inferTypeC[ + replayFirstApp (.fvar consAlphaId)]? = some vecFamilyTail + unfold consTailDomainFinalState replayInsert + rw [Std.HashMap.getElem?_insert] + rw [show (consTailDomain == replayFirstApp (.fvar consAlphaId)) = + false by + simpa only [consTailDomain, ctorIndexedVecApp, + consAlphaExprShape, consNExprShape] using + replayTailDomainBeqFirstApp] + simp only [Bool.false_eq_true, if_false] + unfold consHeadNState replayInsert + rw [Std.HashMap.getElem?_insert] + rw [show (consNExpr == replayFirstApp (.fvar consAlphaId)) = false by + simpa [consNExprShape, replayFirstApp] using + (replayFVarBeqApp consNId + (.const ``IndexedVec [.param `u]) (.fvar consAlphaId))] + simp only [Bool.false_eq_true, if_false] + unfold consHeadFirstAppState replayInsert + rw [Std.HashMap.getElem?_insert] + rw [show (replayFirstApp consAlphaExpr == + replayFirstApp (.fvar consAlphaId)) = true by simp] + rfl + +theorem consAfterHeadCheckNCache : + consAfterHeadCheckState.inferTypeC[(.fvar consNId : Expr)]? = + some (.const ``Nat []) := by + change consTailDomainFinalState.inferTypeC[(.fvar consNId : Expr)]? = + some (.const ``Nat []) + unfold consTailDomainFinalState replayInsert + rw [Std.HashMap.getElem?_insert] + rw [show (consTailDomain == (.fvar consNId : Expr)) = false by + simpa only [consTailDomain, consAlphaExprShape, consNExprShape] using + (replayAppBeqFVar + ((.const ``IndexedVec [.param `u] : Expr).app + (.fvar consAlphaId)) (.fvar consNId) consNId)] + simp only [Bool.false_eq_true, if_false] + unfold consHeadNState replayInsert + rw [Std.HashMap.getElem?_insert] + rw [show (consNExpr == (.fvar consNId : Expr)) = true by simp] + rfl + +theorem consAfterHeadCheckSuccMiss : + consAfterHeadCheckState.inferTypeC[(.const ``Nat.succ [] : Expr)]? = + none := by + simp [consAfterHeadCheckState, consTailDomainFinalState, + consHeadNState, consHeadFirstAppState, replayInsert, + consTailDomain, replayFirstApp, Std.HashMap.getElem?_insert, + Expr.eqv_eq, Expr.eqv'] + +theorem consAfterHeadCheckSuccAppMiss : + consAfterHeadCheckState.inferTypeC[ + replaySuccApp (.fvar consNId)]? = none := by + simp [consAfterHeadCheckState, consTailDomainFinalState, + consHeadNState, consHeadFirstAppState, replayInsert, + consTailDomain, replayFirstApp, replaySuccApp, + Std.HashMap.getElem?_insert, Expr.eqv_eq, Expr.eqv'] + +theorem consAfterHeadCheckTerminalMiss : + consAfterHeadCheckState.inferTypeC[ + ctorIndexedVecApp (.fvar consAlphaId) + (replaySuccApp (.fvar consNId))]? = none := by + simp [consAfterHeadCheckState, consTailDomainFinalState, + consHeadNState, consHeadFirstAppState, replayInsert, + consTailDomain, ctorIndexedVecApp, replayFirstApp, replaySuccApp, + Std.HashMap.getElem?_insert, Expr.eqv_eq, Expr.eqv'] + +def consAfterHeadCheckSuccState : TypeChecker.State := + replayInsert consAfterHeadCheckState (.const ``Nat.succ []) + (.forallE `n (.const ``Nat []) (.const ``Nat []) .default) + +def consAfterHeadCheckSuccAppState : TypeChecker.State := + replayInsert consAfterHeadCheckSuccState + (replaySuccApp (.fvar consNId)) (.const ``Nat []) + +def consAfterHeadCheckTerminalState : TypeChecker.State := + replayInsert consAfterHeadCheckSuccAppState + (ctorIndexedVecApp (.fvar consAlphaId) + (replaySuccApp (.fvar consNId))) + (.sort (.succ (.param `u))) + +theorem replayInferConsAfterHeadTerminal : + TypeChecker.Inner.inferType' + (ctorIndexedVecApp (.fvar consAlphaId) + (replaySuccApp (.fvar consNId))) false + (TypeChecker.Methods.withFuel 9998) + (tcContext consAfterHeadCheckLctx) consAfterHeadCheckState = + .ok (.sort (.succ (.param `u)), + consAfterHeadCheckTerminalState) := by + simpa [consAfterHeadCheckSuccState, + consAfterHeadCheckSuccAppState, + consAfterHeadCheckTerminalState] using + (replayInferIndexedVecSuccFromCacheCore 9998 consAfterHeadCheckLctx + consAfterHeadCheckState consAlphaId consNId + consAfterHeadCheckFirstCache consAfterHeadCheckSuccMiss + consAfterHeadCheckNCache consAfterHeadCheckSuccAppMiss + consAfterHeadCheckTerminalMiss) + +theorem replayConsAfterHeadCheckTypeM : + TypeChecker.M.run ctorEnv .safe consHeadContext.lctx [`u] + ({} : FuelConfig) (TypeChecker.checkType consAfterHead) = + .ok (.sort (.succ (.param `u))) := by + change Except.map (fun x : Expr × TypeChecker.State => x.1) + (TypeChecker.Inner.inferType consAfterHead false + (TypeChecker.Methods.withFuel 10000) + (tcContext consHeadContext.lctx) ({} : TypeChecker.State)) = _ + change Except.map (fun x : Expr × TypeChecker.State => x.1) + (TypeChecker.Inner.inferType' consAfterHead false + (TypeChecker.Methods.withFuel 9999) + (tcContext consHeadContext.lctx) ({} : TypeChecker.State)) = _ + unfold consAfterHead consTailDomain TypeChecker.Inner.inferType' + simp [Expr.hasLooseBVars, Expr.looseBVarRange', + TypeChecker.Inner.inferForall, TypeChecker.Inner.inferForall.loop, + TypeChecker.Inner.inferApp, + Bind.bind, ReaderT.bind, StateT.bind, Except.bind] + rw [show TypeChecker.Inner.inferType' + (.app + (.app (.const ``IndexedVec [.param `u]) (.fvar consAlphaId)) + (.fvar consNId)) false + (TypeChecker.Methods.withFuel 9998) + (tcContext consHeadContext.lctx) ({} : TypeChecker.State) = + .ok (.sort (.succ (.param `u)), consTailDomainFinalState) by + simpa [consTailDomain, ctorIndexedVecApp] using + replayInferConsTailDomainCore 9998] + simp only [ensureSortExact] + rw [withLocalDeclEq] + simp [Expr.instantiate1'] + have hterminal : + TypeChecker.Inner.inferType + (((.const ``IndexedVec [.param `u] : Expr).app + (.fvar consAlphaId)).app + ((.const ``Nat.succ [] : Expr).app (.fvar consNId))) false + (TypeChecker.Methods.withFuel 9999) + (tcContext consAfterHeadCheckLctx) consAfterHeadCheckState = + .ok (.sort (.succ (.param `u)), + consAfterHeadCheckTerminalState) := by + change TypeChecker.Inner.inferType' + (((.const ``IndexedVec [.param `u] : Expr).app + (.fvar consAlphaId)).app + ((.const ``Nat.succ [] : Expr).app (.fvar consNId))) false + (TypeChecker.Methods.withFuel 9998) + (tcContext consAfterHeadCheckLctx) consAfterHeadCheckState = _ + simpa [ctorIndexedVecApp, replaySuccApp] using + replayInferConsAfterHeadTerminal + simp only [consAfterHeadCheckLctx, consAfterHeadCheckTailId, + consAfterHeadCheckState, consTailDomain, consAlphaExprShape, + consNExprShape, tcContext] at hterminal + simp only [tcContext] + simp only [Bind.bind, ReaderT.bind, StateT.bind, Except.bind] + rw [hterminal] + simp only [ensureSortExact] + simp [Expr.sortLevel!, Pure.pure, ReaderT.pure, + StateT.pure, Except.pure] + rfl + +/-! The two-binder suffix beginning at the `head` field. -/ + +def consAfterNHeadDomainState : TypeChecker.State := + replayInsert ({} : TypeChecker.State) consAlphaExpr + (.sort (.succ (.param `u))) + +theorem replayInferConsAfterNHeadDomain (fuel : Nat) : + TypeChecker.Inner.inferType' consAlphaExpr false + (TypeChecker.Methods.withFuel fuel) + (tcContext consNContext.lctx) ({} : TypeChecker.State) = + .ok (.sort (.succ (.param `u)), + consAfterNHeadDomainState) := by + simpa [consAfterNHeadDomainState, replayInsert, + consAlphaExprShape] using + (inferTypeFVarCore fuel consNContext.lctx ({} : TypeChecker.State) + consAlphaId (.sort (.succ (.param `u))) + (index := 0) (name := consAlphaName) (bi := .implicit) + (kind := .default) (by simp) consAlphaFindInN) + +def consAfterNCheckHeadId : FVarId := + ⟨consAfterNHeadDomainState.ngen.curr⟩ + +def consAfterNCheckLctx : LocalContext := + consNContext.lctx.mkLocalDecl consAfterNCheckHeadId + consHeadName consAlphaExpr .default + +def consAfterNCheckState : TypeChecker.State := + { consAfterNHeadDomainState with + ngen := consAfterNHeadDomainState.ngen.next } + +theorem consAfterNCheckHeadFresh : + consNContext.lctx.find? consAfterNCheckHeadId = none := by + have h := LocalContext.WF.find?_eq_find?_toList + (fv := consAfterNCheckHeadId) consNContextWF + rw [h] + simp [consAfterNCheckHeadId, consAfterNHeadDomainState, + replayInsert, consNContext, consAlphaContext, consRootContext, + ctorContext, consAlphaId, consNId, + AddInductive.Context.pushLocalDecl, + AddInductive.Context.freshFVarId, + LocalContext.mkLocalDecl_toList, LocalContext.mkLocalDecl, + LocalContext.toList, LocalDecl.fvarId, + NameGenerator.next, NameGenerator.curr] + intro x hx + change some x ∈ + (PersistentArray.empty : PersistentArray (Option LocalDecl)).toList' at hx + rw [PersistentArray.toList'_empty] at hx + simp at hx + +theorem consAfterNCheckLctxWF : consAfterNCheckLctx.WF := by + simpa [consAfterNCheckLctx] using + (LocalContext.WF.mkLocalDecl consNContextWF consAfterNCheckHeadFresh) + +theorem consAfterNCheckNFind : + consAfterNCheckLctx.find? consNId = + some (.cdecl 1 consNId consNName (.const ``Nat []) + .implicit .default) := by + rw [consAfterNCheckLctxWF.find?_eq_find?_toList] + simp [consAfterNCheckLctx, consAfterNCheckHeadId, + consAfterNHeadDomainState, replayInsert, + consNContext, consAlphaContext, consRootContext, ctorContext, + consAlphaId, consNId, AddInductive.Context.pushLocalDecl, + AddInductive.Context.freshFVarId, + LocalContext.mkLocalDecl_toList, LocalContext.mkLocalDecl, + LocalContext.toList, LocalDecl.fvarId, + NameGenerator.next, NameGenerator.curr] + +theorem consAfterNCheckAlphaCache : + consAfterNCheckState.inferTypeC[(.fvar consAlphaId : Expr)]? = + some (.sort (.succ (.param `u))) := by + change consAfterNHeadDomainState.inferTypeC[ + (.fvar consAlphaId : Expr)]? = some (.sort (.succ (.param `u))) + unfold consAfterNHeadDomainState replayInsert + rw [Std.HashMap.getElem?_insert] + rw [show (consAlphaExpr == (.fvar consAlphaId : Expr)) = true by simp] + rfl + +theorem consAfterNCheckFamilyMiss : + consAfterNCheckState.inferTypeC[ + (.const ``IndexedVec [.param `u] : Expr)]? = none := by + simp [consAfterNCheckState, consAfterNHeadDomainState, replayInsert] + +theorem consAfterNCheckFirstAppMiss : + consAfterNCheckState.inferTypeC[ + replayFirstApp (.fvar consAlphaId)]? = none := by + simp [consAfterNCheckState, consAfterNHeadDomainState, + replayInsert, replayFirstApp] + +def consAfterNCheckFirstAppState : TypeChecker.State := + replayInsert + (replayInsert consAfterNCheckState + (.const ``IndexedVec [.param `u]) indexedVecInfo.type) + (replayFirstApp (.fvar consAlphaId)) vecFamilyTail + +theorem consAfterNCheckNMiss : + consAfterNCheckFirstAppState.inferTypeC[(.fvar consNId : Expr)]? = + none := by + simp [consAfterNCheckFirstAppState, consAfterNCheckState, + consAfterNHeadDomainState, replayInsert, replayFirstApp] + +theorem consAfterNCheckTailMiss : + consAfterNCheckState.inferTypeC[ + ctorIndexedVecApp (.fvar consAlphaId) (.fvar consNId)]? = none := by + simp [consAfterNCheckState, consAfterNHeadDomainState, + replayInsert, ctorIndexedVecApp] + +def consAfterNCheckNState : TypeChecker.State := + replayInsert consAfterNCheckFirstAppState + (.fvar consNId) (.const ``Nat []) + +def consAfterNCheckTailDomainState : TypeChecker.State := + replayInsert consAfterNCheckNState + (ctorIndexedVecApp (.fvar consAlphaId) (.fvar consNId)) + (.sort (.succ (.param `u))) + +theorem replayInferConsAfterNTailDomain (fuel : Nat) : + TypeChecker.Inner.inferType' + (ctorIndexedVecApp (.fvar consAlphaId) (.fvar consNId)) false + (TypeChecker.Methods.withFuel fuel) + (tcContext consAfterNCheckLctx) consAfterNCheckState = + .ok (.sort (.succ (.param `u)), + consAfterNCheckTailDomainState) := by + simpa [consAfterNCheckFirstAppState, consAfterNCheckNState, + consAfterNCheckTailDomainState] using + (replayInferTailDomainAlphaCachedCore fuel consAfterNCheckLctx + consAfterNCheckState consAlphaId consNId + consAfterNCheckAlphaCache consAfterNCheckFamilyMiss + consAfterNCheckFirstAppMiss consAfterNCheckNMiss + consAfterNCheckTailMiss consAfterNCheckNFind) + +def consAfterNCheckTailId : FVarId := + ⟨consAfterNCheckTailDomainState.ngen.curr⟩ + +def consAfterNCheckTailLctx : LocalContext := + consAfterNCheckLctx.mkLocalDecl consAfterNCheckTailId + consTailName + (ctorIndexedVecApp (.fvar consAlphaId) (.fvar consNId)) .default + +def consAfterNCheckTailState : TypeChecker.State := + { consAfterNCheckTailDomainState with + ngen := consAfterNCheckTailDomainState.ngen.next } + +theorem consAfterNCheckTailFirstCache : + consAfterNCheckTailState.inferTypeC[ + replayFirstApp (.fvar consAlphaId)]? = some vecFamilyTail := by + change consAfterNCheckTailDomainState.inferTypeC[ + replayFirstApp (.fvar consAlphaId)]? = some vecFamilyTail + unfold consAfterNCheckTailDomainState replayInsert + rw [Std.HashMap.getElem?_insert] + rw [replayTailDomainBeqFirstApp] + simp only [Bool.false_eq_true, if_false] + unfold consAfterNCheckNState replayInsert + rw [Std.HashMap.getElem?_insert] + rw [show ((.fvar consNId : Expr) == + replayFirstApp (.fvar consAlphaId)) = false by + simpa only [replayFirstApp] using + (replayFVarBeqApp consNId + (.const ``IndexedVec [.param `u]) (.fvar consAlphaId))] + simp only [Bool.false_eq_true, if_false] + unfold consAfterNCheckFirstAppState replayInsert + rw [Std.HashMap.getElem?_insert] + rw [beq_self_eq_true] + rfl + +theorem consAfterNCheckTailNCache : + consAfterNCheckTailState.inferTypeC[(.fvar consNId : Expr)]? = + some (.const ``Nat []) := by + change consAfterNCheckTailDomainState.inferTypeC[ + (.fvar consNId : Expr)]? = some (.const ``Nat []) + unfold consAfterNCheckTailDomainState replayInsert + rw [Std.HashMap.getElem?_insert] + rw [show (ctorIndexedVecApp (.fvar consAlphaId) (.fvar consNId) == + (.fvar consNId : Expr)) = false by + simpa only [ctorIndexedVecApp] using + (replayAppBeqFVar + ((.const ``IndexedVec [.param `u] : Expr).app + (.fvar consAlphaId)) (.fvar consNId) consNId)] + simp only [Bool.false_eq_true, if_false] + unfold consAfterNCheckNState replayInsert + rw [Std.HashMap.getElem?_insert] + rw [beq_self_eq_true] + rfl + +theorem consAfterNCheckTailSuccMiss : + consAfterNCheckTailState.inferTypeC[ + (.const ``Nat.succ [] : Expr)]? = none := by + simp [consAfterNCheckTailState, consAfterNCheckTailDomainState, + consAfterNCheckNState, consAfterNCheckFirstAppState, + consAfterNCheckState, consAfterNHeadDomainState, + replayInsert, ctorIndexedVecApp, replayFirstApp, + Expr.eqv_eq, Expr.eqv'] + +theorem consAfterNCheckTailSuccAppMiss : + consAfterNCheckTailState.inferTypeC[ + replaySuccApp (.fvar consNId)]? = none := by + simp [consAfterNCheckTailState, consAfterNCheckTailDomainState, + consAfterNCheckNState, consAfterNCheckFirstAppState, + consAfterNCheckState, consAfterNHeadDomainState, + replayInsert, ctorIndexedVecApp, replayFirstApp, replaySuccApp, + Expr.eqv_eq, Expr.eqv'] + +theorem consAfterNCheckTailTerminalMiss : + consAfterNCheckTailState.inferTypeC[ + ctorIndexedVecApp (.fvar consAlphaId) + (replaySuccApp (.fvar consNId))]? = none := by + simp [consAfterNCheckTailState, consAfterNCheckTailDomainState, + consAfterNCheckNState, consAfterNCheckFirstAppState, + consAfterNCheckState, consAfterNHeadDomainState, + replayInsert, ctorIndexedVecApp, replayFirstApp, replaySuccApp, + Expr.eqv_eq, Expr.eqv'] + +def consAfterNCheckSuccState : TypeChecker.State := + replayInsert consAfterNCheckTailState (.const ``Nat.succ []) + (.forallE `n (.const ``Nat []) (.const ``Nat []) .default) + +def consAfterNCheckSuccAppState : TypeChecker.State := + replayInsert consAfterNCheckSuccState + (replaySuccApp (.fvar consNId)) (.const ``Nat []) + +def consAfterNCheckTerminalState : TypeChecker.State := + replayInsert consAfterNCheckSuccAppState + (ctorIndexedVecApp (.fvar consAlphaId) + (replaySuccApp (.fvar consNId))) + (.sort (.succ (.param `u))) + +theorem replayInferConsAfterNTerminal (fuel : Nat) : + TypeChecker.Inner.inferType' + (ctorIndexedVecApp (.fvar consAlphaId) + (replaySuccApp (.fvar consNId))) false + (TypeChecker.Methods.withFuel fuel) + (tcContext consAfterNCheckTailLctx) consAfterNCheckTailState = + .ok (.sort (.succ (.param `u)), + consAfterNCheckTerminalState) := by + simpa [consAfterNCheckSuccState, consAfterNCheckSuccAppState, + consAfterNCheckTerminalState] using + (replayInferIndexedVecSuccFromCacheCore fuel + consAfterNCheckTailLctx consAfterNCheckTailState + consAlphaId consNId consAfterNCheckTailFirstCache + consAfterNCheckTailSuccMiss consAfterNCheckTailNCache + consAfterNCheckTailSuccAppMiss consAfterNCheckTailTerminalMiss) + +theorem replayConsAfterNCheckTypeM : + TypeChecker.M.run ctorEnv .safe consNContext.lctx [`u] + ({} : FuelConfig) (TypeChecker.checkType consAfterN) = + .ok (.sort (.succ (.param `u))) := by + change Except.map (fun x : Expr × TypeChecker.State => x.1) + (TypeChecker.Inner.inferType consAfterN false + (TypeChecker.Methods.withFuel 10000) + (tcContext consNContext.lctx) ({} : TypeChecker.State)) = _ + change Except.map (fun x : Expr × TypeChecker.State => x.1) + (TypeChecker.Inner.inferType' consAfterN false + (TypeChecker.Methods.withFuel 9999) + (tcContext consNContext.lctx) ({} : TypeChecker.State)) = _ + unfold consAfterN TypeChecker.Inner.inferType' + simp [Expr.hasLooseBVars, Expr.looseBVarRange', + TypeChecker.Inner.inferForall, TypeChecker.Inner.inferForall.loop, + Bind.bind, ReaderT.bind, StateT.bind, Except.bind] + rw [show TypeChecker.Inner.inferType' + (.fvar consAlphaId) false + (TypeChecker.Methods.withFuel 9998) + (tcContext consNContext.lctx) ({} : TypeChecker.State) = + .ok (.sort (.succ (.param `u)), + consAfterNHeadDomainState) by + simpa [consAlphaExprShape] using + replayInferConsAfterNHeadDomain 9998] + simp only [ensureSortExact] + rw [withLocalDeclEq] + simp [Expr.instantiate1'] + have htail : + TypeChecker.Inner.inferType + (((.const ``IndexedVec [.param `u] : Expr).app + (.fvar consAlphaId)).app (.fvar consNId)) false + (TypeChecker.Methods.withFuel 9999) + (tcContext consAfterNCheckLctx) consAfterNCheckState = + .ok (.sort (.succ (.param `u)), + consAfterNCheckTailDomainState) := by + change TypeChecker.Inner.inferType' + (((.const ``IndexedVec [.param `u] : Expr).app + (.fvar consAlphaId)).app (.fvar consNId)) false + (TypeChecker.Methods.withFuel 9998) + (tcContext consAfterNCheckLctx) consAfterNCheckState = _ + simpa [ctorIndexedVecApp] using + replayInferConsAfterNTailDomain 9998 + simp only [consAfterNCheckLctx, consAfterNCheckHeadId, + consAfterNCheckState, consAlphaExprShape, tcContext] at htail + simp only [tcContext] + simp only [Bind.bind, ReaderT.bind, StateT.bind, Except.bind] + rw [htail] + simp only [ensureSortExact] + rw [withLocalDeclEq] + simp only [Expr.instantiate1'] + have hterminal : + TypeChecker.Inner.inferType + (((.const ``IndexedVec [.param `u] : Expr).app + (.fvar consAlphaId)).app + ((.const ``Nat.succ [] : Expr).app (.fvar consNId))) false + (TypeChecker.Methods.withFuel 9999) + (tcContext consAfterNCheckTailLctx) consAfterNCheckTailState = + .ok (.sort (.succ (.param `u)), + consAfterNCheckTerminalState) := by + change TypeChecker.Inner.inferType' + (((.const ``IndexedVec [.param `u] : Expr).app + (.fvar consAlphaId)).app + ((.const ``Nat.succ [] : Expr).app (.fvar consNId))) false + (TypeChecker.Methods.withFuel 9998) + (tcContext consAfterNCheckTailLctx) consAfterNCheckTailState = _ + simpa [ctorIndexedVecApp, replaySuccApp] using + replayInferConsAfterNTerminal 9998 + simp only [consAfterNCheckTailLctx, consAfterNCheckTailId, + consAfterNCheckTailState, consAfterNCheckLctx, + consAfterNCheckHeadId, consAlphaExprShape, + ctorIndexedVecApp, tcContext] at hterminal + simp only [Bind.bind, ReaderT.bind, StateT.bind, Except.bind] + rw [hterminal] + simp only [ensureSortExact] + simp [Expr.sortLevel!, Pure.pure, ReaderT.pure, + StateT.pure, Except.pure] + rfl + +/-! The three-binder suffix beginning at the `n` index. -/ + +open private mkLevelIMaxCore mkLevelMaxCore from Lean.Level in +@[simp] theorem replayMkLevelIMaxSuccZeroSuccParam : + mkLevelIMax' (.succ .zero) (.succ (.param `u)) = + .succ (.param `u) := by + simp [mkLevelIMax', mkLevelIMaxCore, mkLevelMax', mkLevelMaxCore, + Level.isNeverZero, Level.isZero, Level.isExplicit, + Level.hasMVar', Level.hasParam', + Level.getOffset, + Level.getOffsetAux, Level.getLevelOffset] + +def consAfterAlphaNatState : TypeChecker.State := + replayInsert ({} : TypeChecker.State) (.const ``Nat []) + (.sort (.succ .zero)) + +theorem replayInferConsAfterAlphaNat (fuel : Nat) : + TypeChecker.Inner.inferType' (.const ``Nat []) false + (TypeChecker.Methods.withFuel fuel) + (tcContext consAlphaContext.lctx) ({} : TypeChecker.State) = + .ok (.sort (.succ .zero), consAfterAlphaNatState) := by + simpa [consAfterAlphaNatState, replayInsert] using + (inferTypeNatCore fuel consAlphaContext.lctx + ({} : TypeChecker.State) (by simp)) + +def consAfterAlphaCheckNId : FVarId := + ⟨consAfterAlphaNatState.ngen.curr⟩ + +def consAfterAlphaCheckNLctx : LocalContext := + consAlphaContext.lctx.mkLocalDecl consAfterAlphaCheckNId + consNName (.const ``Nat []) .implicit + +def consAfterAlphaCheckNState : TypeChecker.State := + { consAfterAlphaNatState with + ngen := consAfterAlphaNatState.ngen.next } + +theorem consAfterAlphaCheckNFresh : + consAlphaContext.lctx.find? consAfterAlphaCheckNId = none := by + have h := LocalContext.WF.find?_eq_find?_toList + (fv := consAfterAlphaCheckNId) consAlphaContextWF + rw [h] + simp [consAfterAlphaCheckNId, consAfterAlphaNatState, replayInsert, + consAlphaContext, consRootContext, ctorContext, + consAlphaId, AddInductive.Context.pushLocalDecl, + AddInductive.Context.freshFVarId, + LocalContext.mkLocalDecl_toList, LocalContext.mkLocalDecl, + LocalContext.toList, LocalDecl.fvarId, + NameGenerator.next, NameGenerator.curr] + intro x hx + change some x ∈ + (PersistentArray.empty : PersistentArray (Option LocalDecl)).toList' at hx + rw [PersistentArray.toList'_empty] at hx + simp at hx + +theorem consAfterAlphaCheckNLctxWF : consAfterAlphaCheckNLctx.WF := by + simpa [consAfterAlphaCheckNLctx] using + (LocalContext.WF.mkLocalDecl consAlphaContextWF + consAfterAlphaCheckNFresh) + +theorem consAfterAlphaCheckAlphaFind : + consAfterAlphaCheckNLctx.find? consAlphaId = + some (.cdecl 0 consAlphaId consAlphaName + (.sort (.succ (.param `u))) .implicit .default) := by + rw [consAfterAlphaCheckNLctxWF.find?_eq_find?_toList] + simp [consAfterAlphaCheckNLctx, consAfterAlphaCheckNId, + consAfterAlphaNatState, replayInsert, + consAlphaContext, consRootContext, ctorContext, + consAlphaId, AddInductive.Context.pushLocalDecl, + AddInductive.Context.freshFVarId, + LocalContext.mkLocalDecl_toList, LocalContext.mkLocalDecl, + LocalContext.toList, LocalDecl.fvarId, + NameGenerator.next, NameGenerator.curr] + +theorem consAfterAlphaCheckAlphaMiss : + consAfterAlphaCheckNState.inferTypeC[ + (.fvar consAlphaId : Expr)]? = none := by + simp [consAfterAlphaCheckNState, consAfterAlphaNatState, + replayInsert] + +def consAfterAlphaHeadDomainState : TypeChecker.State := + replayInsert consAfterAlphaCheckNState (.fvar consAlphaId) + (.sort (.succ (.param `u))) + +theorem replayInferConsAfterAlphaHeadDomain (fuel : Nat) : + TypeChecker.Inner.inferType' (.fvar consAlphaId) false + (TypeChecker.Methods.withFuel fuel) + (tcContext consAfterAlphaCheckNLctx) consAfterAlphaCheckNState = + .ok (.sort (.succ (.param `u)), + consAfterAlphaHeadDomainState) := by + simpa [consAfterAlphaHeadDomainState, replayInsert] using + (inferTypeFVarCore fuel consAfterAlphaCheckNLctx + consAfterAlphaCheckNState consAlphaId + (.sort (.succ (.param `u))) + consAfterAlphaCheckAlphaMiss consAfterAlphaCheckAlphaFind) + +def consAfterAlphaCheckHeadId : FVarId := + ⟨consAfterAlphaHeadDomainState.ngen.curr⟩ + +def consAfterAlphaCheckHeadLctx : LocalContext := + consAfterAlphaCheckNLctx.mkLocalDecl consAfterAlphaCheckHeadId + consHeadName (.fvar consAlphaId) .default + +def consAfterAlphaCheckHeadState : TypeChecker.State := + { consAfterAlphaHeadDomainState with + ngen := consAfterAlphaHeadDomainState.ngen.next } + +theorem consAfterAlphaCheckHeadFresh : + consAfterAlphaCheckNLctx.find? consAfterAlphaCheckHeadId = none := by + have h := LocalContext.WF.find?_eq_find?_toList + (fv := consAfterAlphaCheckHeadId) consAfterAlphaCheckNLctxWF + rw [h] + simp [consAfterAlphaCheckHeadId, consAfterAlphaHeadDomainState, + consAfterAlphaCheckNState, consAfterAlphaCheckNId, + consAfterAlphaNatState, replayInsert, + consAfterAlphaCheckNLctx, consAlphaContext, + consRootContext, ctorContext, consAlphaId, + AddInductive.Context.pushLocalDecl, + AddInductive.Context.freshFVarId, + LocalContext.mkLocalDecl_toList, LocalContext.mkLocalDecl, + LocalContext.toList, LocalDecl.fvarId, + NameGenerator.next, NameGenerator.curr] + intro x hx + change some x ∈ + (PersistentArray.empty : PersistentArray (Option LocalDecl)).toList' at hx + rw [PersistentArray.toList'_empty] at hx + simp at hx + +theorem consAfterAlphaCheckHeadLctxWF : + consAfterAlphaCheckHeadLctx.WF := by + simpa [consAfterAlphaCheckHeadLctx] using + (LocalContext.WF.mkLocalDecl consAfterAlphaCheckNLctxWF + consAfterAlphaCheckHeadFresh) + +theorem consAfterAlphaCheckNFind : + consAfterAlphaCheckHeadLctx.find? consAfterAlphaCheckNId = + some (.cdecl 1 consAfterAlphaCheckNId consNName + (.const ``Nat []) .implicit .default) := by + rw [consAfterAlphaCheckHeadLctxWF.find?_eq_find?_toList] + simp [consAfterAlphaCheckHeadLctx, consAfterAlphaCheckHeadId, + consAfterAlphaHeadDomainState, consAfterAlphaCheckNState, + consAfterAlphaCheckNLctx, consAfterAlphaCheckNId, + consAfterAlphaNatState, replayInsert, + consAlphaContext, consRootContext, ctorContext, + consAlphaId, AddInductive.Context.pushLocalDecl, + AddInductive.Context.freshFVarId, + LocalContext.mkLocalDecl_toList, LocalContext.mkLocalDecl, + LocalContext.toList, LocalDecl.fvarId, + NameGenerator.next, NameGenerator.curr] + +theorem consAfterAlphaCheckAlphaCache : + consAfterAlphaCheckHeadState.inferTypeC[ + (.fvar consAlphaId : Expr)]? = + some (.sort (.succ (.param `u))) := by + change consAfterAlphaHeadDomainState.inferTypeC[ + (.fvar consAlphaId : Expr)]? = + some (.sort (.succ (.param `u))) + unfold consAfterAlphaHeadDomainState replayInsert + rw [Std.HashMap.getElem?_insert] + rw [beq_self_eq_true] + rfl + +@[simp] theorem replayNatConstBeqIndexedVec : + ((.const ``Nat [] : Expr) == + .const ``IndexedVec [.param `u]) = false := by + change Expr.eqv (.const ``Nat []) + (.const ``IndexedVec [.param `u]) = false + rw [Expr.eqv_eq] + rfl + +@[simp] theorem replayAlphaIdBeqAfterAlphaNId : + ((.fvar consAlphaId : Expr) == + .fvar consAfterAlphaCheckNId) = false := by + change Expr.eqv (.fvar consAlphaId) + (.fvar consAfterAlphaCheckNId) = false + rw [Expr.eqv_eq] + simp [Expr.eqv', consAlphaId, consAfterAlphaCheckNId, + consAfterAlphaNatState, replayInsert, + consAlphaContext, consRootContext, ctorContext, + AddInductive.Context.pushLocalDecl, + AddInductive.Context.freshFVarId, + NameGenerator.next, NameGenerator.curr] + +theorem consAfterAlphaCheckFamilyMiss : + consAfterAlphaCheckHeadState.inferTypeC[ + (.const ``IndexedVec [.param `u] : Expr)]? = none := by + simp [consAfterAlphaCheckHeadState, consAfterAlphaHeadDomainState, + consAfterAlphaCheckNState, consAfterAlphaNatState, replayInsert] + +theorem consAfterAlphaCheckFirstAppMiss : + consAfterAlphaCheckHeadState.inferTypeC[ + replayFirstApp (.fvar consAlphaId)]? = none := by + simp [consAfterAlphaCheckHeadState, consAfterAlphaHeadDomainState, + consAfterAlphaCheckNState, consAfterAlphaNatState, + replayInsert, replayFirstApp] + +def consAfterAlphaCheckFirstAppState : TypeChecker.State := + replayInsert + (replayInsert consAfterAlphaCheckHeadState + (.const ``IndexedVec [.param `u]) indexedVecInfo.type) + (replayFirstApp (.fvar consAlphaId)) vecFamilyTail + +theorem consAfterAlphaCheckNMiss : + consAfterAlphaCheckFirstAppState.inferTypeC[ + (.fvar consAfterAlphaCheckNId : Expr)]? = none := by + simp [consAfterAlphaCheckFirstAppState, + consAfterAlphaCheckHeadState, consAfterAlphaHeadDomainState, + consAfterAlphaCheckNState, consAfterAlphaNatState, + replayInsert, replayFirstApp] + +theorem consAfterAlphaCheckTailMiss : + consAfterAlphaCheckHeadState.inferTypeC[ + ctorIndexedVecApp (.fvar consAlphaId) + (.fvar consAfterAlphaCheckNId)]? = none := by + simp [consAfterAlphaCheckHeadState, consAfterAlphaHeadDomainState, + consAfterAlphaCheckNState, consAfterAlphaNatState, + replayInsert, ctorIndexedVecApp] + +def consAfterAlphaCheckNInferState : TypeChecker.State := + replayInsert consAfterAlphaCheckFirstAppState + (.fvar consAfterAlphaCheckNId) (.const ``Nat []) + +def consAfterAlphaCheckTailDomainState : TypeChecker.State := + replayInsert consAfterAlphaCheckNInferState + (ctorIndexedVecApp (.fvar consAlphaId) + (.fvar consAfterAlphaCheckNId)) + (.sort (.succ (.param `u))) + +theorem replayInferConsAfterAlphaTailDomain (fuel : Nat) : + TypeChecker.Inner.inferType' + (ctorIndexedVecApp (.fvar consAlphaId) + (.fvar consAfterAlphaCheckNId)) false + (TypeChecker.Methods.withFuel fuel) + (tcContext consAfterAlphaCheckHeadLctx) + consAfterAlphaCheckHeadState = + .ok (.sort (.succ (.param `u)), + consAfterAlphaCheckTailDomainState) := by + simpa [consAfterAlphaCheckFirstAppState, + consAfterAlphaCheckNInferState, + consAfterAlphaCheckTailDomainState] using + (replayInferTailDomainAlphaCachedCore fuel + consAfterAlphaCheckHeadLctx consAfterAlphaCheckHeadState + consAlphaId consAfterAlphaCheckNId + consAfterAlphaCheckAlphaCache consAfterAlphaCheckFamilyMiss + consAfterAlphaCheckFirstAppMiss consAfterAlphaCheckNMiss + consAfterAlphaCheckTailMiss consAfterAlphaCheckNFind) + +def consAfterAlphaCheckTailId : FVarId := + ⟨consAfterAlphaCheckTailDomainState.ngen.curr⟩ + +def consAfterAlphaCheckTailLctx : LocalContext := + consAfterAlphaCheckHeadLctx.mkLocalDecl consAfterAlphaCheckTailId + consTailName + (ctorIndexedVecApp (.fvar consAlphaId) + (.fvar consAfterAlphaCheckNId)) .default + +def consAfterAlphaCheckTailState : TypeChecker.State := + { consAfterAlphaCheckTailDomainState with + ngen := consAfterAlphaCheckTailDomainState.ngen.next } + +@[simp] theorem replayAfterAlphaNIdBeqAlphaId : + ((.fvar consAfterAlphaCheckNId : Expr) == + .fvar consAlphaId) = false := by + change Expr.eqv (.fvar consAfterAlphaCheckNId) + (.fvar consAlphaId) = false + rw [Expr.eqv_eq] + simp [Expr.eqv', consAlphaId, consAfterAlphaCheckNId, + consAfterAlphaNatState, replayInsert, + consAlphaContext, consRootContext, ctorContext, + AddInductive.Context.pushLocalDecl, + AddInductive.Context.freshFVarId, + NameGenerator.next, NameGenerator.curr] + +@[simp] theorem replayNatConstBeqSucc : + ((.const ``Nat [] : Expr) == .const ``Nat.succ []) = false := by + change Expr.eqv (.const ``Nat []) (.const ``Nat.succ []) = false + rw [Expr.eqv_eq] + rfl + +@[simp] theorem replayIndexedVecAppBeqFirstApp + (alpha index : Expr) : + (ctorIndexedVecApp alpha index == replayFirstApp alpha) = false := by + change Expr.eqv (ctorIndexedVecApp alpha index) + (replayFirstApp alpha) = false + rw [Expr.eqv_eq] + simp [Expr.eqv', ctorIndexedVecApp, replayFirstApp] + +@[simp] theorem replayIndexedVecAppBeqSuccApp + (alpha n : Expr) : + (ctorIndexedVecApp alpha n == replaySuccApp n) = false := by + change Expr.eqv (ctorIndexedVecApp alpha n) + (replaySuccApp n) = false + rw [Expr.eqv_eq] + simp [Expr.eqv', ctorIndexedVecApp, replayFirstApp, replaySuccApp] + +@[simp] theorem replayIndexedVecAppBeqIndexedVecSucc + (alpha : Expr) (id : FVarId) : + (ctorIndexedVecApp alpha (.fvar id) == + ctorIndexedVecApp alpha (replaySuccApp (.fvar id))) = false := by + change Expr.eqv (ctorIndexedVecApp alpha (.fvar id)) + (ctorIndexedVecApp alpha (replaySuccApp (.fvar id))) = false + rw [Expr.eqv_eq] + simp [Expr.eqv', ctorIndexedVecApp, replaySuccApp] + +@[simp] theorem replayFirstAppBeqIndexedVecSucc + (alpha n : Expr) : + (replayFirstApp alpha == + ctorIndexedVecApp alpha (replaySuccApp n)) = false := by + change Expr.eqv (replayFirstApp alpha) + (ctorIndexedVecApp alpha (replaySuccApp n)) = false + rw [Expr.eqv_eq] + simp [Expr.eqv', ctorIndexedVecApp, replayFirstApp, replaySuccApp] + +@[simp] theorem replayIndexedVecLiteralBeqSuccApp + (alpha n : Expr) : + (((.const ``IndexedVec [.param `u] : Expr).app alpha).app n == + (.const ``Nat.succ [] : Expr).app n) = false := by + simpa [ctorIndexedVecApp, replaySuccApp] using + replayIndexedVecAppBeqSuccApp alpha n + +@[simp] theorem replayFirstAppLiteralGenericBeqSuccApp + (alpha n : Expr) : + ((.const ``IndexedVec [.param `u] : Expr).app alpha == + (.const ``Nat.succ [] : Expr).app n) = false := by + simpa [replayFirstApp, replaySuccApp] using + replayFirstAppBeqSuccApp alpha n + +@[simp] theorem replayIndexedVecLiteralFVarBeqTerminal + (alpha : Expr) (id : FVarId) : + (((.const ``IndexedVec [.param `u] : Expr).app alpha).app + (.fvar id) == + ((.const ``IndexedVec [.param `u] : Expr).app alpha).app + ((.const ``Nat.succ [] : Expr).app (.fvar id))) = false := by + simpa [ctorIndexedVecApp, replaySuccApp] using + replayIndexedVecAppBeqIndexedVecSucc alpha id + +@[simp] theorem replayFirstAppLiteralGenericBeqTerminal + (alpha : Expr) (id : FVarId) : + ((.const ``IndexedVec [.param `u] : Expr).app alpha == + ((.const ``IndexedVec [.param `u] : Expr).app alpha).app + ((.const ``Nat.succ [] : Expr).app (.fvar id))) = false := by + simpa [ctorIndexedVecApp, replayFirstApp, replaySuccApp] using + replayFirstAppBeqIndexedVecSucc alpha (.fvar id) + +theorem consAfterAlphaCheckTailFirstCache : + consAfterAlphaCheckTailState.inferTypeC[ + replayFirstApp (.fvar consAlphaId)]? = some vecFamilyTail := by + change consAfterAlphaCheckTailDomainState.inferTypeC[ + replayFirstApp (.fvar consAlphaId)]? = some vecFamilyTail + unfold consAfterAlphaCheckTailDomainState replayInsert + rw [Std.HashMap.getElem?_insert] + rw [replayIndexedVecAppBeqFirstApp] + simp only [Bool.false_eq_true, if_false] + unfold consAfterAlphaCheckNInferState replayInsert + rw [Std.HashMap.getElem?_insert] + rw [show ((.fvar consAfterAlphaCheckNId : Expr) == + replayFirstApp (.fvar consAlphaId)) = false by + exact replayFVarBeqApp consAfterAlphaCheckNId + (.const ``IndexedVec [.param `u]) (.fvar consAlphaId)] + simp only [Bool.false_eq_true, if_false] + unfold consAfterAlphaCheckFirstAppState replayInsert + rw [Std.HashMap.getElem?_insert] + rw [beq_self_eq_true] + rfl + +theorem consAfterAlphaCheckTailNCache : + consAfterAlphaCheckTailState.inferTypeC[ + (.fvar consAfterAlphaCheckNId : Expr)]? = + some (.const ``Nat []) := by + change consAfterAlphaCheckTailDomainState.inferTypeC[ + (.fvar consAfterAlphaCheckNId : Expr)]? = + some (.const ``Nat []) + unfold consAfterAlphaCheckTailDomainState replayInsert + rw [Std.HashMap.getElem?_insert] + rw [show (ctorIndexedVecApp (.fvar consAlphaId) + (.fvar consAfterAlphaCheckNId) == + (.fvar consAfterAlphaCheckNId : Expr)) = false by + exact replayAppBeqFVar + ((.const ``IndexedVec [.param `u] : Expr).app + (.fvar consAlphaId)) + (.fvar consAfterAlphaCheckNId) consAfterAlphaCheckNId] + simp only [Bool.false_eq_true, if_false] + unfold consAfterAlphaCheckNInferState replayInsert + rw [Std.HashMap.getElem?_insert] + rw [beq_self_eq_true] + rfl + +theorem consAfterAlphaCheckTailSuccMiss : + consAfterAlphaCheckTailState.inferTypeC[ + (.const ``Nat.succ [] : Expr)]? = none := by + simp [consAfterAlphaCheckTailState, + consAfterAlphaCheckTailDomainState, + consAfterAlphaCheckNInferState, + consAfterAlphaCheckFirstAppState, + consAfterAlphaCheckHeadState, consAfterAlphaHeadDomainState, + consAfterAlphaCheckNState, consAfterAlphaNatState, + replayInsert, ctorIndexedVecApp, replayFirstApp] + +theorem consAfterAlphaCheckTailSuccAppMiss : + consAfterAlphaCheckTailState.inferTypeC[ + replaySuccApp (.fvar consAfterAlphaCheckNId)]? = none := by + simp [consAfterAlphaCheckTailState, + consAfterAlphaCheckTailDomainState, + consAfterAlphaCheckNInferState, + consAfterAlphaCheckFirstAppState, + consAfterAlphaCheckHeadState, consAfterAlphaHeadDomainState, + consAfterAlphaCheckNState, consAfterAlphaNatState, + replayInsert, ctorIndexedVecApp, replayFirstApp, replaySuccApp] + +theorem consAfterAlphaCheckTailTerminalMiss : + consAfterAlphaCheckTailState.inferTypeC[ + ctorIndexedVecApp (.fvar consAlphaId) + (replaySuccApp (.fvar consAfterAlphaCheckNId))]? = none := by + simp [consAfterAlphaCheckTailState, + consAfterAlphaCheckTailDomainState, + consAfterAlphaCheckNInferState, + consAfterAlphaCheckFirstAppState, + consAfterAlphaCheckHeadState, consAfterAlphaHeadDomainState, + consAfterAlphaCheckNState, consAfterAlphaNatState, + replayInsert, ctorIndexedVecApp, replayFirstApp, replaySuccApp] + +def consAfterAlphaCheckSuccState : TypeChecker.State := + replayInsert consAfterAlphaCheckTailState (.const ``Nat.succ []) + (.forallE `n (.const ``Nat []) (.const ``Nat []) .default) + +def consAfterAlphaCheckSuccAppState : TypeChecker.State := + replayInsert consAfterAlphaCheckSuccState + (replaySuccApp (.fvar consAfterAlphaCheckNId)) (.const ``Nat []) + +def consAfterAlphaCheckTerminalState : TypeChecker.State := + replayInsert consAfterAlphaCheckSuccAppState + (ctorIndexedVecApp (.fvar consAlphaId) + (replaySuccApp (.fvar consAfterAlphaCheckNId))) + (.sort (.succ (.param `u))) + +theorem replayInferConsAfterAlphaTerminal (fuel : Nat) : + TypeChecker.Inner.inferType' + (ctorIndexedVecApp (.fvar consAlphaId) + (replaySuccApp (.fvar consAfterAlphaCheckNId))) false + (TypeChecker.Methods.withFuel fuel) + (tcContext consAfterAlphaCheckTailLctx) + consAfterAlphaCheckTailState = + .ok (.sort (.succ (.param `u)), + consAfterAlphaCheckTerminalState) := by + simpa [consAfterAlphaCheckSuccState, + consAfterAlphaCheckSuccAppState, + consAfterAlphaCheckTerminalState] using + (replayInferIndexedVecSuccFromCacheCore fuel + consAfterAlphaCheckTailLctx consAfterAlphaCheckTailState + consAlphaId consAfterAlphaCheckNId + consAfterAlphaCheckTailFirstCache + consAfterAlphaCheckTailSuccMiss + consAfterAlphaCheckTailNCache + consAfterAlphaCheckTailSuccAppMiss + consAfterAlphaCheckTailTerminalMiss) + +theorem replayConsAfterAlphaCheckTypeM : + TypeChecker.M.run ctorEnv .safe consAlphaContext.lctx [`u] + ({} : FuelConfig) (TypeChecker.checkType consAfterAlpha) = + .ok (.sort (.succ (.param `u))) := by + change Except.map (fun x : Expr × TypeChecker.State => x.1) + (TypeChecker.Inner.inferType consAfterAlpha false + (TypeChecker.Methods.withFuel 10000) + (tcContext consAlphaContext.lctx) ({} : TypeChecker.State)) = _ + change Except.map (fun x : Expr × TypeChecker.State => x.1) + (TypeChecker.Inner.inferType' consAfterAlpha false + (TypeChecker.Methods.withFuel 9999) + (tcContext consAlphaContext.lctx) ({} : TypeChecker.State)) = _ + unfold consAfterAlpha TypeChecker.Inner.inferType' + simp [Expr.hasLooseBVars, Expr.looseBVarRange', + TypeChecker.Inner.inferForall, TypeChecker.Inner.inferForall.loop, + Bind.bind, ReaderT.bind, StateT.bind, Except.bind] + rw [show TypeChecker.Inner.inferType' + (.const ``Nat []) false + (TypeChecker.Methods.withFuel 9998) + (tcContext consAlphaContext.lctx) ({} : TypeChecker.State) = + .ok (.sort (.succ .zero), consAfterAlphaNatState) by + exact replayInferConsAfterAlphaNat 9998] + simp only [ensureSortExact] + rw [withLocalDeclEq] + simp only [Expr.instantiate1'] + have hhead : + TypeChecker.Inner.inferType (.fvar consAlphaId) false + (TypeChecker.Methods.withFuel 9999) + (tcContext consAfterAlphaCheckNLctx) + consAfterAlphaCheckNState = + .ok (.sort (.succ (.param `u)), + consAfterAlphaHeadDomainState) := by + change TypeChecker.Inner.inferType' (.fvar consAlphaId) false + (TypeChecker.Methods.withFuel 9998) + (tcContext consAfterAlphaCheckNLctx) + consAfterAlphaCheckNState = _ + exact replayInferConsAfterAlphaHeadDomain 9998 + simp only [consAfterAlphaCheckNLctx, consAfterAlphaCheckNId, + consAfterAlphaCheckNState, tcContext] at hhead + simp only [tcContext] + simp only [Bind.bind, ReaderT.bind, StateT.bind, Except.bind] + rw [hhead] + simp only [ensureSortExact] + rw [withLocalDeclEq] + simp [Expr.instantiate1'] + have htail : + TypeChecker.Inner.inferType + (((.const ``IndexedVec [.param `u] : Expr).app + (.fvar consAlphaId)).app + (.fvar consAfterAlphaCheckNId)) false + (TypeChecker.Methods.withFuel 9999) + (tcContext consAfterAlphaCheckHeadLctx) + consAfterAlphaCheckHeadState = + .ok (.sort (.succ (.param `u)), + consAfterAlphaCheckTailDomainState) := by + change TypeChecker.Inner.inferType' + (((.const ``IndexedVec [.param `u] : Expr).app + (.fvar consAlphaId)).app + (.fvar consAfterAlphaCheckNId)) false + (TypeChecker.Methods.withFuel 9998) + (tcContext consAfterAlphaCheckHeadLctx) + consAfterAlphaCheckHeadState = _ + simpa [ctorIndexedVecApp] using + replayInferConsAfterAlphaTailDomain 9998 + simp only [consAfterAlphaCheckHeadLctx, + consAfterAlphaCheckHeadId, consAfterAlphaCheckHeadState, + consAfterAlphaCheckNLctx, consAfterAlphaCheckNId, + tcContext] at htail + simp only [Bind.bind, ReaderT.bind, StateT.bind, Except.bind] + rw [htail] + simp only [ensureSortExact] + rw [withLocalDeclEq] + simp [Expr.instantiate1'] + have hterminal : + TypeChecker.Inner.inferType + (((.const ``IndexedVec [.param `u] : Expr).app + (.fvar consAlphaId)).app + ((.const ``Nat.succ [] : Expr).app + (.fvar consAfterAlphaCheckNId))) false + (TypeChecker.Methods.withFuel 9999) + (tcContext consAfterAlphaCheckTailLctx) + consAfterAlphaCheckTailState = + .ok (.sort (.succ (.param `u)), + consAfterAlphaCheckTerminalState) := by + change TypeChecker.Inner.inferType' + (((.const ``IndexedVec [.param `u] : Expr).app + (.fvar consAlphaId)).app + ((.const ``Nat.succ [] : Expr).app + (.fvar consAfterAlphaCheckNId))) false + (TypeChecker.Methods.withFuel 9998) + (tcContext consAfterAlphaCheckTailLctx) + consAfterAlphaCheckTailState = _ + simpa [ctorIndexedVecApp, replaySuccApp] using + replayInferConsAfterAlphaTerminal 9998 + simp only [consAfterAlphaCheckTailLctx, + consAfterAlphaCheckTailId, consAfterAlphaCheckTailState, + consAfterAlphaCheckHeadLctx, consAfterAlphaCheckHeadId, + consAfterAlphaCheckNLctx, consAfterAlphaCheckNId, + ctorIndexedVecApp, tcContext] at hterminal + simp only [Bind.bind, ReaderT.bind, StateT.bind, Except.bind] + rw [hterminal] + simp only [ensureSortExact] + simp [Expr.sortLevel!, Pure.pure, ReaderT.pure, + StateT.pure, Except.pure] + rfl + +/-! The complete four-binder constructor type. -/ + +def consRootCheckAlphaId : FVarId := + ⟨nilRootSortState.ngen.curr⟩ + +def consRootCheckAlphaLctx : LocalContext := + consRootContext.lctx.mkLocalDecl consRootCheckAlphaId + consAlphaName (.sort (.succ (.param `u))) .implicit + +def consRootCheckAlphaState : TypeChecker.State := + { nilRootSortState with ngen := nilRootSortState.ngen.next } + +theorem replayInferConsRootSort : + TypeChecker.Inner.inferType' + (.sort (.succ (.param `u))) false + (TypeChecker.Methods.withFuel 9998) + (tcContext consRootContext.lctx) ({} : TypeChecker.State) = + .ok (.sort (.succ (.succ (.param `u))), + nilRootSortState) := by + simpa [consRootContext, ctorContext] using nilRootSortCore + +theorem consRootCheckAlphaFresh : + consRootContext.lctx.find? consRootCheckAlphaId = none := by + have h := LocalContext.WF.find?_eq_find?_toList + (fv := consRootCheckAlphaId) LocalContext.WF.nil + change + ({ fvarIdToDecl := PersistentHashMap.empty, + decls := PersistentArray.empty, + auxDeclToFullName := Std.TreeMap.empty } : LocalContext).find? + consRootCheckAlphaId = none + rw [h] + simp [LocalContext.toList] + +theorem consRootCheckAlphaLctxWF : consRootCheckAlphaLctx.WF := by + change (({} : LocalContext).mkLocalDecl consRootCheckAlphaId + consAlphaName (.sort (.succ (.param `u))) .implicit).WF + exact LocalContext.WF.mkLocalDecl LocalContext.WF.nil (by + have h := LocalContext.WF.find?_eq_find?_toList + (fv := consRootCheckAlphaId) LocalContext.WF.nil + change + ({ fvarIdToDecl := PersistentHashMap.empty, + decls := PersistentArray.empty, + auxDeclToFullName := Std.TreeMap.empty } : LocalContext).find? + consRootCheckAlphaId = none + rw [h] + simp [LocalContext.toList]) + +theorem consRootCheckAlphaFind : + consRootCheckAlphaLctx.find? consRootCheckAlphaId = + some (.cdecl 0 consRootCheckAlphaId consAlphaName + (.sort (.succ (.param `u))) .implicit .default) := by + rw [consRootCheckAlphaLctxWF.find?_eq_find?_toList] + simp [consRootCheckAlphaLctx, consRootCheckAlphaId, + consRootContext, ctorContext, nilRootSortState, + LocalContext.mkLocalDecl_toList, LocalContext.mkLocalDecl, + LocalContext.toList, LocalDecl.fvarId, + NameGenerator.next, NameGenerator.curr] + +theorem consRootCheckNatMiss : + consRootCheckAlphaState.inferTypeC[ + (.const ``Nat [] : Expr)]? = none := by + simp [consRootCheckAlphaState, nilRootSortState] + +def consRootCheckNatState : TypeChecker.State := + replayInsert consRootCheckAlphaState (.const ``Nat []) + (.sort (.succ .zero)) + +theorem replayInferConsRootNat (fuel : Nat) : + TypeChecker.Inner.inferType' (.const ``Nat []) false + (TypeChecker.Methods.withFuel fuel) + (tcContext consRootCheckAlphaLctx) consRootCheckAlphaState = + .ok (.sort (.succ .zero), consRootCheckNatState) := by + simpa [consRootCheckNatState, replayInsert] using + (inferTypeNatCore fuel consRootCheckAlphaLctx + consRootCheckAlphaState consRootCheckNatMiss) + +def consRootCheckNId : FVarId := + ⟨consRootCheckNatState.ngen.curr⟩ + +def consRootCheckNLctx : LocalContext := + consRootCheckAlphaLctx.mkLocalDecl consRootCheckNId + consNName (.const ``Nat []) .implicit + +def consRootCheckNState : TypeChecker.State := + { consRootCheckNatState with ngen := consRootCheckNatState.ngen.next } + +theorem consRootCheckNFresh : + consRootCheckAlphaLctx.find? consRootCheckNId = none := by + have h := LocalContext.WF.find?_eq_find?_toList + (fv := consRootCheckNId) consRootCheckAlphaLctxWF + rw [h] + simp [consRootCheckNId, consRootCheckNatState, + consRootCheckAlphaState, consRootCheckAlphaLctx, + consRootCheckAlphaId, nilRootSortState, replayInsert, + consRootContext, ctorContext, + LocalContext.mkLocalDecl_toList, LocalContext.mkLocalDecl, + LocalContext.toList, LocalDecl.fvarId, + NameGenerator.next, NameGenerator.curr] + intro x hx + change some x ∈ + (PersistentArray.empty : PersistentArray (Option LocalDecl)).toList' at hx + rw [PersistentArray.toList'_empty] at hx + simp at hx + +theorem consRootCheckNLctxWF : consRootCheckNLctx.WF := by + simpa [consRootCheckNLctx] using + (LocalContext.WF.mkLocalDecl consRootCheckAlphaLctxWF + consRootCheckNFresh) + +theorem consRootCheckAlphaFindInN : + consRootCheckNLctx.find? consRootCheckAlphaId = + some (.cdecl 0 consRootCheckAlphaId consAlphaName + (.sort (.succ (.param `u))) .implicit .default) := by + rw [consRootCheckNLctxWF.find?_eq_find?_toList] + simp [consRootCheckNLctx, consRootCheckNId, + consRootCheckNatState, consRootCheckAlphaState, + consRootCheckAlphaLctx, consRootCheckAlphaId, + nilRootSortState, replayInsert, consRootContext, ctorContext, + LocalContext.mkLocalDecl_toList, LocalContext.mkLocalDecl, + LocalContext.toList, LocalDecl.fvarId, + NameGenerator.next, NameGenerator.curr] + +theorem consRootCheckAlphaMiss : + consRootCheckNState.inferTypeC[ + (.fvar consRootCheckAlphaId : Expr)]? = none := by + simp [consRootCheckNState, consRootCheckNatState, + consRootCheckAlphaState, nilRootSortState, replayInsert] + +def consRootCheckHeadDomainState : TypeChecker.State := + replayInsert consRootCheckNState (.fvar consRootCheckAlphaId) + (.sort (.succ (.param `u))) + +theorem replayInferConsRootHeadDomain (fuel : Nat) : + TypeChecker.Inner.inferType' (.fvar consRootCheckAlphaId) false + (TypeChecker.Methods.withFuel fuel) + (tcContext consRootCheckNLctx) consRootCheckNState = + .ok (.sort (.succ (.param `u)), + consRootCheckHeadDomainState) := by + simpa [consRootCheckHeadDomainState, replayInsert] using + (inferTypeFVarCore fuel consRootCheckNLctx consRootCheckNState + consRootCheckAlphaId (.sort (.succ (.param `u))) + consRootCheckAlphaMiss consRootCheckAlphaFindInN) + +def consRootCheckHeadId : FVarId := + ⟨consRootCheckHeadDomainState.ngen.curr⟩ + +def consRootCheckHeadLctx : LocalContext := + consRootCheckNLctx.mkLocalDecl consRootCheckHeadId + consHeadName (.fvar consRootCheckAlphaId) .default + +def consRootCheckHeadState : TypeChecker.State := + { consRootCheckHeadDomainState with + ngen := consRootCheckHeadDomainState.ngen.next } + +theorem consRootCheckHeadFresh : + consRootCheckNLctx.find? consRootCheckHeadId = none := by + have h := LocalContext.WF.find?_eq_find?_toList + (fv := consRootCheckHeadId) consRootCheckNLctxWF + rw [h] + simp [consRootCheckHeadId, consRootCheckHeadDomainState, + consRootCheckNState, consRootCheckNId, consRootCheckNatState, + consRootCheckAlphaState, consRootCheckAlphaLctx, + consRootCheckAlphaId, nilRootSortState, replayInsert, + consRootCheckNLctx, consRootContext, ctorContext, + LocalContext.mkLocalDecl_toList, LocalContext.mkLocalDecl, + LocalContext.toList, LocalDecl.fvarId, + NameGenerator.next, NameGenerator.curr] + intro x hx + change some x ∈ + (PersistentArray.empty : PersistentArray (Option LocalDecl)).toList' at hx + rw [PersistentArray.toList'_empty] at hx + simp at hx + +theorem consRootCheckHeadLctxWF : consRootCheckHeadLctx.WF := by + simpa [consRootCheckHeadLctx] using + (LocalContext.WF.mkLocalDecl consRootCheckNLctxWF + consRootCheckHeadFresh) + +theorem consRootCheckNFind : + consRootCheckHeadLctx.find? consRootCheckNId = + some (.cdecl 1 consRootCheckNId consNName + (.const ``Nat []) .implicit .default) := by + rw [consRootCheckHeadLctxWF.find?_eq_find?_toList] + simp [consRootCheckHeadLctx, consRootCheckHeadId, + consRootCheckHeadDomainState, consRootCheckNState, + consRootCheckNLctx, consRootCheckNId, consRootCheckNatState, + consRootCheckAlphaState, consRootCheckAlphaLctx, + consRootCheckAlphaId, nilRootSortState, replayInsert, + consRootContext, ctorContext, + LocalContext.mkLocalDecl_toList, LocalContext.mkLocalDecl, + LocalContext.toList, LocalDecl.fvarId, + NameGenerator.next, NameGenerator.curr] + +@[simp] theorem replayConsRootAlphaIdBeqNId : + ((.fvar consRootCheckAlphaId : Expr) == + .fvar consRootCheckNId) = false := by + change Expr.eqv (.fvar consRootCheckAlphaId) + (.fvar consRootCheckNId) = false + rw [Expr.eqv_eq] + simp [Expr.eqv', consRootCheckAlphaId, consRootCheckNId, + consRootCheckNatState, consRootCheckAlphaState, + nilRootSortState, replayInsert, + NameGenerator.next, NameGenerator.curr] + +@[simp] theorem replayConsRootNIdBeqAlphaId : + ((.fvar consRootCheckNId : Expr) == + .fvar consRootCheckAlphaId) = false := by + change Expr.eqv (.fvar consRootCheckNId) + (.fvar consRootCheckAlphaId) = false + rw [Expr.eqv_eq] + simp [Expr.eqv', consRootCheckAlphaId, consRootCheckNId, + consRootCheckNatState, consRootCheckAlphaState, + nilRootSortState, replayInsert, + NameGenerator.next, NameGenerator.curr] + +theorem consRootCheckAlphaCache : + consRootCheckHeadState.inferTypeC[ + (.fvar consRootCheckAlphaId : Expr)]? = + some (.sort (.succ (.param `u))) := by + change consRootCheckHeadDomainState.inferTypeC[ + (.fvar consRootCheckAlphaId : Expr)]? = + some (.sort (.succ (.param `u))) + unfold consRootCheckHeadDomainState replayInsert + rw [Std.HashMap.getElem?_insert] + rw [beq_self_eq_true] + rfl + +theorem consRootCheckFamilyMiss : + consRootCheckHeadState.inferTypeC[ + (.const ``IndexedVec [.param `u] : Expr)]? = none := by + simp [consRootCheckHeadState, consRootCheckHeadDomainState, + consRootCheckNState, consRootCheckNatState, + consRootCheckAlphaState, nilRootSortState, replayInsert] + +theorem consRootCheckFirstAppMiss : + consRootCheckHeadState.inferTypeC[ + replayFirstApp (.fvar consRootCheckAlphaId)]? = none := by + simp [consRootCheckHeadState, consRootCheckHeadDomainState, + consRootCheckNState, consRootCheckNatState, + consRootCheckAlphaState, nilRootSortState, + replayInsert, replayFirstApp] + +def consRootCheckFirstAppState : TypeChecker.State := + replayInsert + (replayInsert consRootCheckHeadState + (.const ``IndexedVec [.param `u]) indexedVecInfo.type) + (replayFirstApp (.fvar consRootCheckAlphaId)) vecFamilyTail + +theorem consRootCheckNMiss : + consRootCheckFirstAppState.inferTypeC[ + (.fvar consRootCheckNId : Expr)]? = none := by + simp [consRootCheckFirstAppState, consRootCheckHeadState, + consRootCheckHeadDomainState, consRootCheckNState, + consRootCheckNatState, consRootCheckAlphaState, + nilRootSortState, replayInsert, replayFirstApp] + +theorem consRootCheckTailMiss : + consRootCheckHeadState.inferTypeC[ + ctorIndexedVecApp (.fvar consRootCheckAlphaId) + (.fvar consRootCheckNId)]? = none := by + simp [consRootCheckHeadState, consRootCheckHeadDomainState, + consRootCheckNState, consRootCheckNatState, + consRootCheckAlphaState, nilRootSortState, + replayInsert, ctorIndexedVecApp] + +def consRootCheckNInferState : TypeChecker.State := + replayInsert consRootCheckFirstAppState + (.fvar consRootCheckNId) (.const ``Nat []) + +def consRootCheckTailDomainState : TypeChecker.State := + replayInsert consRootCheckNInferState + (ctorIndexedVecApp (.fvar consRootCheckAlphaId) + (.fvar consRootCheckNId)) + (.sort (.succ (.param `u))) + +theorem replayInferConsRootTailDomain (fuel : Nat) : + TypeChecker.Inner.inferType' + (ctorIndexedVecApp (.fvar consRootCheckAlphaId) + (.fvar consRootCheckNId)) false + (TypeChecker.Methods.withFuel fuel) + (tcContext consRootCheckHeadLctx) consRootCheckHeadState = + .ok (.sort (.succ (.param `u)), + consRootCheckTailDomainState) := by + simpa [consRootCheckFirstAppState, consRootCheckNInferState, + consRootCheckTailDomainState] using + (replayInferTailDomainAlphaCachedCore fuel + consRootCheckHeadLctx consRootCheckHeadState + consRootCheckAlphaId consRootCheckNId + consRootCheckAlphaCache consRootCheckFamilyMiss + consRootCheckFirstAppMiss consRootCheckNMiss + consRootCheckTailMiss consRootCheckNFind) + +def consRootCheckTailId : FVarId := + ⟨consRootCheckTailDomainState.ngen.curr⟩ + +def consRootCheckTailLctx : LocalContext := + consRootCheckHeadLctx.mkLocalDecl consRootCheckTailId + consTailName + (ctorIndexedVecApp (.fvar consRootCheckAlphaId) + (.fvar consRootCheckNId)) .default + +def consRootCheckTailState : TypeChecker.State := + { consRootCheckTailDomainState with + ngen := consRootCheckTailDomainState.ngen.next } + +theorem consRootCheckTailFirstCache : + consRootCheckTailState.inferTypeC[ + replayFirstApp (.fvar consRootCheckAlphaId)]? = + some vecFamilyTail := by + change consRootCheckTailDomainState.inferTypeC[ + replayFirstApp (.fvar consRootCheckAlphaId)]? = some vecFamilyTail + unfold consRootCheckTailDomainState replayInsert + rw [Std.HashMap.getElem?_insert] + rw [replayIndexedVecAppBeqFirstApp] + simp only [Bool.false_eq_true, if_false] + unfold consRootCheckNInferState replayInsert + rw [Std.HashMap.getElem?_insert] + rw [show ((.fvar consRootCheckNId : Expr) == + replayFirstApp (.fvar consRootCheckAlphaId)) = false by + exact replayFVarBeqApp consRootCheckNId + (.const ``IndexedVec [.param `u]) + (.fvar consRootCheckAlphaId)] + simp only [Bool.false_eq_true, if_false] + unfold consRootCheckFirstAppState replayInsert + rw [Std.HashMap.getElem?_insert] + rw [beq_self_eq_true] + rfl + +theorem consRootCheckTailNCache : + consRootCheckTailState.inferTypeC[ + (.fvar consRootCheckNId : Expr)]? = some (.const ``Nat []) := by + change consRootCheckTailDomainState.inferTypeC[ + (.fvar consRootCheckNId : Expr)]? = some (.const ``Nat []) + unfold consRootCheckTailDomainState replayInsert + rw [Std.HashMap.getElem?_insert] + rw [show (ctorIndexedVecApp (.fvar consRootCheckAlphaId) + (.fvar consRootCheckNId) == + (.fvar consRootCheckNId : Expr)) = false by + exact replayAppBeqFVar + ((.const ``IndexedVec [.param `u] : Expr).app + (.fvar consRootCheckAlphaId)) + (.fvar consRootCheckNId) consRootCheckNId] + simp only [Bool.false_eq_true, if_false] + unfold consRootCheckNInferState replayInsert + rw [Std.HashMap.getElem?_insert] + rw [beq_self_eq_true] + rfl + +theorem consRootCheckTailSuccMiss : + consRootCheckTailState.inferTypeC[ + (.const ``Nat.succ [] : Expr)]? = none := by + simp [consRootCheckTailState, consRootCheckTailDomainState, + consRootCheckNInferState, consRootCheckFirstAppState, + consRootCheckHeadState, consRootCheckHeadDomainState, + consRootCheckNState, consRootCheckNatState, + consRootCheckAlphaState, nilRootSortState, + replayInsert, ctorIndexedVecApp, replayFirstApp] + +theorem consRootCheckTailSuccAppMiss : + consRootCheckTailState.inferTypeC[ + replaySuccApp (.fvar consRootCheckNId)]? = none := by + simp [consRootCheckTailState, consRootCheckTailDomainState, + consRootCheckNInferState, consRootCheckFirstAppState, + consRootCheckHeadState, consRootCheckHeadDomainState, + consRootCheckNState, consRootCheckNatState, + consRootCheckAlphaState, nilRootSortState, + replayInsert, ctorIndexedVecApp, replayFirstApp, replaySuccApp] + +theorem consRootCheckTailTerminalMiss : + consRootCheckTailState.inferTypeC[ + ctorIndexedVecApp (.fvar consRootCheckAlphaId) + (replaySuccApp (.fvar consRootCheckNId))]? = none := by + simp [consRootCheckTailState, consRootCheckTailDomainState, + consRootCheckNInferState, consRootCheckFirstAppState, + consRootCheckHeadState, consRootCheckHeadDomainState, + consRootCheckNState, consRootCheckNatState, + consRootCheckAlphaState, nilRootSortState, + replayInsert, ctorIndexedVecApp, replayFirstApp, replaySuccApp] + +def consRootCheckSuccState : TypeChecker.State := + replayInsert consRootCheckTailState (.const ``Nat.succ []) + (.forallE `n (.const ``Nat []) (.const ``Nat []) .default) + +def consRootCheckSuccAppState : TypeChecker.State := + replayInsert consRootCheckSuccState + (replaySuccApp (.fvar consRootCheckNId)) (.const ``Nat []) + +def consRootCheckTerminalState : TypeChecker.State := + replayInsert consRootCheckSuccAppState + (ctorIndexedVecApp (.fvar consRootCheckAlphaId) + (replaySuccApp (.fvar consRootCheckNId))) + (.sort (.succ (.param `u))) + +theorem replayInferConsRootTerminal (fuel : Nat) : + TypeChecker.Inner.inferType' + (ctorIndexedVecApp (.fvar consRootCheckAlphaId) + (replaySuccApp (.fvar consRootCheckNId))) false + (TypeChecker.Methods.withFuel fuel) + (tcContext consRootCheckTailLctx) consRootCheckTailState = + .ok (.sort (.succ (.param `u)), + consRootCheckTerminalState) := by + simpa [consRootCheckSuccState, consRootCheckSuccAppState, + consRootCheckTerminalState] using + (replayInferIndexedVecSuccFromCacheCore fuel + consRootCheckTailLctx consRootCheckTailState + consRootCheckAlphaId consRootCheckNId + consRootCheckTailFirstCache consRootCheckTailSuccMiss + consRootCheckTailNCache consRootCheckTailSuccAppMiss + consRootCheckTailTerminalMiss) + +open private mkLevelIMaxCore mkLevelMaxCore from Lean.Level in +@[simp] theorem replayMkLevelIMaxSuccSuccParamSuccParam : + mkLevelIMax' (.succ (.succ (.param `u))) + (.succ (.param `u)) = .succ (.succ (.param `u)) := by + simp [mkLevelIMax', mkLevelIMaxCore, mkLevelMax', mkLevelMaxCore, + Level.isNeverZero, Level.isZero, Level.isExplicit, + Level.hasMVar', Level.hasParam', Level.getOffset, + Level.getOffsetAux, Level.getLevelOffset] + +theorem replayConsRootCheckTypeM : + TypeChecker.M.run ctorEnv .safe consRootContext.lctx [`u] + ({} : FuelConfig) (TypeChecker.checkType indexedVecConsInfo.type) = + .ok (.sort (.succ (.succ (.param `u)))) := by + change Except.map (fun x : Expr × TypeChecker.State => x.1) + (TypeChecker.Inner.inferType indexedVecConsInfo.type false + (TypeChecker.Methods.withFuel 10000) + (tcContext consRootContext.lctx) ({} : TypeChecker.State)) = _ + rw [consInfoTypeShape] + change Except.map (fun x : Expr × TypeChecker.State => x.1) + (TypeChecker.Inner.inferType' consCtorTypeRaw false + (TypeChecker.Methods.withFuel 9999) + (tcContext consRootContext.lctx) ({} : TypeChecker.State)) = _ + unfold consCtorTypeRaw consNTypeRaw consHeadTypeRaw + consTailTypeRaw consTerminalRaw TypeChecker.Inner.inferType' + simp [Expr.hasLooseBVars, Expr.looseBVarRange', + TypeChecker.Inner.inferForall, TypeChecker.Inner.inferForall.loop, + Bind.bind, ReaderT.bind, StateT.bind, Except.bind] + rw [replayInferConsRootSort] + simp only [ensureSortExact] + rw [withLocalDeclEq] + simp [Expr.instantiate1'] + have hnat : + TypeChecker.Inner.inferType (.const ``Nat []) false + (TypeChecker.Methods.withFuel 9999) + (tcContext consRootCheckAlphaLctx) consRootCheckAlphaState = + .ok (.sort (.succ .zero), consRootCheckNatState) := by + change TypeChecker.Inner.inferType' (.const ``Nat []) false + (TypeChecker.Methods.withFuel 9998) + (tcContext consRootCheckAlphaLctx) consRootCheckAlphaState = _ + exact replayInferConsRootNat 9998 + simp only [consRootCheckAlphaLctx, consRootCheckAlphaId, + consRootCheckAlphaState, tcContext] at hnat + simp only [tcContext] + simp only [Bind.bind, ReaderT.bind, StateT.bind, Except.bind] + rw [hnat] + simp only [ensureSortExact] + rw [withLocalDeclEq] + simp [Expr.instantiate1'] + have hhead : + TypeChecker.Inner.inferType (.fvar consRootCheckAlphaId) false + (TypeChecker.Methods.withFuel 9999) + (tcContext consRootCheckNLctx) consRootCheckNState = + .ok (.sort (.succ (.param `u)), + consRootCheckHeadDomainState) := by + change TypeChecker.Inner.inferType' + (.fvar consRootCheckAlphaId) false + (TypeChecker.Methods.withFuel 9998) + (tcContext consRootCheckNLctx) consRootCheckNState = _ + exact replayInferConsRootHeadDomain 9998 + simp only [consRootCheckNLctx, consRootCheckNId, + consRootCheckNState, consRootCheckAlphaLctx, + consRootCheckAlphaId, tcContext] at hhead + simp only [Bind.bind, ReaderT.bind, StateT.bind, Except.bind] + rw [hhead] + simp only [ensureSortExact] + rw [withLocalDeclEq] + simp [Expr.instantiate1'] + have htail : + TypeChecker.Inner.inferType + (((.const ``IndexedVec [.param `u] : Expr).app + (.fvar consRootCheckAlphaId)).app + (.fvar consRootCheckNId)) false + (TypeChecker.Methods.withFuel 9999) + (tcContext consRootCheckHeadLctx) consRootCheckHeadState = + .ok (.sort (.succ (.param `u)), + consRootCheckTailDomainState) := by + change TypeChecker.Inner.inferType' + (((.const ``IndexedVec [.param `u] : Expr).app + (.fvar consRootCheckAlphaId)).app + (.fvar consRootCheckNId)) false + (TypeChecker.Methods.withFuel 9998) + (tcContext consRootCheckHeadLctx) consRootCheckHeadState = _ + simpa [ctorIndexedVecApp] using + replayInferConsRootTailDomain 9998 + simp only [consRootCheckHeadLctx, consRootCheckHeadId, + consRootCheckHeadState, consRootCheckNLctx, consRootCheckNId, + consRootCheckAlphaLctx, consRootCheckAlphaId, + tcContext] at htail + simp only [Bind.bind, ReaderT.bind, StateT.bind, Except.bind] + rw [htail] + simp only [ensureSortExact] + rw [withLocalDeclEq] + simp [Expr.instantiate1'] + have hterminal : + TypeChecker.Inner.inferType + (((.const ``IndexedVec [.param `u] : Expr).app + (.fvar consRootCheckAlphaId)).app + ((.const ``Nat.succ [] : Expr).app + (.fvar consRootCheckNId))) false + (TypeChecker.Methods.withFuel 9999) + (tcContext consRootCheckTailLctx) consRootCheckTailState = + .ok (.sort (.succ (.param `u)), + consRootCheckTerminalState) := by + change TypeChecker.Inner.inferType' + (((.const ``IndexedVec [.param `u] : Expr).app + (.fvar consRootCheckAlphaId)).app + ((.const ``Nat.succ [] : Expr).app + (.fvar consRootCheckNId))) false + (TypeChecker.Methods.withFuel 9998) + (tcContext consRootCheckTailLctx) consRootCheckTailState = _ + simpa [ctorIndexedVecApp, replaySuccApp] using + replayInferConsRootTerminal 9998 + simp only [consRootCheckTailLctx, consRootCheckTailId, + consRootCheckTailState, consRootCheckHeadLctx, + consRootCheckHeadId, consRootCheckNLctx, consRootCheckNId, + consRootCheckAlphaLctx, consRootCheckAlphaId, + ctorIndexedVecApp, tcContext] at hterminal + simp only [Bind.bind, ReaderT.bind, StateT.bind, Except.bind] + rw [hterminal] + simp only [ensureSortExact] + simp [Expr.sortLevel!, Pure.pure, ReaderT.pure, + StateT.pure, Except.pure] + rfl + +/-! ## Source-indexed candidate trace -/ + +def consAlphaAnnotations : + AddInductive.CandidateTypeAnnotations + (.sort (.succ (.param `u))) where + consumed := .sort (.succ (.param `u)) + trace := .identity _ + +def consNatAnnotations : + AddInductive.CandidateTypeAnnotations (.const ``Nat []) where + consumed := .const ``Nat [] + trace := .identity _ + +def consHeadAnnotations : + AddInductive.CandidateTypeAnnotations consAlphaExpr where + consumed := consAlphaExpr + trace := .identity _ + +def consTailAnnotations : + AddInductive.CandidateTypeAnnotations consTailDomain where + consumed := consTailDomain + trace := .identity _ + +theorem consAlphaAnnotationTraceBuild : + AddInductive.CandidateTypeAnnotationTrace.build + (.sort (.succ (.param `u))) = + ⟨.sort (.succ (.param `u)), .identity _⟩ := by + simp [AddInductive.CandidateTypeAnnotationTrace.build] + +theorem consNatAnnotationTraceBuild : + AddInductive.CandidateTypeAnnotationTrace.build (.const ``Nat []) = + ⟨.const ``Nat [], .identity _⟩ := by + simp [AddInductive.CandidateTypeAnnotationTrace.build] + +theorem consHeadAnnotationTraceBuild : + AddInductive.CandidateTypeAnnotationTrace.build consAlphaExpr = + ⟨consAlphaExpr, .identity _⟩ := by + simp [AddInductive.CandidateTypeAnnotationTrace.build, + consAlphaExprShape] + +theorem consTailAnnotationTraceBuild : + AddInductive.CandidateTypeAnnotationTrace.build consTailDomain = + ⟨consTailDomain, .identity _⟩ := by + simp [AddInductive.CandidateTypeAnnotationTrace.build, + consTailDomain, consAlphaExprShape, consNExprShape] + +theorem consAlphaAnnotationsBuild : + AddInductive.buildCandidateTypeAnnotations + (.sort (.succ (.param `u))) = .ok consAlphaAnnotations := by + unfold AddInductive.buildCandidateTypeAnnotations + rw [consAlphaAnnotationTraceBuild] + rfl + +theorem consNatAnnotationsBuild : + AddInductive.buildCandidateTypeAnnotations (.const ``Nat []) = + .ok consNatAnnotations := by + unfold AddInductive.buildCandidateTypeAnnotations + rw [consNatAnnotationTraceBuild] + rfl + +theorem consHeadAnnotationsBuild : + AddInductive.buildCandidateTypeAnnotations consAlphaExpr = + .ok consHeadAnnotations := by + unfold AddInductive.buildCandidateTypeAnnotations + rw [consHeadAnnotationTraceBuild] + rfl + +theorem consTailAnnotationsBuild : + AddInductive.buildCandidateTypeAnnotations consTailDomain = + .ok consTailAnnotations := by + unfold AddInductive.buildCandidateTypeAnnotations + rw [consTailAnnotationTraceBuild] + rfl + +theorem consAlphaAnnotationsEq : + AddInductive.CandidateIsDefEqStep.Valid + ⟨consRootContext, (.sort (.succ (.param `u))), + consAlphaAnnotations.consumed⟩ := by + simpa [consAlphaAnnotations] using + (candidateIsDefEqSelfValid consRootContext + (.sort (.succ (.param `u))) 9999 rfl) + +theorem consNatAnnotationsEq : + AddInductive.CandidateIsDefEqStep.Valid + ⟨consAlphaContext, (.const ``Nat []), + consNatAnnotations.consumed⟩ := by + simpa [consNatAnnotations] using + (candidateIsDefEqSelfValid consAlphaContext + (.const ``Nat []) 9999 rfl) + +theorem consHeadAnnotationsEq : + AddInductive.CandidateIsDefEqStep.Valid + ⟨consNContext, consAlphaExpr, + consHeadAnnotations.consumed⟩ := by + simpa [consHeadAnnotations] using + (candidateIsDefEqSelfValid consNContext consAlphaExpr 9999 rfl) + +theorem consTailAnnotationsEq : + AddInductive.CandidateIsDefEqStep.Valid + ⟨consHeadContext, consTailDomain, + consTailAnnotations.consumed⟩ := by + simpa [consTailAnnotations] using + (candidateIsDefEqSelfValid consHeadContext consTailDomain 9999 rfl) + +theorem consRootCheckValid : + AddInductive.CandidateCheckTypeStep.Valid + ⟨consRootContext, indexedVecConsInfo.type, + .sort (.succ (.succ (.param `u)))⟩ := by + simpa [AddInductive.CandidateCheckTypeStep.Valid, + consRootContext, ctorContext] using + replayConsRootCheckTypeM + +theorem consRootWhnfValid : + AddInductive.CandidateWhnfStep.Valid + ⟨consRootContext, indexedVecConsInfo.type, + indexedVecConsInfo.type⟩ := by + simpa [AddInductive.CandidateWhnfStep.Valid, + consRootContext, ctorContext] using replayConsRootWhnfM + +theorem consAfterAlphaCheckValid : + AddInductive.CandidateCheckTypeStep.Valid + ⟨consAlphaContext, consAfterAlpha, + .sort (.succ (.param `u))⟩ := by + simpa [AddInductive.CandidateCheckTypeStep.Valid, + consAlphaContext, consRootContext, ctorContext, + AddInductive.Context.pushLocalDecl] using + replayConsAfterAlphaCheckTypeM + +theorem consAfterAlphaWhnfValid : + AddInductive.CandidateWhnfStep.Valid + ⟨consAlphaContext, consAfterAlpha, consAfterAlpha⟩ := by + simpa [AddInductive.CandidateWhnfStep.Valid, + consAlphaContext, consRootContext, ctorContext, + AddInductive.Context.pushLocalDecl] using + replayConsAfterAlphaWhnfM + +theorem consAfterNCheckValid : + AddInductive.CandidateCheckTypeStep.Valid + ⟨consNContext, consAfterN, .sort (.succ (.param `u))⟩ := by + simpa [AddInductive.CandidateCheckTypeStep.Valid, + consNContext, consAlphaContext, consRootContext, ctorContext, + AddInductive.Context.pushLocalDecl] using + replayConsAfterNCheckTypeM + +theorem consAfterNWhnfValid : + AddInductive.CandidateWhnfStep.Valid + ⟨consNContext, consAfterN, consAfterN⟩ := by + simpa [AddInductive.CandidateWhnfStep.Valid, + consNContext, consAlphaContext, consRootContext, ctorContext, + AddInductive.Context.pushLocalDecl] using + replayConsAfterNWhnfM + +theorem consAfterHeadCheckValid : + AddInductive.CandidateCheckTypeStep.Valid + ⟨consHeadContext, consAfterHead, + .sort (.succ (.param `u))⟩ := by + simpa [AddInductive.CandidateCheckTypeStep.Valid, + consHeadContext, consNContext, consAlphaContext, + consRootContext, ctorContext, AddInductive.Context.pushLocalDecl] using + replayConsAfterHeadCheckTypeM + +theorem consAfterHeadWhnfValid : + AddInductive.CandidateWhnfStep.Valid + ⟨consHeadContext, consAfterHead, consAfterHead⟩ := by + simpa [AddInductive.CandidateWhnfStep.Valid, + consHeadContext, consNContext, consAlphaContext, + consRootContext, ctorContext, AddInductive.Context.pushLocalDecl] using + replayConsAfterHeadWhnfM + +theorem consTerminalCheckValid : + AddInductive.CandidateCheckTypeStep.Valid + ⟨consTailContext, consTerminal, + .sort (.succ (.param `u))⟩ := by + simpa [AddInductive.CandidateCheckTypeStep.Valid, + consTailContext, consHeadContext, consNContext, consAlphaContext, + consRootContext, ctorContext, AddInductive.Context.pushLocalDecl] using + replayConsTerminalCheckTypeM + +theorem consTerminalWhnfValid : + AddInductive.CandidateWhnfStep.Valid + ⟨consTailContext, consTerminal, consTerminal⟩ := by + simpa [AddInductive.CandidateWhnfStep.Valid, + consTailContext, consHeadContext, consNContext, consAlphaContext, + consRootContext, ctorContext, AddInductive.Context.pushLocalDecl] using + replayConsTerminalWhnfM + +theorem consAlphaDomainCheckValid : + AddInductive.CandidateCheckTypeStep.Valid + ⟨consRootContext, (.sort (.succ (.param `u))), + .sort (.succ (.succ (.param `u)))⟩ := by + simpa [AddInductive.CandidateCheckTypeStep.Valid, + consRootContext, nilCandidateContext, ctorContext] using + nilDomainCheckValid + +theorem consAlphaDomainWhnfValid : + AddInductive.CandidateWhnfStep.Valid + ⟨consRootContext, (.sort (.succ (.param `u))), + .sort (.succ (.param `u))⟩ := by + simpa [AddInductive.CandidateWhnfStep.Valid, + consRootContext, nilCandidateContext, ctorContext] using + nilDomainWhnfValid + +theorem consNatDomainCheckValid : + AddInductive.CandidateCheckTypeStep.Valid + ⟨consAlphaContext, (.const ``Nat []), + .sort (.succ .zero)⟩ := by + simpa [AddInductive.CandidateCheckTypeStep.Valid, + consAlphaContext, consRootContext, ctorContext, + AddInductive.Context.pushLocalDecl] using + ctorNatCheckTypeM consAlphaContext.lctx + +theorem consNatDomainWhnfValid : + AddInductive.CandidateWhnfStep.Valid + ⟨consAlphaContext, (.const ``Nat []), (.const ``Nat [])⟩ := by + simpa [AddInductive.CandidateWhnfStep.Valid, + consAlphaContext, consRootContext, ctorContext, + AddInductive.Context.pushLocalDecl] using + ctorNatWhnfM consAlphaContext.lctx + +theorem consHeadDomainCheckValid : + AddInductive.CandidateCheckTypeStep.Valid + ⟨consNContext, consAlphaExpr, + .sort (.succ (.param `u))⟩ := by + simpa [AddInductive.CandidateCheckTypeStep.Valid, + consAlphaExprShape, consNContext, consAlphaContext, + consRootContext, ctorContext, AddInductive.Context.pushLocalDecl] using + (ctorFVarCheckTypeM consNContext.lctx consAlphaId + (.sort (.succ (.param `u))) consAlphaFindInN) + +theorem consHeadDomainWhnfValid : + AddInductive.CandidateWhnfStep.Valid + ⟨consNContext, consAlphaExpr, consAlphaExpr⟩ := by + simpa [AddInductive.CandidateWhnfStep.Valid, + consAlphaExprShape, consNContext, consAlphaContext, + consRootContext, ctorContext, AddInductive.Context.pushLocalDecl] using + (ctorFVarWhnfM consNContext.lctx consAlphaId consAlphaFindInN) + +theorem consTailDomainCheckValid : + AddInductive.CandidateCheckTypeStep.Valid + ⟨consHeadContext, consTailDomain, + .sort (.succ (.param `u))⟩ := by + simpa [AddInductive.CandidateCheckTypeStep.Valid, + consHeadContext, consNContext, consAlphaContext, + consRootContext, ctorContext, AddInductive.Context.pushLocalDecl] using + replayConsTailDomainCheckTypeM + +theorem consTailDomainWhnfValid : + AddInductive.CandidateWhnfStep.Valid + ⟨consHeadContext, consTailDomain, consTailDomain⟩ := by + simpa [AddInductive.CandidateWhnfStep.Valid, + consHeadContext, consNContext, consAlphaContext, + consRootContext, ctorContext, AddInductive.Context.pushLocalDecl] using + replayConsTailDomainWhnfM + +def consAlphaDomainCandidateTrace : + AddInductive.CandidateExprTrace consRootContext + (.sort (.succ (.param `u))) := + .terminal consRootContext (.sort (.succ (.param `u))) + (.sort (.succ (.succ (.param `u)))) + (.sort (.succ (.param `u))) + consAlphaDomainCheckValid consAlphaDomainWhnfValid + +def consNatDomainCandidateTrace : + AddInductive.CandidateExprTrace consAlphaContext + (.const ``Nat []) := + .terminal consAlphaContext (.const ``Nat []) + (.sort (.succ .zero)) (.const ``Nat []) + consNatDomainCheckValid consNatDomainWhnfValid + +def consHeadDomainCandidateTrace : + AddInductive.CandidateExprTrace consNContext consAlphaExpr := + .terminal consNContext consAlphaExpr + (.sort (.succ (.param `u))) consAlphaExpr + consHeadDomainCheckValid consHeadDomainWhnfValid + +def consTailDomainCandidateTrace : + AddInductive.CandidateExprTrace consHeadContext consTailDomain := + .terminal consHeadContext consTailDomain + (.sort (.succ (.param `u))) consTailDomain + consTailDomainCheckValid consTailDomainWhnfValid + +def consTerminalCandidateTrace : + AddInductive.CandidateExprTrace consTailContext + (consAfterHead.bindingBody!.instantiate1 + consHeadContext.freshExpr) := + .terminal consTailContext + (consAfterHead.bindingBody!.instantiate1 consHeadContext.freshExpr) + (.sort (.succ (.param `u))) consTerminal + (by simpa only [consTerminalShape] using consTerminalCheckValid) + (by simpa only [consTerminalShape] using consTerminalWhnfValid) + +def consAfterHeadCandidateTrace : + AddInductive.CandidateExprTrace consHeadContext + (consAfterN.bindingBody!.instantiate1 consNContext.freshExpr) := + .forallE consHeadContext + (consAfterN.bindingBody!.instantiate1 consNContext.freshExpr) + (.sort (.succ (.param `u))) consTailName consTailDomain + consAfterHead.bindingBody! .default consHeadContextFresh + consTailAnnotations consTailAnnotationsEq + (by simpa only [consAfterHeadShape] using consAfterHeadCheckValid) + (by + simpa [consAfterN, consAfterHead, consTailDomain, + consAlphaExpr, consNExpr, consRootContext, consAlphaContext, + consNContext, ctorContext, AddInductive.Context.pushLocalDecl, + AddInductive.Context.freshExpr, Expr.bindingBody!, + Expr.instantiate1_eq, Expr.instantiate1', + Expr.liftLooseBVars_zero] using + consAfterHeadWhnfValid) + consTailDomainCandidateTrace consTerminalCandidateTrace + +def consAfterNCandidateTrace : + AddInductive.CandidateExprTrace consNContext + (consAfterAlpha.bindingBody!.instantiate1 + consAlphaContext.freshExpr) := + .forallE consNContext + (consAfterAlpha.bindingBody!.instantiate1 + consAlphaContext.freshExpr) + (.sort (.succ (.param `u))) consHeadName consAlphaExpr + consAfterN.bindingBody! .default consNContextFresh + consHeadAnnotations consHeadAnnotationsEq + (by simpa only [consAfterNShape] using consAfterNCheckValid) + (by + simpa [consAfterAlpha, consAfterN, consAlphaExpr, consNExpr, + consRootContext, consAlphaContext, ctorContext, + AddInductive.Context.pushLocalDecl, + AddInductive.Context.freshExpr, Expr.bindingBody!, + Expr.instantiate1_eq, Expr.instantiate1', + Expr.liftLooseBVars_zero] using + consAfterNWhnfValid) + consHeadDomainCandidateTrace consAfterHeadCandidateTrace + +def consAfterAlphaCandidateTrace : + AddInductive.CandidateExprTrace consAlphaContext + (consNTypeRaw.instantiate1 consRootContext.freshExpr) := + .forallE consAlphaContext + (consNTypeRaw.instantiate1 consRootContext.freshExpr) + (.sort (.succ (.param `u))) consNName (.const ``Nat []) + consAfterAlpha.bindingBody! .implicit consAlphaContextFresh + consNatAnnotations consNatAnnotationsEq + (by simpa only [consAfterAlphaShape] using consAfterAlphaCheckValid) + (by + simpa [consNTypeRaw, consHeadTypeRaw, consTailTypeRaw, + consTerminalRaw, consAfterAlpha, consAlphaExpr, + consRootContext, ctorContext, AddInductive.Context.freshExpr, + Expr.bindingBody!, Expr.instantiate1_eq, Expr.instantiate1', + Expr.liftLooseBVars_zero] using + consAfterAlphaWhnfValid) + consNatDomainCandidateTrace consAfterNCandidateTrace + +def consCandidateTrace : + AddInductive.CandidateExprTrace consRootContext + indexedVecConsInfo.type := + .forallE consRootContext indexedVecConsInfo.type + (.sort (.succ (.succ (.param `u)))) consAlphaName + (.sort (.succ (.param `u))) consNTypeRaw .implicit consRootFresh + consAlphaAnnotations consAlphaAnnotationsEq consRootCheckValid + (by + simpa [consInfoTypeShape, consCtorTypeRaw] using consRootWhnfValid) + consAlphaDomainCandidateTrace consAfterAlphaCandidateTrace + +def consCandidate : AddInductive.CandidateExpr indexedVecConsInfo.type := + ⟨consRootContext, consCandidateTrace⟩ + +theorem consCandidate_view_eq : + consCandidate.view = indexedVecConsInfo.type := by + have habstract (context : AddInductive.Context) (e : Expr) : + e.abstract #[context.freshExpr] = + Expr.abstract1 context.freshFVarId e := by + rw [show #[context.freshExpr] = + ⟨[context.freshFVarId].map Expr.fvar⟩ by rfl] + simp only [Expr.abstract_eq, Expr.abstractList] + simp only [consCandidate, AddInductive.CandidateExpr.view, + consCandidateTrace, consAlphaDomainCandidateTrace, + consNatDomainCandidateTrace, consHeadDomainCandidateTrace, + consTailDomainCandidateTrace, consTerminalCandidateTrace, + consAfterHeadCandidateTrace, consAfterNCandidateTrace, + consAfterAlphaCandidateTrace, AddInductive.CandidateExprTrace.view] + rw [habstract, habstract, habstract, habstract] + rw [consInfoTypeShape] + simp [consCtorTypeRaw, consNTypeRaw, consHeadTypeRaw, + consTailTypeRaw, consTerminalRaw, consTerminal, consTailDomain, + consAlphaExpr, consNExpr, + consRootContext, consAlphaContext, ctorContext, + AddInductive.Context.pushLocalDecl, + AddInductive.Context.freshExpr, + AddInductive.Context.freshFVarId, + Expr.abstract1, NameGenerator.next, NameGenerator.curr] + +/-- The retained `cons` candidate preserves all four Pi nodes, their domains, +and the terminal recursive result under the exact instantiated contexts. -/ +theorem consCandidate_identity : + TypeChecker.CandidateExprIdentity consCandidate.trace := by + change TypeChecker.CandidateExprIdentity consCandidateTrace + unfold consCandidateTrace + refine .forallE (name := consAlphaName) (binderInfo := .implicit) + (body := consNTypeRaw) (annotations := consAlphaAnnotations) + consAlphaDomainCandidateTrace consAfterAlphaCandidateTrace + (by simpa [consCtorTypeRaw] using consInfoTypeShape) + rfl (.terminal rfl) ?_ + · unfold consAfterAlphaCandidateTrace + refine .forallE (name := consNName) (binderInfo := .implicit) + (body := consAfterAlpha.bindingBody!) + (annotations := consNatAnnotations) + consNatDomainCandidateTrace consAfterNCandidateTrace + (by rw [consAfterAlphaShape]; rfl) rfl (.terminal rfl) ?_ + · unfold consAfterNCandidateTrace + refine .forallE (name := consHeadName) (binderInfo := .default) + (body := consAfterN.bindingBody!) + (annotations := consHeadAnnotations) + consHeadDomainCandidateTrace consAfterHeadCandidateTrace + (by rw [consAfterNShape]; rfl) rfl (.terminal rfl) ?_ + · unfold consAfterHeadCandidateTrace + refine .forallE (name := consTailName) (binderInfo := .default) + (body := consAfterHead.bindingBody!) + (annotations := consTailAnnotations) + consTailDomainCandidateTrace consTerminalCandidateTrace + (by rw [consAfterHeadShape]; rfl) rfl (.terminal rfl) ?_ + · unfold consTerminalCandidateTrace + exact .terminal (by + simpa only [Expr.instantiate1_eq] using consTerminalShape.symm) + +theorem consAlphaDomainCandidateTraceLoop (fuel : Nat) : + AddInductive.buildCandidateExpr.loop consRootContext + (.sort (.succ (.param `u))) (fuel + 1) = + .ok consAlphaDomainCandidateTrace := by + simpa only [consAlphaDomainCandidateTrace] using + AddInductive.buildCandidateExpr_loop_of_whnf_nonForall + consRootContext (.sort (.succ (.param `u))) + (.sort (.succ (.succ (.param `u)))) + (.sort (.succ (.param `u))) fuel + consAlphaDomainCheckValid consAlphaDomainWhnfValid rfl + +theorem consNatDomainCandidateTraceLoop (fuel : Nat) : + AddInductive.buildCandidateExpr.loop consAlphaContext + (.const ``Nat []) (fuel + 1) = + .ok consNatDomainCandidateTrace := by + simpa only [consNatDomainCandidateTrace] using + AddInductive.buildCandidateExpr_loop_of_whnf_nonForall + consAlphaContext (.const ``Nat []) (.sort (.succ .zero)) + (.const ``Nat []) fuel consNatDomainCheckValid + consNatDomainWhnfValid rfl + +theorem consHeadDomainCandidateTraceLoop (fuel : Nat) : + AddInductive.buildCandidateExpr.loop consNContext consAlphaExpr + (fuel + 1) = .ok consHeadDomainCandidateTrace := by + simpa only [consHeadDomainCandidateTrace] using + AddInductive.buildCandidateExpr_loop_of_whnf_nonForall + consNContext consAlphaExpr (.sort (.succ (.param `u))) + consAlphaExpr fuel consHeadDomainCheckValid + consHeadDomainWhnfValid (by rw [consAlphaExprShape]; rfl) + +theorem consTailDomainCandidateTraceLoop (fuel : Nat) : + AddInductive.buildCandidateExpr.loop consHeadContext consTailDomain + (fuel + 1) = .ok consTailDomainCandidateTrace := by + simpa only [consTailDomainCandidateTrace] using + AddInductive.buildCandidateExpr_loop_of_whnf_nonForall + consHeadContext consTailDomain (.sort (.succ (.param `u))) + consTailDomain fuel consTailDomainCheckValid + consTailDomainWhnfValid (by rfl) + +theorem consTerminalCandidateTraceLoop (fuel : Nat) : + AddInductive.buildCandidateExpr.loop consTailContext + (consAfterHead.bindingBody!.instantiate1 + consHeadContext.freshExpr) (fuel + 1) = + .ok consTerminalCandidateTrace := by + simpa only [consTerminalCandidateTrace] using + AddInductive.buildCandidateExpr_loop_of_whnf_nonForall + consTailContext + (consAfterHead.bindingBody!.instantiate1 consHeadContext.freshExpr) + (.sort (.succ (.param `u))) consTerminal fuel + (by simpa only [consTerminalShape] using consTerminalCheckValid) + (by simpa only [consTerminalShape] using consTerminalWhnfValid) + (by rfl) + +theorem consAfterHeadCandidateTraceLoop : + AddInductive.buildCandidateExpr.loop consHeadContext + (consAfterN.bindingBody!.instantiate1 consNContext.freshExpr) 997 = + .ok consAfterHeadCandidateTrace := by + rw [show 997 = 996 + 1 by rfl] + simpa only [consAfterHeadCandidateTrace, consTailContext, + consTailAnnotations] using + (AddInductive.buildCandidateExpr_loop_of_whnf_forall + (context := consHeadContext) + (e := consAfterN.bindingBody!.instantiate1 consNContext.freshExpr) + (inferred := .sort (.succ (.param `u))) (fuel := 996) + (name := consTailName) (domain := consTailDomain) + (body := consAfterHead.bindingBody!) (binderInfo := .default) + (hfresh := consHeadContextFresh) + (annotations := consTailAnnotations) + (hannotations := consTailAnnotationsBuild) + (hannotationsEq := consTailAnnotationsEq) + (hcheck := by + simpa only [consAfterHeadShape] using consAfterHeadCheckValid) + (hrun := by + simpa [consAfterN, consAfterHead, consTailDomain, + consAlphaExpr, consNExpr, consRootContext, consAlphaContext, + consNContext, ctorContext, AddInductive.Context.pushLocalDecl, + AddInductive.Context.freshExpr, Expr.bindingBody!, + Expr.instantiate1_eq, Expr.instantiate1', + Expr.liftLooseBVars_zero] using + consAfterHeadWhnfValid) + (domainCandidate := consTailDomainCandidateTrace) + (bodyCandidate := consTerminalCandidateTrace) + (hdomain := by + simpa using consTailDomainCandidateTraceLoop 995) + (hbody := by + simpa [consTailContext, consTailAnnotations] using + consTerminalCandidateTraceLoop 995)) + +theorem consAfterNCandidateTraceLoop : + AddInductive.buildCandidateExpr.loop consNContext + (consAfterAlpha.bindingBody!.instantiate1 + consAlphaContext.freshExpr) 998 = + .ok consAfterNCandidateTrace := by + rw [show 998 = 997 + 1 by rfl] + simpa only [consAfterNCandidateTrace, consHeadContext, + consHeadAnnotations] using + (AddInductive.buildCandidateExpr_loop_of_whnf_forall + (context := consNContext) + (e := consAfterAlpha.bindingBody!.instantiate1 + consAlphaContext.freshExpr) + (inferred := .sort (.succ (.param `u))) (fuel := 997) + (name := consHeadName) (domain := consAlphaExpr) + (body := consAfterN.bindingBody!) (binderInfo := .default) + (hfresh := consNContextFresh) + (annotations := consHeadAnnotations) + (hannotations := consHeadAnnotationsBuild) + (hannotationsEq := consHeadAnnotationsEq) + (hcheck := by + simpa only [consAfterNShape] using consAfterNCheckValid) + (hrun := by + simpa [consAfterAlpha, consAfterN, consAlphaExpr, consNExpr, + consRootContext, consAlphaContext, ctorContext, + AddInductive.Context.pushLocalDecl, + AddInductive.Context.freshExpr, Expr.bindingBody!, + Expr.instantiate1_eq, Expr.instantiate1', + Expr.liftLooseBVars_zero] using + consAfterNWhnfValid) + (domainCandidate := consHeadDomainCandidateTrace) + (bodyCandidate := consAfterHeadCandidateTrace) + (hdomain := by + simpa using consHeadDomainCandidateTraceLoop 996) + (hbody := by + simpa [consHeadContext, consHeadAnnotations] using + consAfterHeadCandidateTraceLoop)) + +theorem consAfterAlphaCandidateTraceLoop : + AddInductive.buildCandidateExpr.loop consAlphaContext + (consNTypeRaw.instantiate1 consRootContext.freshExpr) 999 = + .ok consAfterAlphaCandidateTrace := by + rw [show 999 = 998 + 1 by rfl] + simpa only [consAfterAlphaCandidateTrace, consNContext, + consNatAnnotations] using + (AddInductive.buildCandidateExpr_loop_of_whnf_forall + (context := consAlphaContext) + (e := consNTypeRaw.instantiate1 consRootContext.freshExpr) + (inferred := .sort (.succ (.param `u))) (fuel := 998) + (name := consNName) (domain := .const ``Nat []) + (body := consAfterAlpha.bindingBody!) (binderInfo := .implicit) + (hfresh := consAlphaContextFresh) + (annotations := consNatAnnotations) + (hannotations := consNatAnnotationsBuild) + (hannotationsEq := consNatAnnotationsEq) + (hcheck := by + simpa only [consAfterAlphaShape] using consAfterAlphaCheckValid) + (hrun := by + simpa [consNTypeRaw, consHeadTypeRaw, consTailTypeRaw, + consTerminalRaw, consAfterAlpha, consAlphaExpr, + consRootContext, ctorContext, AddInductive.Context.freshExpr, + Expr.bindingBody!, Expr.instantiate1_eq, Expr.instantiate1', + Expr.liftLooseBVars_zero] using + consAfterAlphaWhnfValid) + (domainCandidate := consNatDomainCandidateTrace) + (bodyCandidate := consAfterNCandidateTrace) + (hdomain := by + simpa using consNatDomainCandidateTraceLoop 997) + (hbody := by + simpa [consNContext, consNatAnnotations] using + consAfterNCandidateTraceLoop)) + +theorem consCandidateTraceLoop : + AddInductive.buildCandidateExpr.loop consRootContext + indexedVecConsInfo.type consRootContext.fuel.inductiveFuel = + .ok consCandidateTrace := by + change AddInductive.buildCandidateExpr.loop consRootContext + indexedVecConsInfo.type (999 + 1) = _ + simpa only [consCandidateTrace, consAlphaContext, + consAlphaAnnotations] using + (AddInductive.buildCandidateExpr_loop_of_whnf_forall + (context := consRootContext) (e := indexedVecConsInfo.type) + (inferred := .sort (.succ (.succ (.param `u)))) (fuel := 999) + (name := consAlphaName) + (domain := .sort (.succ (.param `u))) + (body := consNTypeRaw) (binderInfo := .implicit) + (hfresh := consRootFresh) + (annotations := consAlphaAnnotations) + (hannotations := consAlphaAnnotationsBuild) + (hannotationsEq := consAlphaAnnotationsEq) + (hcheck := consRootCheckValid) + (hrun := by + simpa [consInfoTypeShape, consCtorTypeRaw] using consRootWhnfValid) + (domainCandidate := consAlphaDomainCandidateTrace) + (bodyCandidate := consAfterAlphaCandidateTrace) + (hdomain := by + simpa using consAlphaDomainCandidateTraceLoop 998) + (hbody := by + simpa [consAlphaContext, consAlphaAnnotations] using + consAfterAlphaCandidateTraceLoop)) + +theorem consCandidateProduced : + AddInductive.buildCandidateExpr indexedVecConsInfo.type + consRootContext = .ok consCandidate := by + unfold AddInductive.buildCandidateExpr + simp only [readThe, MonadReaderOf.read, ReaderT.read, + ReaderT.bind, Bind.bind, ReaderT.pure, Pure.pure, + Except.bind, Except.pure] + rw [consCandidateTraceLoop] + rfl + +def indexedVecNilConstructorCandidate : + AddInductive.CandidateConstructor indexedVecKernelNil where + type := nilCandidate + +def indexedVecConsConstructorCandidate : + AddInductive.CandidateConstructor indexedVecKernelCons where + type := consCandidate + +def indexedVecFamilyListCandidate : + AddInductive.CandidateFamily indexedVecKernelType where + familyType := ⟨indexedVecFamilyCandidate⟩ + constructors := + .cons indexedVecNilConstructorCandidate + (.cons indexedVecConsConstructorCandidate .nil) + +def indexedVecNormalizationCandidate : + AddInductive.NormalizationCandidate [indexedVecKernelType] where + families := .cons indexedVecFamilyListCandidate .nil + +/-- Source-indexed evidence for the complete `IndexedVec` family-type list. -/ +def indexedVecFamilyTypeListProduced : + AddInductive.CandidateFamilyTypeListProduced + indexedVecFamilyCandidateContext + (.cons indexedVecFamilyListCandidate.familyType .nil) := by + exact .cons (by + unfold AddInductive.normalizeCandidateFamilyType + simp only [ReaderT.bind, Bind.bind] + simp only [indexedVecKernelType] + rw [indexedVecFamily_candidateTrace] + rfl) .nil + +theorem indexedVecFamilyTypeListCandidateProduced : + (withReader (fun c : AddInductive.Context => { c with lctx := {} }) + (AddInductive.normalizeCandidateFamilyTypeList + [indexedVecKernelType])) indexedVecFamilyCandidateContext = + .ok (.cons indexedVecFamilyListCandidate.familyType .nil) := by + change AddInductive.normalizeCandidateFamilyTypeList + [indexedVecKernelType] indexedVecFamilyCandidateContext = _ + exact indexedVecFamilyTypeListProduced.normalize + +/-- The two constructor positions are assembled in source order. The +dependent list indices rule out truncating, swapping, or reusing either +constructor proof. -/ +def indexedVecConstructorListProduced : + AddInductive.CandidateConstructorListProduced ctorContext + indexedVecFamilyListCandidate.constructors := by + have hnil : AddInductive.buildCandidateExpr indexedVecNilInfo.type + ctorContext = .ok nilCandidate := by + simpa [nilCandidateContext] using nilCandidateProduced + have hcons : AddInductive.buildCandidateExpr indexedVecConsInfo.type + ctorContext = .ok consCandidate := by + simpa [consRootContext] using consCandidateProduced + exact .cons (by + unfold AddInductive.normalizeCandidateConstructor + simp only [ReaderT.bind, Bind.bind] + simp only [indexedVecKernelNil] + rw [hnil] + rfl) (.cons (by + unfold AddInductive.normalizeCandidateConstructor + simp only [ReaderT.bind, Bind.bind] + simp only [indexedVecKernelCons] + rw [hcons] + rfl) .nil) + +theorem indexedVecConstructorListCandidateProduced : + AddInductive.normalizeCandidateConstructorList + indexedVecKernelType.ctors ctorContext = + .ok indexedVecFamilyListCandidate.constructors := by + exact indexedVecConstructorListProduced.normalize + +/-- Source-indexed evidence for complete family assembly after constructor +normalization. -/ +def indexedVecFamilyListProduced : + AddInductive.CandidateFamilyListProduced ctorContext + (.cons indexedVecFamilyListCandidate.familyType .nil) + indexedVecNormalizationCandidate.families := by + exact .cons indexedVecConstructorListProduced .nil + +theorem indexedVecFamilyListCandidateProduced : + AddInductive.normalizeCandidateFamilyList + (.cons indexedVecFamilyListCandidate.familyType .nil) + ctorContext = + .ok indexedVecNormalizationCandidate.families := by + exact indexedVecFamilyListProduced.normalize + +end IndexedVecConsReplay + +end Lean4Lean.InductiveReplayFixtures diff --git a/Lean4Lean/Verify/Environment/IndexedVecConstructors.lean b/Lean4Lean/Verify/Environment/IndexedVecConstructors.lean new file mode 100644 index 00000000..13301e2c --- /dev/null +++ b/Lean4Lean/Verify/Environment/IndexedVecConstructors.lean @@ -0,0 +1,1854 @@ +import Lean4Lean.Verify.Environment.IndexedVecCandidate + +/-! +# IndexedVec constructor normalization candidates + +Exact ordinary-checker and candidate-producer traces for the real `nil` and +`cons` constructor metadata, staged in the post-family kernel environment. +This module extends the family-validation seam proved in +`IndexedVecCandidate` toward the complete normalization candidate used by the +certified inductive-generation path. +-/ + +namespace Lean4Lean.InductiveReplayFixtures +open Lean Meta +open Lean4Lean.InductiveFixtures + +def ctorEnv : Kernel.Environment := + -- `declareInductiveTypes` preserves the input environment header while + -- inserting the raw family constant. Use that exact staged header so this + -- environment is not merely lookup-equivalent to the producer result. + Kernel.Environment.ofConstants `_indexedVecCandidate indexedVecTypeMap + +def ctorContext : AddInductive.Context where + env := ctorEnv + lparams := [`u] + safety := .safe + allowPrimitive := false + +theorem type_lookup_family : + ctorEnv.find? ``IndexedVec = some indexedVecInfo := by + change indexedVecTypeMap.find?' ``IndexedVec = some indexedVecInfo + rw [indexedVecTypeMap_wf.find?'_eq_find?, indexedVecTypeMap, + natMap_wf.find?_insert] + rfl + +theorem type_lookup_nat : ctorEnv.find? ``Nat = some natInfo := by + change indexedVecTypeMap.find?' ``Nat = some natInfo + rw [indexedVecTypeMap_wf.find?'_eq_find?, indexedVecTypeMap, + natMap_wf.find?_insert, nat_type_map_lookup] + simp +decide + +theorem nat_zero_map_lookup : + natMap.find? ``Nat.zero = some natZeroInfo := by + rw [natMap, natCtorMap_wf.find?_insert, natCtorMap, + natZeroMap_wf.find?_insert, natZeroMap, + natTypeMap_wf.find?_insert] + rfl + +theorem type_lookup_zero : + ctorEnv.find? ``Nat.zero = some natZeroInfo := by + change indexedVecTypeMap.find?' ``Nat.zero = some natZeroInfo + rw [indexedVecTypeMap_wf.find?'_eq_find?, indexedVecTypeMap, + natMap_wf.find?_insert, nat_zero_map_lookup] + simp +decide + +theorem type_lookup_succ : + ctorEnv.find? ``Nat.succ = some natSuccInfo := by + change indexedVecTypeMap.find?' ``Nat.succ = some natSuccInfo + rw [indexedVecTypeMap_wf.find?'_eq_find?, indexedVecTypeMap, + natMap_wf.find?_insert, nat_succ_map_lookup] + simp +decide + +@[simp] theorem type_get_family : + ctorEnv.get ``IndexedVec = .ok indexedVecInfo := by + unfold Kernel.Environment.get + rw [type_lookup_family] + rfl + +@[simp] theorem type_get_nat : ctorEnv.get ``Nat = .ok natInfo := by + unfold Kernel.Environment.get + rw [type_lookup_nat] + rfl + +@[simp] theorem type_get_zero : + ctorEnv.get ``Nat.zero = .ok natZeroInfo := by + unfold Kernel.Environment.get + rw [type_lookup_zero] + rfl + +@[simp] theorem type_get_succ : + ctorEnv.get ``Nat.succ = .ok natSuccInfo := by + unfold Kernel.Environment.get + rw [type_lookup_succ] + rfl + +def tcContext (lctx : LocalContext := {}) : TypeChecker.Context where + env := ctorEnv + lctx := lctx + lparams := [`u] + +@[simp] theorem checkLevelSuccParam (lctx) : + TypeChecker.Inner.checkLevel (tcContext lctx) + (.succ (.param `u)) = .ok () := by + simp [TypeChecker.Inner.checkLevel, tcContext, + Level.getUndefParam, Level.forEach, + Level.hasParam_eq, Level.hasParam'] + rfl + +@[simp] theorem checkLevelParam (lctx) : + TypeChecker.Inner.checkLevel (tcContext lctx) (.param `u) = + .ok () := by + simp [TypeChecker.Inner.checkLevel, tcContext, + Level.getUndefParam, Level.forEach, + Level.hasParam_eq, Level.hasParam'] + rfl + +@[simp] theorem indexedVecInfoLevelParams : + indexedVecInfo.levelParams = [`u] := rfl + +@[simp] theorem indexedVecInfoIsUnsafe : + indexedVecInfo.isUnsafe = false := rfl + +@[simp] theorem indexedVecInfoInstantiate : + indexedVecInfo.instantiateTypeLevelParams [.param `u] = + indexedVecInfo.type := by + rw [ConstantInfo.instantiateTypeLevelParams, + ConstantVal.instantiateTypeLevelParams, + Expr.instantiateLevelParams_eq] + simp [indexedVecInfo, ConstantInfo.type, + ConstantInfo.toConstantVal, + Expr.instantiateLevelParamsCore', Level.substParams', + Syntax.structEq_eq] + +@[simp] theorem inferConstantFamily (lctx) : + TypeChecker.Inner.inferConstant (tcContext lctx) ``IndexedVec + [.param `u] false = .ok indexedVecInfo.type := by + unfold TypeChecker.Inner.inferConstant + simp only [tcContext] + rw [type_get_family] + simp only [Bind.bind, Except.bind] + rw [show indexedVecInfo.levelParams.length = 1 by rfl] + simp + rw [show TypeChecker.Inner.checkLevel + ({ env := ctorEnv, lctx := lctx, lparams := [`u] } : + TypeChecker.Context) (.param `u) = .ok () by + simpa [tcContext] using checkLevelParam lctx] + simp [indexedVecInfo, indexedVecInfoInstantiate, + ConstantInfo.levelParams, ConstantInfo.isUnsafe, + ConstantInfo.instantiateTypeLevelParams, ConstantInfo.toConstantVal, + ConstantVal.instantiateTypeLevelParams, + Expr.instantiateLevelParams_eq, Expr.instantiateLevelParamsCore', + Level.substParams', Bind.bind, Except.bind, + Pure.pure, Except.pure] + +@[simp] theorem inferConstantNat (lctx) : + TypeChecker.Inner.inferConstant (tcContext lctx) ``Nat [] false = + .ok (.sort (.succ .zero)) := by + unfold TypeChecker.Inner.inferConstant + simp [tcContext, natInfo, + ConstantInfo.levelParams, ConstantInfo.isUnsafe, + ConstantInfo.instantiateTypeLevelParams, ConstantInfo.toConstantVal, + ConstantVal.instantiateTypeLevelParams, + Expr.instantiateLevelParams_eq, Expr.instantiateLevelParamsCore', + Level.substParams', + Bind.bind, Except.bind, Pure.pure, Except.pure] + +@[simp] theorem inferConstantZero (lctx) : + TypeChecker.Inner.inferConstant (tcContext lctx) ``Nat.zero [] false = + .ok (.const ``Nat []) := by + unfold TypeChecker.Inner.inferConstant + simp [tcContext, natZeroInfo, + ConstantInfo.levelParams, ConstantInfo.isUnsafe, + ConstantInfo.instantiateTypeLevelParams, ConstantInfo.toConstantVal, + ConstantVal.instantiateTypeLevelParams, + Expr.instantiateLevelParams_eq, Expr.instantiateLevelParamsCore', + Bind.bind, Except.bind, Pure.pure, Except.pure] + +@[simp] theorem inferConstantSucc (lctx) : + TypeChecker.Inner.inferConstant (tcContext lctx) ``Nat.succ [] false = + .ok (.forallE `n (.const ``Nat []) (.const ``Nat []) .default) := by + unfold TypeChecker.Inner.inferConstant + simp [tcContext, natSuccInfo, + ConstantInfo.levelParams, ConstantInfo.isUnsafe, + ConstantInfo.instantiateTypeLevelParams, ConstantInfo.toConstantVal, + ConstantVal.instantiateTypeLevelParams, + Expr.instantiateLevelParams_eq, Expr.instantiateLevelParamsCore', + Bind.bind, Except.bind, Pure.pure, Except.pure] + +theorem selfDefEq (e : Expr) fuel context state : + TypeChecker.Inner.isDefEq e e (TypeChecker.Methods.withFuel fuel) + context state = .ok (true, state) := by + unfold TypeChecker.Inner.isDefEq + rw [if_pos (Expr.eqv_refl _)] + rfl + +@[simp] theorem constBeqFVar (name : Name) (levels : List Level) + (id : FVarId) : + ((.const name levels : Expr) == .fvar id) = false := by + change Expr.eqv (.const name levels) (.fvar id) = false + rw [Expr.eqv_eq] + rfl + +@[simp] theorem sortBeqFVar (level : Level) (id : FVarId) : + ((.sort level : Expr) == .fvar id) = false := by + change Expr.eqv (.sort level) (.fvar id) = false + rw [Expr.eqv_eq] + rfl + +@[simp] theorem fvarBeqConst (id : FVarId) (name : Name) + (levels : List Level) : + ((.fvar id : Expr) == .const name levels) = false := by + change Expr.eqv (.fvar id) (.const name levels) = false + rw [Expr.eqv_eq] + rfl + +@[simp] theorem sortBeqApp (level : Level) (fn arg : Expr) : + ((.sort level : Expr) == .app fn arg) = false := by + change Expr.eqv (.sort level) (.app fn arg) = false + rw [Expr.eqv_eq] + rfl + +@[simp] theorem indexedVecConstBeqZero : + ((.const ``IndexedVec [.param `u] : Expr) == + .const ``Nat.zero []) = false := by + change Expr.eqv (.const ``IndexedVec [.param `u]) + (.const ``Nat.zero []) = false + rw [Expr.eqv_eq] + rfl + +theorem withLocalDeclEq + {α} (name : Name) (bi : BinderInfo) (ty : Expr) + (k : Expr → TypeChecker.RecM α) + (methods : TypeChecker.Methods) + (context : TypeChecker.Context) + (state : TypeChecker.State) : + (withLocalDecl (m := TypeChecker.RecM) name bi ty k) + methods context state = + k (.fvar ⟨state.ngen.curr⟩) methods + { context with lctx := + context.lctx.mkLocalDecl ⟨state.ngen.curr⟩ name ty bi } + { state with ngen := state.ngen.next } := rfl + +def nilRootSortState : TypeChecker.State := + { ({} : TypeChecker.State) with + inferTypeC := ({} : TypeChecker.State).inferTypeC.insert + (.sort (.succ (.param `u))) + (.sort (.succ (.succ (.param `u)))) } + +def nilAlphaId : FVarId := + ⟨nilRootSortState.ngen.curr⟩ + +def nilAlphaLctx : LocalContext := + ({} : LocalContext).mkLocalDecl nilAlphaId `α + (.sort (.succ (.param `u))) .implicit + +def nilBodyInitialState : TypeChecker.State := + { nilRootSortState with ngen := nilRootSortState.ngen.next } + +theorem nilAlphaFind : + nilAlphaLctx.find? nilAlphaId = + some (.cdecl 0 nilAlphaId `α + (.sort (.succ (.param `u))) .implicit .default) := by + have hfresh : ({} : LocalContext).find? nilAlphaId = none := by + have h := LocalContext.WF.find?_eq_find?_toList + (fv := nilAlphaId) LocalContext.WF.nil + change + ({ fvarIdToDecl := PersistentHashMap.empty, + decls := PersistentArray.empty, + auxDeclToFullName := Std.TreeMap.empty } : LocalContext).find? + nilAlphaId = none + rw [h] + simp [LocalContext.toList] + have hwf : nilAlphaLctx.WF := by + change (({} : LocalContext).mkLocalDecl nilAlphaId `α + (.sort (.succ (.param `u))) .implicit).WF + exact LocalContext.WF.mkLocalDecl LocalContext.WF.nil hfresh + rw [hwf.find?_eq_find?_toList] + simp only [nilAlphaLctx] + rw [LocalContext.mkLocalDecl_toList] + rw [show ({} : LocalContext).toList = [] by rfl] + rw [show ({} : LocalContext).decls.size = 0 by rfl] + change + (if nilAlphaId == nilAlphaId then + some (LocalDecl.cdecl 0 nilAlphaId `α + (.sort (.succ (.param `u))) .implicit .default) + else none) = _ + rw [beq_self_eq_true] + rfl + +example : + TypeChecker.Inner.inferFVar (tcContext nilAlphaLctx) nilAlphaId = + .ok (.sort (.succ (.param `u))) := by + unfold TypeChecker.Inner.inferFVar + simp [tcContext, nilAlphaFind, LocalDecl.type, + Pure.pure, Except.pure] + +theorem inferTypeFamilyCore + (fuel : Nat) (lctx : LocalContext) (state : TypeChecker.State) + (hcache : state.inferTypeC[ + (.const ``IndexedVec [.param `u] : Expr)]? = none) : + TypeChecker.Inner.inferType' + (.const ``IndexedVec [.param `u]) false + (TypeChecker.Methods.withFuel fuel) (tcContext lctx) state = + .ok (indexedVecInfo.type, + { state with inferTypeC := + (state.inferTypeC.insert + (.const ``IndexedVec [.param `u]) indexedVecInfo.type) }) := by + unfold TypeChecker.Inner.inferType' + simp [Expr.hasLooseBVars, Expr.looseBVarRange', hcache, + inferConstantFamily, Bind.bind, ReaderT.bind, + StateT.bind, Except.bind] + +theorem inferTypeFVarCore + (fuel : Nat) (lctx : LocalContext) (state : TypeChecker.State) + (id : FVarId) (type : Expr) + (hcache : state.inferTypeC[(.fvar id : Expr)]? = none) + (hfind : lctx.find? id = some (.cdecl index id name type bi kind)) : + TypeChecker.Inner.inferType' (.fvar id) false + (TypeChecker.Methods.withFuel fuel) (tcContext lctx) state = + .ok (type, { state with inferTypeC := + (state.inferTypeC.insert (.fvar id) type) }) := by + unfold TypeChecker.Inner.inferType' + simp [Expr.hasLooseBVars, Expr.looseBVarRange', hcache, + TypeChecker.Inner.inferFVar, tcContext, hfind, + LocalDecl.type, Bind.bind, ReaderT.bind, StateT.bind, Except.bind] + +theorem inferTypeZeroCore + (fuel : Nat) (lctx : LocalContext) (state : TypeChecker.State) + (hcache : state.inferTypeC[(.const ``Nat.zero [] : Expr)]? = none) : + TypeChecker.Inner.inferType' (.const ``Nat.zero []) false + (TypeChecker.Methods.withFuel fuel) (tcContext lctx) state = + .ok (.const ``Nat [], { state with inferTypeC := + (state.inferTypeC.insert (.const ``Nat.zero []) (.const ``Nat [])) }) := by + unfold TypeChecker.Inner.inferType' + simp [Expr.hasLooseBVars, Expr.looseBVarRange', hcache, + inferConstantZero, Bind.bind, ReaderT.bind, + StateT.bind, Except.bind] + +theorem inferTypeNatCore + (fuel : Nat) (lctx : LocalContext) (state : TypeChecker.State) + (hcache : state.inferTypeC[(.const ``Nat [] : Expr)]? = none) : + TypeChecker.Inner.inferType' (.const ``Nat []) false + (TypeChecker.Methods.withFuel fuel) (tcContext lctx) state = + .ok (.sort (.succ .zero), { state with inferTypeC := + (state.inferTypeC.insert (.const ``Nat []) + (.sort (.succ .zero))) }) := by + unfold TypeChecker.Inner.inferType' + simp [Expr.hasLooseBVars, Expr.looseBVarRange', hcache, + inferConstantNat, Bind.bind, ReaderT.bind, + StateT.bind, Except.bind] + +theorem inferTypeSuccCore + (fuel : Nat) (lctx : LocalContext) (state : TypeChecker.State) + (hcache : state.inferTypeC[(.const ``Nat.succ [] : Expr)]? = none) : + TypeChecker.Inner.inferType' (.const ``Nat.succ []) false + (TypeChecker.Methods.withFuel fuel) (tcContext lctx) state = + .ok (.forallE `n (.const ``Nat []) (.const ``Nat []) .default, + { state with inferTypeC := + (state.inferTypeC.insert (.const ``Nat.succ []) + (.forallE `n (.const ``Nat []) (.const ``Nat []) .default)) }) := by + unfold TypeChecker.Inner.inferType' + simp [Expr.hasLooseBVars, Expr.looseBVarRange', hcache, + inferConstantSucc, Bind.bind, ReaderT.bind, + StateT.bind, Except.bind] + +@[simp] theorem ensureForallExact + (name : Name) (domain body : Expr) (bi : BinderInfo) + (source : Expr) (fuel : Nat) (context : TypeChecker.Context) + (state : TypeChecker.State) : + TypeChecker.Inner.ensureForallCore (.forallE name domain body bi) + source (TypeChecker.Methods.withFuel fuel) context state = + .ok (.forallE name domain body bi, state) := by + rfl + +theorem inferAppCoreOf + (fuel : Nat) (context : TypeChecker.Context) + (state stateFn stateArg : TypeChecker.State) + (fn arg domain body : Expr) (name : Name) (bi : BinderInfo) + (hclosed : (.app fn arg : Expr).hasLooseBVars = false) + (hcache : state.inferTypeC[(.app fn arg : Expr)]? = none) + (hfn : TypeChecker.Inner.inferType' fn false + (TypeChecker.Methods.withFuel fuel) context state = + .ok (.forallE name domain body bi, stateFn)) + (harg : TypeChecker.Inner.inferType' arg false + (TypeChecker.Methods.withFuel fuel) context stateFn = + .ok (domain, stateArg)) + (heager : arg.isAppOfArity ``eagerReduce 2 = false) : + TypeChecker.Inner.inferType' (.app fn arg) false + (TypeChecker.Methods.withFuel fuel) context state = + .ok (body.instantiate1 arg, + { stateArg with inferTypeC := + (stateArg.inferTypeC.insert + (.app fn arg) (body.instantiate1 arg)) }) := by + unfold TypeChecker.Inner.inferType' + simp [hclosed, hcache, hfn, harg, + heager, ensureForallExact, selfDefEq, + Expr.instantiate1_eq, Bind.bind, ReaderT.bind, + StateT.bind, Except.bind] + +theorem inferTypeForallCore + (fuel : Nat) (context : TypeChecker.Context) + (state finalState : TypeChecker.State) + (name : Name) (domain body result : Expr) (bi : BinderInfo) + (hclosed : (.forallE name domain body bi : Expr).hasLooseBVars = false) + (hcache : state.inferTypeC[(.forallE name domain body bi : Expr)]? = none) + (hforall : TypeChecker.Inner.inferForall + (.forallE name domain body bi) false + (TypeChecker.Methods.withFuel fuel) context state = + .ok (result, finalState)) : + TypeChecker.Inner.inferType' + (.forallE name domain body bi) false + (TypeChecker.Methods.withFuel fuel) context state = + .ok (result, { finalState with inferTypeC := + (finalState.inferTypeC.insert + (.forallE name domain body bi) result) }) := by + unfold TypeChecker.Inner.inferType' + simp [hclosed, hcache, hforall, Bind.bind, ReaderT.bind, + StateT.bind, Except.bind] + +def nilBodyExpr : Expr := + .app (.app (.const ``IndexedVec [.param `u]) (.fvar nilAlphaId)) + (.const ``Nat.zero []) + +def vecIndexName : Name := + indexedVecInfo.type.bindingBody!.bindingName! + +def vecFamilyTail : Expr := + .forallE vecIndexName (.const ``Nat []) + (.sort (.succ (.param `u))) .default + +theorem indexedVecInfoTypeShape : + indexedVecInfo.type = + .forallE `α (.sort (.succ (.param `u))) vecFamilyTail .default := by + rfl + +@[simp] theorem vecFamilyTailInstantiate (arg : Expr) : + vecFamilyTail.instantiate1 arg = vecFamilyTail := by + simp [vecFamilyTail, Expr.instantiate1_eq, Expr.instantiate1'] + +def nilFamilyState : TypeChecker.State := + { nilBodyInitialState with inferTypeC := + (nilBodyInitialState.inferTypeC.insert + (.const ``IndexedVec [.param `u]) indexedVecInfo.type) } + +def nilAlphaState : TypeChecker.State := + { nilFamilyState with inferTypeC := + (nilFamilyState.inferTypeC.insert (.fvar nilAlphaId) + (.sort (.succ (.param `u)))) } + +def nilFirstApp : Expr := + .app (.const ``IndexedVec [.param `u]) (.fvar nilAlphaId) + +def nilFirstAppState : TypeChecker.State := + { nilAlphaState with inferTypeC := + (nilAlphaState.inferTypeC.insert nilFirstApp vecFamilyTail) } + +def nilZeroState : TypeChecker.State := + { nilFirstAppState with inferTypeC := + (nilFirstAppState.inferTypeC.insert (.const ``Nat.zero []) + (.const ``Nat [])) } + +theorem inferNilFamily : + TypeChecker.Inner.inferType' + (.const ``IndexedVec [.param `u]) false + (TypeChecker.Methods.withFuel 9998) + (tcContext nilAlphaLctx) nilBodyInitialState = + .ok (indexedVecInfo.type, nilFamilyState) := by + simpa [nilFamilyState] using + (inferTypeFamilyCore 9998 nilAlphaLctx nilBodyInitialState (by + simp [nilBodyInitialState, nilRootSortState, + Std.HashMap.getElem?_insert, + Expr.eqv_eq])) + +theorem inferNilAlpha : + TypeChecker.Inner.inferType' (.fvar nilAlphaId) false + (TypeChecker.Methods.withFuel 9998) + (tcContext nilAlphaLctx) nilFamilyState = + .ok (.sort (.succ (.param `u)), nilAlphaState) := by + simpa [nilAlphaState] using + (inferTypeFVarCore 9998 nilAlphaLctx nilFamilyState nilAlphaId + (.sort (.succ (.param `u))) (index := 0) (name := `α) + (bi := .implicit) (kind := .default) (by + simp [nilFamilyState, nilBodyInitialState, nilRootSortState, + Std.HashMap.getElem?_insert, Expr.eqv_eq]) nilAlphaFind) + +theorem inferNilFirstApp : + TypeChecker.Inner.inferType' nilFirstApp false + (TypeChecker.Methods.withFuel 9998) + (tcContext nilAlphaLctx) nilBodyInitialState = + .ok (vecFamilyTail, nilFirstAppState) := by + have h := inferAppCoreOf 9998 (tcContext nilAlphaLctx) + nilBodyInitialState nilFamilyState nilAlphaState + (.const ``IndexedVec [.param `u]) (.fvar nilAlphaId) + (.sort (.succ (.param `u))) vecFamilyTail `α .default + (by + simp [Expr.hasLooseBVars, Expr.looseBVarRange']) + (by + simp [nilBodyInitialState, nilRootSortState, + Std.HashMap.getElem?_insert, + Expr.eqv_eq]) + (by simpa [indexedVecInfoTypeShape] using inferNilFamily) + inferNilAlpha (by rfl) + simpa [nilFirstApp, nilFirstAppState, vecFamilyTail, + Expr.instantiate1'] using h + +theorem inferNilZero : + TypeChecker.Inner.inferType' (.const ``Nat.zero []) false + (TypeChecker.Methods.withFuel 9998) + (tcContext nilAlphaLctx) nilFirstAppState = + .ok (.const ``Nat [], nilZeroState) := by + simpa [nilZeroState] using + (inferTypeZeroCore 9998 nilAlphaLctx nilFirstAppState (by + simp [nilFirstAppState, nilAlphaState, nilFamilyState, + nilBodyInitialState, nilRootSortState, nilFirstApp, + Std.HashMap.getElem?_insert, Expr.eqv_eq])) + +theorem inferNilBodyExists : ∃ finalState, + TypeChecker.Inner.inferType nilBodyExpr false + (TypeChecker.Methods.withFuel 9999) + (tcContext nilAlphaLctx) nilBodyInitialState = + .ok (.sort (.succ (.param `u)), finalState) := by + refine ⟨{ nilZeroState with inferTypeC := + (nilZeroState.inferTypeC.insert nilBodyExpr + (.sort (.succ (.param `u)))) }, ?_⟩ + change TypeChecker.Inner.inferType' nilBodyExpr false + (TypeChecker.Methods.withFuel 9998) + (tcContext nilAlphaLctx) nilBodyInitialState = _ + have h := inferAppCoreOf 9998 (tcContext nilAlphaLctx) + nilBodyInitialState nilFirstAppState nilZeroState + nilFirstApp (.const ``Nat.zero []) (.const ``Nat []) + (.sort (.succ (.param `u))) vecIndexName .default + (by simp [nilBodyExpr, nilFirstApp, + Expr.hasLooseBVars, Expr.looseBVarRange']) + (by simp [nilBodyExpr, nilBodyInitialState, nilRootSortState, + Std.HashMap.getElem?_insert, Expr.eqv_eq]) + (by simpa [vecFamilyTail] using inferNilFirstApp) + inferNilZero (by rfl) + simpa [nilBodyExpr, nilFirstApp, + Expr.instantiate1_eq, Expr.instantiate1'] using h + +theorem nilOuterWithLocalDecl + {α} (k : Expr → TypeChecker.RecM α) + (methods : TypeChecker.Methods) : + (withLocalDecl (m := TypeChecker.RecM) `α .implicit + (.sort (.succ (.param `u))) k) + methods (tcContext ({} : LocalContext)) nilRootSortState = + k (.fvar nilAlphaId) methods (tcContext nilAlphaLctx) + nilBodyInitialState := by + simpa [nilAlphaId, nilAlphaLctx, nilBodyInitialState, tcContext] using + (withLocalDeclEq `α .implicit (.sort (.succ (.param `u))) k methods + (tcContext ({} : LocalContext)) nilRootSortState) + +@[simp] theorem ensureSortExact + (level : Level) (source : Expr) (fuel : Nat) + (context : TypeChecker.Context) (state : TypeChecker.State) : + TypeChecker.Inner.ensureSortCore (.sort level) source + (TypeChecker.Methods.withFuel fuel) context state = + .ok (.sort level, state) := by + rfl + +theorem nilRootSortCore : + TypeChecker.Inner.inferType' + (.sort (.succ (.param `u))) false + (TypeChecker.Methods.withFuel 9998) + (tcContext ({} : LocalContext)) ({} : TypeChecker.State) = + .ok (.sort (.succ (.succ (.param `u))), nilRootSortState) := by + unfold TypeChecker.Inner.inferType' + simp [Expr.hasLooseBVars, Expr.looseBVarRange', + nilRootSortState, checkLevelSuccParam, + Bind.bind, ReaderT.bind, StateT.bind, Except.bind] + +def nilCtorBodyRaw : Expr := + .app (.app (.const ``IndexedVec [.param `u]) (.bvar 0)) + (.const ``Nat.zero []) + +def nilCtorTypeRaw : Expr := + .forallE `α (.sort (.succ (.param `u))) nilCtorBodyRaw .implicit + +def nilCtorInferredLevel : Level := + mkLevelIMax' (.succ (.succ (.param `u))) (.succ (.param `u)) + +theorem nilInfoTypeShape : indexedVecNilInfo.type = nilCtorTypeRaw := by + rfl + +theorem nilRootInferForallExists : ∃ finalState, + TypeChecker.Inner.inferForall nilCtorTypeRaw false + (TypeChecker.Methods.withFuel 9999) + (tcContext ({} : LocalContext)) ({} : TypeChecker.State) = + .ok (.sort nilCtorInferredLevel, finalState) := by + obtain ⟨finalState, hbody⟩ := inferNilBodyExists + refine ⟨finalState, ?_⟩ + unfold TypeChecker.Inner.inferForall + simp only [TypeChecker.Inner.inferForall.loop, nilCtorTypeRaw] + rw [show + (.sort (.succ (.param `u)) : Expr).instantiateRev #[] = + .sort (.succ (.param `u)) by + simp [Expr.instantiateRev_eq, Expr.instantiate_eq]] + simp only [Bind.bind, ReaderT.bind, StateT.bind, Except.bind] + rw [show TypeChecker.Inner.inferType + (.sort (.succ (.param `u))) false + (TypeChecker.Methods.withFuel 9999) + (tcContext ({} : LocalContext)) ({} : TypeChecker.State) = + TypeChecker.Inner.inferType' + (.sort (.succ (.param `u))) false + (TypeChecker.Methods.withFuel 9998) + (tcContext ({} : LocalContext)) ({} : TypeChecker.State) by rfl] + rw [nilRootSortCore] + simp only + rw [ensureSortExact] + simp only + rw [nilOuterWithLocalDecl] + simp only [TypeChecker.Inner.inferForall.loop, nilCtorBodyRaw] + rw [show + (((.const ``IndexedVec [.param `u] : Expr).app (.bvar 0)).app + (.const ``Nat.zero [])).instantiateRev + (#[] |>.push (.fvar nilAlphaId)) = nilBodyExpr by + simp [nilCtorBodyRaw, nilBodyExpr, nilAlphaId, + Expr.instantiateRev_eq, Expr.instantiate_eq, + Expr.instantiate1', Expr.liftLooseBVars_zero]] + simp only [Bind.bind, ReaderT.bind, StateT.bind, Except.bind] + rw [hbody] + simp only + rw [ensureSortExact] + simp [nilCtorInferredLevel, Expr.sortLevel!, Pure.pure, ReaderT.pure, + StateT.pure, Except.pure] + +theorem inferNilRootExists : ∃ finalState, + TypeChecker.Inner.inferType indexedVecNilInfo.type false + (TypeChecker.Methods.withFuel 10000) + (tcContext ({} : LocalContext)) ({} : TypeChecker.State) = + .ok (.sort nilCtorInferredLevel, finalState) := by + obtain ⟨state, hforall⟩ := nilRootInferForallExists + refine ⟨{ state with inferTypeC := + (state.inferTypeC.insert indexedVecNilInfo.type + (.sort nilCtorInferredLevel)) }, ?_⟩ + change TypeChecker.Inner.inferType' indexedVecNilInfo.type false + (TypeChecker.Methods.withFuel 9999) + (tcContext ({} : LocalContext)) ({} : TypeChecker.State) = _ + rw [nilInfoTypeShape] + exact inferTypeForallCore 9999 (tcContext ({} : LocalContext)) + ({} : TypeChecker.State) state `α + (.sort (.succ (.param `u))) nilCtorBodyRaw + (.sort nilCtorInferredLevel) .implicit + (by simp [nilCtorBodyRaw, Expr.hasLooseBVars, + Expr.looseBVarRange']) + (by simp) hforall + +theorem nilRootCheckTypeM : + TypeChecker.M.run ctorEnv .safe {} [`u] {} + (TypeChecker.checkType indexedVecNilInfo.type) = + .ok (.sort nilCtorInferredLevel) := by + obtain ⟨finalState, hroot⟩ := inferNilRootExists + change Except.map (fun x : Expr × TypeChecker.State => x.1) + (TypeChecker.Inner.inferType indexedVecNilInfo.type false + (TypeChecker.Methods.withFuel 10000) + (tcContext {}) ({} : TypeChecker.State)) = _ + rw [hroot] + rfl + +def nilCandidateContext : AddInductive.Context := ctorContext + +def nilCandidateBodyContext : AddInductive.Context := + nilCandidateContext.pushLocalDecl `α .implicit + (.sort (.succ (.param `u))) + +def nilCandidateBody : Expr := + nilCtorBodyRaw.instantiate1 nilCandidateContext.freshExpr + +theorem nilStandaloneSortCore : + TypeChecker.Inner.inferType' + (.sort (.succ (.param `u))) false + (TypeChecker.Methods.withFuel 9999) + (tcContext ({} : LocalContext)) ({} : TypeChecker.State) = + .ok (.sort (.succ (.succ (.param `u))), nilRootSortState) := by + unfold TypeChecker.Inner.inferType' + simp [Expr.hasLooseBVars, Expr.looseBVarRange', + nilRootSortState, checkLevelSuccParam, + Bind.bind, ReaderT.bind, StateT.bind, Except.bind] + +theorem nilRootWhnfM : + TypeChecker.M.run nilCandidateContext.env nilCandidateContext.safety + nilCandidateContext.lctx nilCandidateContext.lparams + nilCandidateContext.fuel + (TypeChecker.whnf indexedVecNilInfo.type) = + .ok indexedVecNilInfo.type := by + rfl + +theorem nilDomainCheckTypeM : + TypeChecker.M.run nilCandidateContext.env nilCandidateContext.safety + nilCandidateContext.lctx nilCandidateContext.lparams + nilCandidateContext.fuel + (TypeChecker.checkType (.sort (.succ (.param `u)))) = + .ok (.sort (.succ (.succ (.param `u)))) := by + obtain ⟨finalState, hroot⟩ := + show ∃ finalState, + TypeChecker.Inner.inferType (.sort (.succ (.param `u))) false + (TypeChecker.Methods.withFuel 10000) + (tcContext ({} : LocalContext)) ({} : TypeChecker.State) = + .ok (.sort (.succ (.succ (.param `u))), finalState) by + refine ⟨nilRootSortState, ?_⟩ + change TypeChecker.Inner.inferType' + (.sort (.succ (.param `u))) false + (TypeChecker.Methods.withFuel 9999) + (tcContext ({} : LocalContext)) ({} : TypeChecker.State) = _ + exact nilStandaloneSortCore + change Except.map (fun x : Expr × TypeChecker.State => x.1) + (TypeChecker.Inner.inferType (.sort (.succ (.param `u))) false + (TypeChecker.Methods.withFuel 10000) + (tcContext ({} : LocalContext)) ({} : TypeChecker.State)) = _ + rw [hroot] + rfl + +theorem nilDomainWhnfM : + TypeChecker.M.run nilCandidateContext.env nilCandidateContext.safety + nilCandidateContext.lctx nilCandidateContext.lparams + nilCandidateContext.fuel + (TypeChecker.whnf (.sort (.succ (.param `u)))) = + .ok (.sort (.succ (.param `u))) := by + rfl + +def nilCandidateAlphaId : FVarId := + nilCandidateContext.freshFVarId + +def nilCandidateAlphaLctx : LocalContext := + ({} : LocalContext).mkLocalDecl nilCandidateAlphaId `α + (.sort (.succ (.param `u))) .implicit + +theorem nilCandidateFresh : + ({} : LocalContext).find? nilCandidateAlphaId = none := by + have h := LocalContext.WF.find?_eq_find?_toList + (fv := nilCandidateAlphaId) LocalContext.WF.nil + change + ({ fvarIdToDecl := PersistentHashMap.empty, + decls := PersistentArray.empty, + auxDeclToFullName := Std.TreeMap.empty } : LocalContext).find? + nilCandidateAlphaId = none + rw [h] + simp [LocalContext.toList] + +theorem nilCandidateAlphaFind : + nilCandidateAlphaLctx.find? nilCandidateAlphaId = + some (.cdecl 0 nilCandidateAlphaId `α + (.sort (.succ (.param `u))) .implicit .default) := by + have hwf : nilCandidateAlphaLctx.WF := by + change (({} : LocalContext).mkLocalDecl nilCandidateAlphaId `α + (.sort (.succ (.param `u))) .implicit).WF + exact LocalContext.WF.mkLocalDecl LocalContext.WF.nil + nilCandidateFresh + rw [hwf.find?_eq_find?_toList] + simp only [nilCandidateAlphaLctx] + rw [LocalContext.mkLocalDecl_toList] + rw [show ({} : LocalContext).toList = [] by rfl] + rw [show ({} : LocalContext).decls.size = 0 by rfl] + change + (if nilCandidateAlphaId == nilCandidateAlphaId then + some (LocalDecl.cdecl 0 nilCandidateAlphaId `α + (.sort (.succ (.param `u))) .implicit .default) + else none) = _ + rw [beq_self_eq_true] + rfl + +def nilCandidateFirstApp : Expr := + .app (.const ``IndexedVec [.param `u]) (.fvar nilCandidateAlphaId) + +def nilCandidateBodyExpr : Expr := + .app nilCandidateFirstApp (.const ``Nat.zero []) + +theorem nilCandidateBodyShape : + nilCandidateBody = nilCandidateBodyExpr := by + simp [nilCandidateBody, nilCtorBodyRaw, nilCandidateBodyExpr, + nilCandidateFirstApp, nilCandidateAlphaId, + AddInductive.Context.freshExpr, + Expr.instantiate1_eq, Expr.instantiate1'] + +def nilCandidateFamilyState : TypeChecker.State := + { ({} : TypeChecker.State) with inferTypeC := + (({} : TypeChecker.State).inferTypeC.insert + (.const ``IndexedVec [.param `u]) indexedVecInfo.type) } + +def nilCandidateAlphaState : TypeChecker.State := + { nilCandidateFamilyState with inferTypeC := + (nilCandidateFamilyState.inferTypeC.insert + (.fvar nilCandidateAlphaId) (.sort (.succ (.param `u)))) } + +def nilCandidateFirstAppState : TypeChecker.State := + { nilCandidateAlphaState with inferTypeC := + (nilCandidateAlphaState.inferTypeC.insert + nilCandidateFirstApp vecFamilyTail) } + +def nilCandidateZeroState : TypeChecker.State := + { nilCandidateFirstAppState with inferTypeC := + (nilCandidateFirstAppState.inferTypeC.insert + (.const ``Nat.zero []) (.const ``Nat [])) } + +theorem inferNilCandidateFamily : + TypeChecker.Inner.inferType' + (.const ``IndexedVec [.param `u]) false + (TypeChecker.Methods.withFuel 9999) + (tcContext nilCandidateAlphaLctx) ({} : TypeChecker.State) = + .ok (indexedVecInfo.type, nilCandidateFamilyState) := by + simpa [nilCandidateFamilyState] using + (inferTypeFamilyCore 9999 nilCandidateAlphaLctx + ({} : TypeChecker.State) (by simp)) + +theorem inferNilCandidateAlpha : + TypeChecker.Inner.inferType' (.fvar nilCandidateAlphaId) false + (TypeChecker.Methods.withFuel 9999) + (tcContext nilCandidateAlphaLctx) nilCandidateFamilyState = + .ok (.sort (.succ (.param `u)), nilCandidateAlphaState) := by + simpa [nilCandidateAlphaState] using + (inferTypeFVarCore 9999 nilCandidateAlphaLctx + nilCandidateFamilyState nilCandidateAlphaId + (.sort (.succ (.param `u))) + (by simp [nilCandidateFamilyState]) nilCandidateAlphaFind) + +theorem inferNilCandidateFirstApp : + TypeChecker.Inner.inferType' nilCandidateFirstApp false + (TypeChecker.Methods.withFuel 9999) + (tcContext nilCandidateAlphaLctx) ({} : TypeChecker.State) = + .ok (vecFamilyTail, nilCandidateFirstAppState) := by + have h := inferAppCoreOf 9999 (tcContext nilCandidateAlphaLctx) + ({} : TypeChecker.State) nilCandidateFamilyState + nilCandidateAlphaState (.const ``IndexedVec [.param `u]) + (.fvar nilCandidateAlphaId) (.sort (.succ (.param `u))) + vecFamilyTail `α .default + (by simp [nilCandidateFirstApp, Expr.hasLooseBVars, + Expr.looseBVarRange']) + (by simp [nilCandidateFirstApp]) inferNilCandidateFamily + (by simpa [indexedVecInfoTypeShape] using inferNilCandidateAlpha) + (by rfl) + simpa [nilCandidateFirstApp, nilCandidateFirstAppState, + indexedVecInfoTypeShape, vecFamilyTail, + Expr.instantiate1'] using h + +theorem inferNilCandidateZero : + TypeChecker.Inner.inferType' (.const ``Nat.zero []) false + (TypeChecker.Methods.withFuel 9999) + (tcContext nilCandidateAlphaLctx) nilCandidateFirstAppState = + .ok (.const ``Nat [], nilCandidateZeroState) := by + simpa [nilCandidateZeroState] using + (inferTypeZeroCore 9999 nilCandidateAlphaLctx + nilCandidateFirstAppState (by + simp [nilCandidateFirstAppState, nilCandidateAlphaState, + nilCandidateFamilyState, nilCandidateFirstApp, + Expr.eqv_eq])) + +theorem inferNilCandidateBodyExists : ∃ finalState, + TypeChecker.Inner.inferType nilCandidateBody false + (TypeChecker.Methods.withFuel 10000) + (tcContext nilCandidateAlphaLctx) ({} : TypeChecker.State) = + .ok (.sort (.succ (.param `u)), finalState) := by + refine ⟨{ nilCandidateZeroState with inferTypeC := + (nilCandidateZeroState.inferTypeC.insert nilCandidateBodyExpr + (.sort (.succ (.param `u)))) }, ?_⟩ + change TypeChecker.Inner.inferType' nilCandidateBody false + (TypeChecker.Methods.withFuel 9999) + (tcContext nilCandidateAlphaLctx) ({} : TypeChecker.State) = _ + rw [nilCandidateBodyShape] + have h := inferAppCoreOf 9999 (tcContext nilCandidateAlphaLctx) + ({} : TypeChecker.State) nilCandidateFirstAppState + nilCandidateZeroState nilCandidateFirstApp (.const ``Nat.zero []) + (.const ``Nat []) (.sort (.succ (.param `u))) vecIndexName .default + (by simp [nilCandidateBodyExpr, nilCandidateFirstApp, + Expr.hasLooseBVars, Expr.looseBVarRange']) + (by simp [nilCandidateBodyExpr]) inferNilCandidateFirstApp + inferNilCandidateZero (by rfl) + simpa [nilCandidateBodyExpr, nilCandidateFirstApp, + Expr.instantiate1_eq, Expr.instantiate1'] using h + +theorem nilCandidateBodyCheckTypeM : + TypeChecker.M.run nilCandidateBodyContext.env + nilCandidateBodyContext.safety nilCandidateBodyContext.lctx + nilCandidateBodyContext.lparams nilCandidateBodyContext.fuel + (TypeChecker.checkType nilCandidateBody) = + .ok (.sort (.succ (.param `u))) := by + obtain ⟨finalState, hbody⟩ := inferNilCandidateBodyExists + change Except.map (fun x : Expr × TypeChecker.State => x.1) + (TypeChecker.Inner.inferType nilCandidateBody false + (TypeChecker.Methods.withFuel 10000) + (tcContext nilCandidateAlphaLctx) ({} : TypeChecker.State)) = _ + rw [hbody] + rfl + +theorem nilCandidateBodyGetAppFn : + nilCandidateBody.getAppFn = + .const ``IndexedVec [.param `u] := by + rw [nilCandidateBodyShape] + rfl + +theorem nilRecMBind + {α β} (x : TypeChecker.RecM α) + (f : α → TypeChecker.RecM β) (methods context state) : + (x >>= f) methods context state = + match x methods context state with + | .error e => .error e + | .ok (a, state') => f a methods context state' := by + simp [Bind.bind, ReaderT.bind, StateT.bind, Except.bind] + cases h : x methods context state with + | error => rfl + | ok value => cases value; rfl + +@[simp] theorem nilRecMGetEnv (methods context state) : + (liftM TypeChecker.getEnv : + TypeChecker.RecM Kernel.Environment) methods context state = + .ok (context.env, state) := rfl + +@[simp] theorem nilRecMGet (methods context state) : + (get : TypeChecker.RecM TypeChecker.State) + methods context state = .ok (state, state) := rfl + +@[simp] theorem nilRecMPure + {α} (a : α) (methods context state) : + (pure a : TypeChecker.RecM α) methods context state = + .ok (a, state) := rfl + +theorem nilCandidateInductiveReduceRec + (methods : TypeChecker.Methods) (state : TypeChecker.State) : + inductiveReduceRec ctorEnv nilCandidateBody + (fun e => TypeChecker.Inner.whnf e) + (fun e => TypeChecker.Inner.inferType e) + TypeChecker.Inner.isDefEq + methods (tcContext nilCandidateAlphaLctx) state = + .ok (none, state) := by + unfold inductiveReduceRec + rw [nilCandidateBodyGetAppFn] + simp only + rw [type_lookup_family] + rfl + +theorem nilCandidateReduceRecursor + (methods : TypeChecker.Methods) (state : TypeChecker.State) : + TypeChecker.Inner.reduceRecursor nilCandidateBody false false + methods (tcContext nilCandidateAlphaLctx) state = + .ok (none, state) := by + unfold TypeChecker.Inner.reduceRecursor + have hquot : ctorEnv.quotInit = false := by rfl + simp only [nilRecMBind, nilRecMGetEnv] + rw [show (tcContext nilCandidateAlphaLctx).env = ctorEnv by rfl] + rw [hquot] + simp only [Bool.false_eq_true, if_false, nilRecMBind, nilRecMPure] + rw [nilCandidateInductiveReduceRec methods state] + rfl + +@[simp] theorem nilCandidateWhnfCoreFamily (n state) : + TypeChecker.Inner.whnfCore + (.const ``IndexedVec [.param `u]) false false + (TypeChecker.Methods.withFuel (n + 1)) + (tcContext nilCandidateAlphaLctx) state = + .ok (.const ``IndexedVec [.param `u], state) := by + rfl + +theorem nilCandidateWhnfCoreInitial (n : Nat) : + TypeChecker.Inner.whnfCore' nilCandidateBody false false + (TypeChecker.Methods.withFuel (n + 1)) + (tcContext nilCandidateAlphaLctx) ({} : TypeChecker.State) = + .ok (nilCandidateBody, ({} : TypeChecker.State)) := by + rw [nilCandidateBodyShape] + change TypeChecker.Inner.whnfCore' + (.app (.app (.const ``IndexedVec [.param `u]) + (.fvar nilCandidateAlphaId)) (.const ``Nat.zero [])) + false false (TypeChecker.Methods.withFuel (n + 1)) + (tcContext nilCandidateAlphaLctx) ({} : TypeChecker.State) = _ + unfold TypeChecker.Inner.whnfCore' + simp only [nilRecMPure, nilRecMBind, nilRecMGet, + Std.HashMap.getElem?_empty] + rw [Expr.withRevApp_eq] + simp only [nilRecMBind] + rw [show + (Expr.app + (Expr.app (Expr.const ``IndexedVec [.param `u]) + (Expr.fvar nilCandidateAlphaId)) + (Expr.const ``Nat.zero [])).getAppFn = + (Expr.const ``IndexedVec [.param `u]) by rfl] + rw [nilCandidateWhnfCoreFamily n ({} : TypeChecker.State)] + simp [nilCandidateBodyShape, nilCandidateBodyExpr, + nilCandidateFirstApp, nilCandidateReduceRecursor, + Expr.eqv_eq, Bind.bind, ReaderT.bind, StateT.bind, Except.bind] + rw [show + .app (.app (.const ``IndexedVec [.param `u]) + (.fvar nilCandidateAlphaId)) (.const ``Nat.zero []) = + nilCandidateBody by + symm; exact nilCandidateBodyShape] + rw [nilCandidateReduceRecursor] + rfl + +@[simp] theorem nilCandidateReduceNative + (env : Kernel.Environment) (methods : TypeChecker.Methods) + (state : TypeChecker.State) : + (liftM (TypeChecker.Inner.reduceNative env nilCandidateBody) : + TypeChecker.RecM (Option Expr)) + methods (tcContext nilCandidateAlphaLctx) state = + .ok (none, state) := by + rw [nilCandidateBodyShape] + simp [TypeChecker.Inner.reduceNative, nilCandidateBodyExpr, + nilCandidateFirstApp, Expr.eqv_eq] + +@[simp] theorem nilCandidateReduceNat + (methods : TypeChecker.Methods) (state : TypeChecker.State) : + TypeChecker.Inner.reduceNat nilCandidateBody + methods (tcContext nilCandidateAlphaLctx) state = + .ok (none, state) := by + rw [nilCandidateBodyShape] + simp [TypeChecker.Inner.reduceNat, nilCandidateBodyExpr, + nilCandidateFirstApp, Expr.getAppNumArgs_eq, + Expr.getAppArgsRevList, Expr.appFn!, Expr.eqv_const] + +theorem nilCandidateIsDeltaFamily : + TypeChecker.Inner.isDelta ctorEnv + (.const ``IndexedVec [.param `u]) = none := by + unfold TypeChecker.Inner.isDelta + rw [show + (Expr.const ``IndexedVec [.param `u]).getAppFn = + Expr.const ``IndexedVec [.param `u] by rfl] + simp only + rw [type_lookup_family] + simp [indexedVecInfo, ConstantInfo.deltaValue?] + +theorem nilCandidateUnfoldFamily + (methods : TypeChecker.Methods) (state : TypeChecker.State) : + TypeChecker.Inner.unfoldDefinitionCore + (.const ``IndexedVec [.param `u]) + methods (tcContext nilCandidateAlphaLctx) state = + .ok (none, state) := by + unfold TypeChecker.Inner.unfoldDefinitionCore + simp only [nilRecMBind, nilRecMGetEnv] + rw [show (tcContext nilCandidateAlphaLctx).env = ctorEnv by rfl] + rw [nilCandidateIsDeltaFamily] + rfl + +theorem nilCandidateUnfoldBody + (methods : TypeChecker.Methods) (state : TypeChecker.State) : + TypeChecker.Inner.unfoldDefinition nilCandidateBody + methods (tcContext nilCandidateAlphaLctx) state = + .ok (none, state) := by + unfold TypeChecker.Inner.unfoldDefinition + rw [show nilCandidateBody.isApp = true by + rw [nilCandidateBodyShape] + rfl] + simp only [if_true] + rw [nilCandidateBodyGetAppFn] + simp only [nilRecMBind] + rw [nilCandidateUnfoldFamily] + rfl + +theorem nilCandidateWhnfLoop : + TypeChecker.Inner.whnf'.loop nilCandidateBody 100000 + (TypeChecker.Methods.withFuel 9999) + (tcContext nilCandidateAlphaLctx) ({} : TypeChecker.State) = + .ok (nilCandidateBody, ({} : TypeChecker.State)) := by + rw [show 100000 = 99999 + 1 by rfl] + unfold TypeChecker.Inner.whnf'.loop + rw [show 9999 = 9998 + 1 by rfl] + simp only [nilRecMBind, nilRecMGetEnv] + rw [nilCandidateWhnfCoreInitial 9998] + simp only [nilRecMBind] + rw [nilCandidateReduceNative] + simp only [nilRecMBind, nilRecMPure] + rw [nilCandidateReduceNat] + simp only [nilRecMBind, nilRecMPure] + rw [nilCandidateUnfoldBody] + rfl + +theorem nilCandidateBodyWhnfM : + TypeChecker.M.run nilCandidateBodyContext.env + nilCandidateBodyContext.safety nilCandidateBodyContext.lctx + nilCandidateBodyContext.lparams nilCandidateBodyContext.fuel + (TypeChecker.whnf nilCandidateBody) = .ok nilCandidateBody := by + rw [nilCandidateBodyShape] + change Except.map (fun x : Expr × TypeChecker.State => x.1) + (TypeChecker.Inner.whnf' + (.app (.app (.const ``IndexedVec [.param `u]) + (.fvar nilCandidateAlphaId)) (.const ``Nat.zero [])) + (TypeChecker.Methods.withFuel 9999) + (tcContext nilCandidateAlphaLctx) ({} : TypeChecker.State)) = + .ok (.app (.app (.const ``IndexedVec [.param `u]) + (.fvar nilCandidateAlphaId)) (.const ``Nat.zero [])) + unfold TypeChecker.Inner.whnf' + simp + rw [show + (if (tcContext nilCandidateAlphaLctx).eagerReduce then + (tcContext nilCandidateAlphaLctx).fuel.whnfEager + else (tcContext nilCandidateAlphaLctx).fuel.whnf) = 100000 by rfl] + rw [show + TypeChecker.Inner.whnf'.loop + (.app (.app (.const ``IndexedVec [.param `u]) + (.fvar nilCandidateAlphaId)) (.const ``Nat.zero [])) 100000 + (TypeChecker.Methods.withFuel 9999) + (tcContext nilCandidateAlphaLctx) ({} : TypeChecker.State) = + .ok (.app (.app (.const ``IndexedVec [.param `u]) + (.fvar nilCandidateAlphaId)) (.const ``Nat.zero []), + ({} : TypeChecker.State)) by + simpa [nilCandidateBodyShape, nilCandidateBodyExpr, + nilCandidateFirstApp] using nilCandidateWhnfLoop] + simp [Functor.map, StateT.map, Except.map] + +def nilDomainAnnotations : + AddInductive.CandidateTypeAnnotations + (.sort (.succ (.param `u))) where + consumed := .sort (.succ (.param `u)) + trace := .identity _ + +theorem nilDomainAnnotationTraceBuild : + AddInductive.CandidateTypeAnnotationTrace.build + (.sort (.succ (.param `u))) = + ⟨.sort (.succ (.param `u)), .identity _⟩ := by + simp [AddInductive.CandidateTypeAnnotationTrace.build] + +theorem nilDomainAnnotationsBuild : + AddInductive.buildCandidateTypeAnnotations + (.sort (.succ (.param `u))) = .ok nilDomainAnnotations := by + unfold AddInductive.buildCandidateTypeAnnotations + rw [nilDomainAnnotationTraceBuild] + rfl + +theorem nilDomainAnnotationsEq : + AddInductive.CandidateIsDefEqStep.Valid + ⟨nilCandidateContext, (.sort (.succ (.param `u))), + nilDomainAnnotations.consumed⟩ := by + simpa [nilDomainAnnotations] using + (candidateIsDefEqSelfValid nilCandidateContext + (.sort (.succ (.param `u))) 9999 rfl) + +theorem nilCandidateContextFresh : + nilCandidateContext.lctx.find? + nilCandidateContext.freshFVarId = none := by + change ({} : LocalContext).find? nilCandidateAlphaId = none + exact nilCandidateFresh + +theorem nilRootCheckValid : + AddInductive.CandidateCheckTypeStep.Valid + ⟨nilCandidateContext, indexedVecNilInfo.type, + .sort nilCtorInferredLevel⟩ := by + simpa [AddInductive.CandidateCheckTypeStep.Valid, + nilCandidateContext, ctorContext] using nilRootCheckTypeM + +theorem nilRootWhnfValid : + AddInductive.CandidateWhnfStep.Valid + ⟨nilCandidateContext, indexedVecNilInfo.type, + indexedVecNilInfo.type⟩ := by + simpa [AddInductive.CandidateWhnfStep.Valid, + nilCandidateContext, ctorContext] using nilRootWhnfM + +theorem nilDomainCheckValid : + AddInductive.CandidateCheckTypeStep.Valid + ⟨nilCandidateContext, (.sort (.succ (.param `u))), + .sort (.succ (.succ (.param `u)))⟩ := by + simpa [AddInductive.CandidateCheckTypeStep.Valid] using + nilDomainCheckTypeM + +theorem nilDomainWhnfValid : + AddInductive.CandidateWhnfStep.Valid + ⟨nilCandidateContext, (.sort (.succ (.param `u))), + .sort (.succ (.param `u))⟩ := by + simpa [AddInductive.CandidateWhnfStep.Valid] using nilDomainWhnfM + +theorem nilBodyCheckValid : + AddInductive.CandidateCheckTypeStep.Valid + ⟨nilCandidateBodyContext, nilCandidateBody, + .sort (.succ (.param `u))⟩ := by + simpa [AddInductive.CandidateCheckTypeStep.Valid] using + nilCandidateBodyCheckTypeM + +theorem nilBodyWhnfValid : + AddInductive.CandidateWhnfStep.Valid + ⟨nilCandidateBodyContext, nilCandidateBody, + nilCandidateBody⟩ := by + simpa [AddInductive.CandidateWhnfStep.Valid] using + nilCandidateBodyWhnfM + +def nilDomainCandidateTrace : + AddInductive.CandidateExprTrace nilCandidateContext + (.sort (.succ (.param `u))) := + .terminal nilCandidateContext (.sort (.succ (.param `u))) + (.sort (.succ (.succ (.param `u)))) + (.sort (.succ (.param `u))) + nilDomainCheckValid nilDomainWhnfValid + +def nilBodyCandidateTrace : + AddInductive.CandidateExprTrace nilCandidateBodyContext + (nilCtorBodyRaw.instantiate1 nilCandidateContext.freshExpr) := + .terminal nilCandidateBodyContext + (nilCtorBodyRaw.instantiate1 nilCandidateContext.freshExpr) + (.sort (.succ (.param `u))) nilCandidateBody + (by simpa [nilCandidateBody] using nilBodyCheckValid) + (by simpa [nilCandidateBody] using nilBodyWhnfValid) + +def nilCandidateTrace : + AddInductive.CandidateExprTrace nilCandidateContext + indexedVecNilInfo.type := + .forallE nilCandidateContext indexedVecNilInfo.type + (.sort nilCtorInferredLevel) `α + (.sort (.succ (.param `u))) nilCtorBodyRaw .implicit + nilCandidateContextFresh nilDomainAnnotations + nilDomainAnnotationsEq nilRootCheckValid + (by simpa [nilInfoTypeShape, nilCtorTypeRaw] using nilRootWhnfValid) + nilDomainCandidateTrace nilBodyCandidateTrace + +def nilCandidate : AddInductive.CandidateExpr indexedVecNilInfo.type := + ⟨nilCandidateContext, nilCandidateTrace⟩ + +theorem nilCandidate_view_eq : + nilCandidate.view = indexedVecNilInfo.type := by + have habstract (context : AddInductive.Context) (e : Expr) : + e.abstract #[context.freshExpr] = + Expr.abstract1 context.freshFVarId e := by + rw [show #[context.freshExpr] = + ⟨[context.freshFVarId].map Expr.fvar⟩ by rfl] + simp only [Expr.abstract_eq, Expr.abstractList] + simp only [nilCandidate, AddInductive.CandidateExpr.view, + nilCandidateTrace, nilDomainCandidateTrace, nilBodyCandidateTrace, + AddInductive.CandidateExprTrace.view] + rw [habstract] + rw [nilInfoTypeShape] + simp [nilCandidateBody, nilCtorTypeRaw, nilCtorBodyRaw, + Expr.instantiate1_eq, Expr.instantiate1', Expr.abstract1, + nilCandidateContext, ctorContext, + AddInductive.Context.freshExpr, + AddInductive.Context.freshFVarId, + NameGenerator.curr] + +/-- The retained `nil` candidate is identity-normalizing at its root, domain, +and instantiated result. -/ +theorem nilCandidate_identity : + TypeChecker.CandidateExprIdentity nilCandidate.trace := by + change TypeChecker.CandidateExprIdentity nilCandidateTrace + unfold nilCandidateTrace + refine .forallE (name := `α) (binderInfo := .implicit) + (body := nilCtorBodyRaw) (annotations := nilDomainAnnotations) + nilDomainCandidateTrace nilBodyCandidateTrace + (by simpa [nilCtorTypeRaw] using nilInfoTypeShape) + rfl (.terminal rfl) (.terminal (by rfl)) + +theorem nilDomainCandidateTraceLoop (fuel : Nat) : + AddInductive.buildCandidateExpr.loop nilCandidateContext + (.sort (.succ (.param `u))) (fuel + 1) = + .ok nilDomainCandidateTrace := by + simpa only [nilDomainCandidateTrace] using + AddInductive.buildCandidateExpr_loop_of_whnf_nonForall + nilCandidateContext (.sort (.succ (.param `u))) + (.sort (.succ (.succ (.param `u)))) + (.sort (.succ (.param `u))) fuel + nilDomainCheckValid nilDomainWhnfValid rfl + +theorem nilBodyCandidateTraceLoop (fuel : Nat) : + AddInductive.buildCandidateExpr.loop nilCandidateBodyContext + (nilCtorBodyRaw.instantiate1 nilCandidateContext.freshExpr) + (fuel + 1) = .ok nilBodyCandidateTrace := by + simpa only [nilBodyCandidateTrace] using + AddInductive.buildCandidateExpr_loop_of_whnf_nonForall + nilCandidateBodyContext + (nilCtorBodyRaw.instantiate1 nilCandidateContext.freshExpr) + (.sort (.succ (.param `u))) nilCandidateBody fuel + (by simpa [nilCandidateBody] using nilBodyCheckValid) + (by simpa [nilCandidateBody] using nilBodyWhnfValid) + (by rw [nilCandidateBodyShape]; rfl) + +theorem nilCandidateTraceLoop : + AddInductive.buildCandidateExpr.loop nilCandidateContext + indexedVecNilInfo.type nilCandidateContext.fuel.inductiveFuel = + .ok nilCandidateTrace := by + change AddInductive.buildCandidateExpr.loop nilCandidateContext + indexedVecNilInfo.type (999 + 1) = _ + simpa only [nilCandidateTrace, nilCandidateBodyContext] using + (AddInductive.buildCandidateExpr_loop_of_whnf_forall + (context := nilCandidateContext) + (e := indexedVecNilInfo.type) + (inferred := .sort nilCtorInferredLevel) + (fuel := 999) (name := `α) + (domain := .sort (.succ (.param `u))) + (body := nilCtorBodyRaw) (binderInfo := .implicit) + (hfresh := nilCandidateContextFresh) + (annotations := nilDomainAnnotations) + (hannotations := nilDomainAnnotationsBuild) + (hannotationsEq := nilDomainAnnotationsEq) + (hcheck := nilRootCheckValid) + (hrun := by + simpa [nilInfoTypeShape, nilCtorTypeRaw] using nilRootWhnfValid) + (domainCandidate := nilDomainCandidateTrace) + (bodyCandidate := nilBodyCandidateTrace) + (hdomain := by + simpa using nilDomainCandidateTraceLoop 998) + (hbody := by + simpa [nilCandidateBodyContext, nilDomainAnnotations] using + nilBodyCandidateTraceLoop 998)) + +theorem nilCandidateProduced : + AddInductive.buildCandidateExpr indexedVecNilInfo.type + nilCandidateContext = .ok nilCandidate := by + unfold AddInductive.buildCandidateExpr + simp only [readThe, MonadReaderOf.read, ReaderT.read, + ReaderT.bind, Bind.bind, ReaderT.pure, Pure.pure, + Except.bind, Except.pure] + rw [nilCandidateTraceLoop] + rfl + +/-! ## `IndexedVec.cons` source and candidate contexts -/ + +def consAlphaName : Name := + indexedVecConsInfo.type.bindingName! + +def consNName : Name := + indexedVecConsInfo.type.bindingBody!.bindingName! + +def consHeadName : Name := + indexedVecConsInfo.type.bindingBody!.bindingBody!.bindingName! + +def consTailName : Name := + indexedVecConsInfo.type.bindingBody!.bindingBody!.bindingBody!.bindingName! + +def consTerminalRaw : Expr := + .app (.app (.const ``IndexedVec [.param `u]) (.bvar 3)) + (.app (.const ``Nat.succ []) (.bvar 2)) + +def consTailTypeRaw : Expr := + .forallE consTailName + (.app (.app (.const ``IndexedVec [.param `u]) (.bvar 2)) (.bvar 1)) + consTerminalRaw .default + +def consHeadTypeRaw : Expr := + .forallE consHeadName (.bvar 1) consTailTypeRaw .default + +def consNTypeRaw : Expr := + .forallE consNName (.const ``Nat []) consHeadTypeRaw .implicit + +def consCtorTypeRaw : Expr := + .forallE consAlphaName (.sort (.succ (.param `u))) + consNTypeRaw .implicit + +theorem consInfoTypeShape : + indexedVecConsInfo.type = consCtorTypeRaw := by + rfl + +def consRootContext : AddInductive.Context := ctorContext + +def consAlphaId : FVarId := consRootContext.freshFVarId + +def consAlphaExpr : Expr := consRootContext.freshExpr + +def consAlphaContext : AddInductive.Context := + consRootContext.pushLocalDecl consAlphaName .implicit + (.sort (.succ (.param `u))) + +def consNId : FVarId := consAlphaContext.freshFVarId + +def consNExpr : Expr := consAlphaContext.freshExpr + +def consNContext : AddInductive.Context := + consAlphaContext.pushLocalDecl consNName .implicit (.const ``Nat []) + +def consHeadId : FVarId := consNContext.freshFVarId + +def consHeadExpr : Expr := consNContext.freshExpr + +def consAfterAlpha : Expr := + .forallE consNName (.const ``Nat []) + (.forallE consHeadName consAlphaExpr + (.forallE consTailName + (.app (.app (.const ``IndexedVec [.param `u]) consAlphaExpr) + (.bvar 1)) + (.app (.app (.const ``IndexedVec [.param `u]) consAlphaExpr) + (.app (.const ``Nat.succ []) (.bvar 2))) + .default) + .default) + .implicit + +def consAfterN : Expr := + .forallE consHeadName consAlphaExpr + (.forallE consTailName + (.app (.app (.const ``IndexedVec [.param `u]) consAlphaExpr) + consNExpr) + (.app (.app (.const ``IndexedVec [.param `u]) consAlphaExpr) + (.app (.const ``Nat.succ []) consNExpr)) + .default) + .default + +def consHeadContext : AddInductive.Context := + consNContext.pushLocalDecl consHeadName .default consAlphaExpr + +def consTailId : FVarId := consHeadContext.freshFVarId + +def consTailExpr : Expr := consHeadContext.freshExpr + +def consTailDomain : Expr := + .app (.app (.const ``IndexedVec [.param `u]) consAlphaExpr) consNExpr + +def consAfterHead : Expr := + .forallE consTailName consTailDomain + (.app (.app (.const ``IndexedVec [.param `u]) consAlphaExpr) + (.app (.const ``Nat.succ []) consNExpr)) + .default + +def consTailContext : AddInductive.Context := + consHeadContext.pushLocalDecl consTailName .default consTailDomain + +def consTerminal : Expr := + .app (.app (.const ``IndexedVec [.param `u]) consAlphaExpr) + (.app (.const ``Nat.succ []) consNExpr) + +@[simp] theorem consLiftLooseBVarsFVar + (id : FVarId) (s d : Nat) : + (Expr.fvar id).liftLooseBVars' s d = .fvar id := by + rfl + +@[simp] theorem consInstantiateFVar + (id : FVarId) (a : Expr) (k : Nat) : + (Expr.fvar id).instantiate1' a k = .fvar id := by + rfl + +theorem consAfterAlphaShape : + consNTypeRaw.instantiate1 consRootContext.freshExpr = + consAfterAlpha := by + simp [consNTypeRaw, consHeadTypeRaw, consTailTypeRaw, + consTerminalRaw, consAfterAlpha, consAlphaExpr, + consRootContext, ctorContext, + AddInductive.Context.freshExpr, + Expr.instantiate1_eq, Expr.instantiate1', + Expr.liftLooseBVars_zero] + +theorem consAfterNShape : + consAfterAlpha.bindingBody!.instantiate1 + consAlphaContext.freshExpr = consAfterN := by + simp [consAfterAlpha, consAfterN, consAlphaExpr, consNExpr, + consRootContext, consAlphaContext, ctorContext, + AddInductive.Context.pushLocalDecl, + AddInductive.Context.freshExpr, + Expr.bindingBody!, Expr.instantiate1_eq, Expr.instantiate1', + Expr.liftLooseBVars_zero] + +theorem consAfterHeadShape : + consAfterN.bindingBody!.instantiate1 + consNContext.freshExpr = consAfterHead := by + simp [consAfterN, consAfterHead, consTailDomain, + consAlphaExpr, consNExpr, consRootContext, consAlphaContext, + consNContext, ctorContext, AddInductive.Context.pushLocalDecl, + AddInductive.Context.freshExpr, + Expr.bindingBody!, Expr.instantiate1_eq, Expr.instantiate1', + Expr.liftLooseBVars_zero] + +theorem consTerminalShape : + consAfterHead.bindingBody!.instantiate1 + consHeadContext.freshExpr = consTerminal := by + simp [consAfterHead, consTerminal, consAlphaExpr, consNExpr, + consRootContext, consAlphaContext, consNContext, + consHeadContext, ctorContext, AddInductive.Context.pushLocalDecl, + AddInductive.Context.freshExpr, Expr.bindingBody!, + Expr.instantiate1_eq, Expr.instantiate1', + Expr.liftLooseBVars_zero] + +@[simp] theorem consAlphaExprShape : + consAlphaExpr = .fvar consAlphaId := by + rfl + +@[simp] theorem consNExprShape : + consNExpr = .fvar consNId := by + rfl + +@[simp] theorem consHeadExprShape : + consHeadExpr = .fvar consHeadId := by + rfl + +@[simp] theorem consTailExprShape : + consTailExpr = .fvar consTailId := by + rfl + +theorem consRootFresh : + consRootContext.lctx.find? consRootContext.freshFVarId = none := by + simpa [consRootContext, nilCandidateContext] using nilCandidateContextFresh + +theorem consAlphaContextWF : consAlphaContext.lctx.WF := by + change (({} : LocalContext).mkLocalDecl + consRootContext.freshFVarId consAlphaName + (.sort (.succ (.param `u))) .implicit).WF + exact LocalContext.WF.mkLocalDecl LocalContext.WF.nil (by + have h := LocalContext.WF.find?_eq_find?_toList + (fv := consRootContext.freshFVarId) LocalContext.WF.nil + change + ({ fvarIdToDecl := PersistentHashMap.empty, + decls := PersistentArray.empty, + auxDeclToFullName := Std.TreeMap.empty } : LocalContext).find? + consRootContext.freshFVarId = none + rw [h] + simp [LocalContext.toList]) + +theorem consAlphaContextFresh : + consAlphaContext.lctx.find? consAlphaContext.freshFVarId = none := by + have h := LocalContext.WF.find?_eq_find?_toList + (fv := consAlphaContext.freshFVarId) consAlphaContextWF + rw [h] + simp only [consAlphaContext, consRootContext, ctorContext, + AddInductive.Context.pushLocalDecl, + AddInductive.Context.freshFVarId] + rw [LocalContext.mkLocalDecl_toList] + rw [show ({} : LocalContext).toList = [] by rfl] + simp [NameGenerator.next, NameGenerator.curr] + intro heq + injection heq with hname + injection hname with hidx + omega + +theorem consNContextWF : consNContext.lctx.WF := by + simpa [consNContext, AddInductive.Context.pushLocalDecl] using + (LocalContext.WF.mkLocalDecl consAlphaContextWF consAlphaContextFresh) + +theorem consNContextFresh : + consNContext.lctx.find? consNContext.freshFVarId = none := by + have h := LocalContext.WF.find?_eq_find?_toList + (fv := consNContext.freshFVarId) consNContextWF + rw [h] + simp only [consNContext, consAlphaContext, consRootContext, ctorContext, + AddInductive.Context.pushLocalDecl, + AddInductive.Context.freshFVarId] + rw [LocalContext.mkLocalDecl_toList, LocalContext.mkLocalDecl_toList] + rw [show ({} : LocalContext).toList = [] by rfl] + simp [NameGenerator.next, NameGenerator.curr] + constructor <;> intro heq + · injection heq with hname + injection hname with hidx + omega + · injection heq with hname + injection hname with hidx + omega + +theorem consHeadContextWF : consHeadContext.lctx.WF := by + simpa [consHeadContext, AddInductive.Context.pushLocalDecl] using + (LocalContext.WF.mkLocalDecl consNContextWF consNContextFresh) + +theorem consHeadContextFresh : + consHeadContext.lctx.find? consHeadContext.freshFVarId = none := by + have h := LocalContext.WF.find?_eq_find?_toList + (fv := consHeadContext.freshFVarId) consHeadContextWF + rw [h] + simp only [consHeadContext, consNContext, consAlphaContext, + consRootContext, ctorContext, AddInductive.Context.pushLocalDecl, + AddInductive.Context.freshFVarId] + rw [LocalContext.mkLocalDecl_toList, LocalContext.mkLocalDecl_toList, + LocalContext.mkLocalDecl_toList] + rw [show ({} : LocalContext).toList = [] by rfl] + simp [NameGenerator.next, NameGenerator.curr] + constructor + · intro heq + injection heq with hname + injection hname with hidx + omega + · constructor <;> intro heq + · injection heq with hname + injection hname with hidx + omega + · injection heq with hname + injection hname with hidx + omega + +theorem consTailContextWF : consTailContext.lctx.WF := by + simpa [consTailContext, AddInductive.Context.pushLocalDecl] using + (LocalContext.WF.mkLocalDecl consHeadContextWF consHeadContextFresh) + +theorem consAlphaFindInHead : + consHeadContext.lctx.find? consAlphaId = + some (.cdecl 0 consAlphaId consAlphaName + (.sort (.succ (.param `u))) .implicit .default) := by + rw [consHeadContextWF.find?_eq_find?_toList] + simp [consHeadContext, consNContext, consAlphaContext, + consRootContext, ctorContext, consAlphaId, consNId, consHeadId, + AddInductive.Context.pushLocalDecl, + AddInductive.Context.freshFVarId, + LocalContext.mkLocalDecl_toList, + LocalContext.mkLocalDecl, LocalContext.toList, LocalDecl.fvarId, + NameGenerator.next, NameGenerator.curr] + +theorem consAlphaFindInN : + consNContext.lctx.find? consAlphaId = + some (.cdecl 0 consAlphaId consAlphaName + (.sort (.succ (.param `u))) .implicit .default) := by + rw [consNContextWF.find?_eq_find?_toList] + simp [consNContext, consAlphaContext, consRootContext, ctorContext, + consAlphaId, consNId, AddInductive.Context.pushLocalDecl, + AddInductive.Context.freshFVarId, + LocalContext.mkLocalDecl_toList, LocalContext.mkLocalDecl, + LocalContext.toList, LocalDecl.fvarId, + NameGenerator.next, NameGenerator.curr] + +theorem consNFindInHead : + consHeadContext.lctx.find? consNId = + some (.cdecl 1 consNId consNName (.const ``Nat []) + .implicit .default) := by + rw [consHeadContextWF.find?_eq_find?_toList] + simp [consHeadContext, consNContext, consAlphaContext, + consRootContext, ctorContext, consAlphaId, consNId, consHeadId, + AddInductive.Context.pushLocalDecl, + AddInductive.Context.freshFVarId, + LocalContext.mkLocalDecl_toList, + LocalContext.mkLocalDecl, LocalContext.toList, LocalDecl.fvarId, + NameGenerator.next, NameGenerator.curr] + +theorem consAlphaFindInTail : + consTailContext.lctx.find? consAlphaId = + some (.cdecl 0 consAlphaId consAlphaName + (.sort (.succ (.param `u))) .implicit .default) := by + rw [consTailContextWF.find?_eq_find?_toList] + simp [consTailContext, consHeadContext, consNContext, + consAlphaContext, consRootContext, ctorContext, + consAlphaId, consNId, consHeadId, consTailId, + AddInductive.Context.pushLocalDecl, + AddInductive.Context.freshFVarId, + LocalContext.mkLocalDecl_toList, + LocalContext.mkLocalDecl, LocalContext.toList, LocalDecl.fvarId, + NameGenerator.next, NameGenerator.curr] + +theorem consNFindInTail : + consTailContext.lctx.find? consNId = + some (.cdecl 1 consNId consNName (.const ``Nat []) + .implicit .default) := by + rw [consTailContextWF.find?_eq_find?_toList] + simp [consTailContext, consHeadContext, consNContext, + consAlphaContext, consRootContext, ctorContext, + consAlphaId, consNId, consHeadId, consTailId, + AddInductive.Context.pushLocalDecl, + AddInductive.Context.freshFVarId, + LocalContext.mkLocalDecl_toList, + LocalContext.mkLocalDecl, LocalContext.toList, LocalDecl.fvarId, + NameGenerator.next, NameGenerator.curr] + +/-! ## Reusable post-family atom observations -/ + +theorem ctorNatCheckTypeM (lctx : LocalContext) : + TypeChecker.M.run ctorEnv .safe lctx [`u] ({} : FuelConfig) + (TypeChecker.checkType (.const ``Nat [])) = + .ok (.sort (.succ .zero)) := by + change Except.map (fun x : Expr × TypeChecker.State => x.1) + (TypeChecker.Inner.inferType (.const ``Nat []) false + (TypeChecker.Methods.withFuel 10000) (tcContext lctx) + ({} : TypeChecker.State)) = _ + change Except.map (fun x : Expr × TypeChecker.State => x.1) + (TypeChecker.Inner.inferType' (.const ``Nat []) false + (TypeChecker.Methods.withFuel 9999) (tcContext lctx) + ({} : TypeChecker.State)) = _ + rw [inferTypeNatCore 9999 lctx ({} : TypeChecker.State) + (by simp)] + rfl + +theorem ctorUnfoldNat (lctx methods state) : + TypeChecker.Inner.unfoldDefinition (.const ``Nat []) + methods (tcContext lctx) state = .ok (none, state) := by + change TypeChecker.Inner.unfoldDefinitionCore (.const ``Nat []) + methods (tcContext lctx) state = _ + simp [TypeChecker.Inner.unfoldDefinitionCore, + TypeChecker.Inner.isDelta, Expr.getAppFn, tcContext, + type_lookup_nat, natInfo, ConstantInfo.deltaValue?, + Bind.bind, ReaderT.bind, StateT.bind, Except.bind] + +theorem ctorWhnfLoopNat (lctx methods state n) : + TypeChecker.Inner.whnf'.loop (.const ``Nat []) (n + 1) + methods (tcContext lctx) state = + .ok (.const ``Nat [], state) := by + unfold TypeChecker.Inner.whnf'.loop + simp [ctorUnfoldNat] + +theorem ctorNatWhnfM (lctx : LocalContext) : + TypeChecker.M.run ctorEnv .safe lctx [`u] ({} : FuelConfig) + (TypeChecker.whnf (.const ``Nat [])) = + .ok (.const ``Nat []) := by + change Except.map (fun x : Expr × TypeChecker.State => x.1) + (TypeChecker.Inner.whnf' (.const ``Nat []) + (TypeChecker.Methods.withFuel 9999) (tcContext lctx) + ({} : TypeChecker.State)) = _ + unfold TypeChecker.Inner.whnf' + simp + rw [show + (if (tcContext lctx).eagerReduce then + (tcContext lctx).fuel.whnfEager + else (tcContext lctx).fuel.whnf) = 100000 by rfl] + rw [show 100000 = 99999 + 1 by rfl] + rw [ctorWhnfLoopNat] + simp [Functor.map, StateT.map, Except.map] + +theorem ctorFVarCheckTypeM + (lctx : LocalContext) (id : FVarId) (type : Expr) + (hfind : lctx.find? id = some (.cdecl index id name type bi kind)) : + TypeChecker.M.run ctorEnv .safe lctx [`u] ({} : FuelConfig) + (TypeChecker.checkType (.fvar id)) = .ok type := by + change Except.map (fun x : Expr × TypeChecker.State => x.1) + (TypeChecker.Inner.inferType (.fvar id) false + (TypeChecker.Methods.withFuel 10000) (tcContext lctx) + ({} : TypeChecker.State)) = _ + change Except.map (fun x : Expr × TypeChecker.State => x.1) + (TypeChecker.Inner.inferType' (.fvar id) false + (TypeChecker.Methods.withFuel 9999) (tcContext lctx) + ({} : TypeChecker.State)) = _ + rw [inferTypeFVarCore 9999 lctx ({} : TypeChecker.State) + id type (by simp) hfind] + rfl + +theorem ctorFVarWhnfM + (lctx : LocalContext) (id : FVarId) + (hfind : lctx.find? id = some (.cdecl index id name type bi kind)) : + TypeChecker.M.run ctorEnv .safe lctx [`u] ({} : FuelConfig) + (TypeChecker.whnf (.fvar id)) = .ok (.fvar id) := by + change Except.map (fun x : Expr × TypeChecker.State => x.1) + (TypeChecker.Inner.whnf' (.fvar id) + (TypeChecker.Methods.withFuel 9999) (tcContext lctx) + ({} : TypeChecker.State)) = _ + unfold TypeChecker.Inner.whnf' + simp only [nilRecMBind] + rw [show (getLCtx : TypeChecker.RecM LocalContext) + (TypeChecker.Methods.withFuel 9999) + (tcContext lctx) ({} : TypeChecker.State) = + .ok (lctx, ({} : TypeChecker.State)) by rfl] + simp [TypeChecker.Inner.isLetFVar, hfind, nilRecMPure] + rfl + +/-! A uniform WHNF observation for opaque applications of the inserted +`IndexedVec` family. -/ + +def ctorIndexedVecApp (alpha index : Expr) : Expr := + .app (.app (.const ``IndexedVec [.param `u]) alpha) index + +@[simp] theorem ctorIndexedVecAppGetAppFn (alpha index : Expr) : + (ctorIndexedVecApp alpha index).getAppFn = + .const ``IndexedVec [.param `u] := by + rfl + +theorem ctorIndexedVecInductiveReduceRec + {m : Type → Type} [Monad m] + (alpha index : Expr) (whnf inferType : Expr → m Expr) + (isDefEq : Expr → Expr → m Bool) : + inductiveReduceRec ctorEnv (ctorIndexedVecApp alpha index) + whnf inferType isDefEq = pure none := by + unfold inductiveReduceRec + rw [ctorIndexedVecAppGetAppFn] + simp only + rw [type_lookup_family] + rfl + +theorem ctorIndexedVecReduceRecursor + (lctx : LocalContext) (alpha index : Expr) + (methods : TypeChecker.Methods) (state : TypeChecker.State) : + TypeChecker.Inner.reduceRecursor (ctorIndexedVecApp alpha index) + false false methods (tcContext lctx) state = + .ok (none, state) := by + unfold TypeChecker.Inner.reduceRecursor + have hquot : ctorEnv.quotInit = false := by rfl + simp only [nilRecMBind, nilRecMGetEnv] + rw [show (tcContext lctx).env = ctorEnv by rfl] + rw [hquot] + simp only [Bool.false_eq_true, if_false, nilRecMBind, nilRecMPure] + rw [ctorIndexedVecInductiveReduceRec] + rfl + +@[simp] theorem ctorIndexedVecWhnfCoreFamily + (lctx : LocalContext) (n : Nat) (state : TypeChecker.State) : + TypeChecker.Inner.whnfCore + (.const ``IndexedVec [.param `u]) false false + (TypeChecker.Methods.withFuel (n + 1)) (tcContext lctx) state = + .ok (.const ``IndexedVec [.param `u], state) := by + rfl + +theorem ctorIndexedVecWhnfCoreInitial + (lctx : LocalContext) (alpha index : Expr) (n : Nat) : + TypeChecker.Inner.whnfCore' (ctorIndexedVecApp alpha index) + false false (TypeChecker.Methods.withFuel (n + 1)) + (tcContext lctx) ({} : TypeChecker.State) = + .ok (ctorIndexedVecApp alpha index, ({} : TypeChecker.State)) := by + unfold ctorIndexedVecApp TypeChecker.Inner.whnfCore' + simp only [nilRecMPure, nilRecMBind, nilRecMGet, + Std.HashMap.getElem?_empty] + rw [Expr.withRevApp_eq] + simp only [nilRecMBind] + rw [show + (Expr.app (Expr.app (Expr.const ``IndexedVec [.param `u]) alpha) + index).getAppFn = Expr.const ``IndexedVec [.param `u] by rfl] + rw [ctorIndexedVecWhnfCoreFamily lctx n ({} : TypeChecker.State)] + simp [ctorIndexedVecApp, ctorIndexedVecReduceRecursor, + Expr.eqv_eq, Bind.bind, ReaderT.bind, StateT.bind, Except.bind] + rw [show + Expr.app (Expr.app (Expr.const ``IndexedVec [.param `u]) alpha) + index = ctorIndexedVecApp alpha index by rfl] + rw [ctorIndexedVecReduceRecursor] + rfl + +@[simp] theorem ctorIndexedVecReduceNative + (lctx : LocalContext) (env : Kernel.Environment) + (alpha index : Expr) (methods : TypeChecker.Methods) + (state : TypeChecker.State) : + (liftM (TypeChecker.Inner.reduceNative env + (ctorIndexedVecApp alpha index)) : + TypeChecker.RecM (Option Expr)) + methods (tcContext lctx) state = .ok (none, state) := by + cases index <;> + simp [ctorIndexedVecApp, TypeChecker.Inner.reduceNative, Expr.eqv_eq] + +@[simp] theorem ctorIndexedVecReduceNat + (lctx : LocalContext) (alpha index : Expr) + (methods : TypeChecker.Methods) (state : TypeChecker.State) : + TypeChecker.Inner.reduceNat (ctorIndexedVecApp alpha index) + methods (tcContext lctx) state = .ok (none, state) := by + simp [ctorIndexedVecApp, TypeChecker.Inner.reduceNat, + Expr.getAppNumArgs_eq, Expr.getAppArgsRevList, + Expr.appFn!, Expr.eqv_const] + +theorem ctorIndexedVecUnfoldFamily + (lctx : LocalContext) (methods : TypeChecker.Methods) + (state : TypeChecker.State) : + TypeChecker.Inner.unfoldDefinitionCore + (.const ``IndexedVec [.param `u]) methods (tcContext lctx) state = + .ok (none, state) := by + unfold TypeChecker.Inner.unfoldDefinitionCore + simp only [nilRecMBind, nilRecMGetEnv] + rw [show (tcContext lctx).env = ctorEnv by rfl] + rw [nilCandidateIsDeltaFamily] + rfl + +theorem ctorIndexedVecUnfold + (lctx : LocalContext) (alpha index : Expr) + (methods : TypeChecker.Methods) (state : TypeChecker.State) : + TypeChecker.Inner.unfoldDefinition (ctorIndexedVecApp alpha index) + methods (tcContext lctx) state = .ok (none, state) := by + unfold TypeChecker.Inner.unfoldDefinition + rw [show (ctorIndexedVecApp alpha index).isApp = true by rfl] + simp only [if_true] + rw [ctorIndexedVecAppGetAppFn] + simp only [nilRecMBind] + rw [ctorIndexedVecUnfoldFamily] + rfl + +theorem ctorIndexedVecWhnfLoop + (lctx : LocalContext) (alpha index : Expr) : + TypeChecker.Inner.whnf'.loop (ctorIndexedVecApp alpha index) 100000 + (TypeChecker.Methods.withFuel 9999) (tcContext lctx) + ({} : TypeChecker.State) = + .ok (ctorIndexedVecApp alpha index, ({} : TypeChecker.State)) := by + rw [show 100000 = 99999 + 1 by rfl] + unfold TypeChecker.Inner.whnf'.loop + rw [show 9999 = 9998 + 1 by rfl] + simp only [nilRecMBind, nilRecMGetEnv] + rw [ctorIndexedVecWhnfCoreInitial lctx alpha index 9998] + simp only [nilRecMBind] + rw [ctorIndexedVecReduceNative] + simp only [nilRecMBind, nilRecMPure] + rw [ctorIndexedVecReduceNat] + simp only [nilRecMBind, nilRecMPure] + rw [ctorIndexedVecUnfold] + rfl + +theorem ctorIndexedVecWhnfM + (lctx : LocalContext) (alpha index : Expr) : + TypeChecker.M.run ctorEnv .safe lctx [`u] ({} : FuelConfig) + (TypeChecker.whnf (ctorIndexedVecApp alpha index)) = + .ok (ctorIndexedVecApp alpha index) := by + change Except.map (fun x : Expr × TypeChecker.State => x.1) + (TypeChecker.Inner.whnf' (ctorIndexedVecApp alpha index) + (TypeChecker.Methods.withFuel 9999) (tcContext lctx) + ({} : TypeChecker.State)) = _ + unfold ctorIndexedVecApp + unfold TypeChecker.Inner.whnf' + simp + rw [show + (if (tcContext lctx).eagerReduce then + (tcContext lctx).fuel.whnfEager + else (tcContext lctx).fuel.whnf) = 100000 by rfl] + have hloop := ctorIndexedVecWhnfLoop lctx alpha index + simp only [ctorIndexedVecApp] at hloop + rw [hloop] + simp [Functor.map, StateT.map, Except.map] + +end Lean4Lean.InductiveReplayFixtures diff --git a/Lean4Lean/Verify/Environment/IndexedVecOuterReplay.lean b/Lean4Lean/Verify/Environment/IndexedVecOuterReplay.lean new file mode 100644 index 00000000..6b088357 --- /dev/null +++ b/Lean4Lean/Verify/Environment/IndexedVecOuterReplay.lean @@ -0,0 +1,1593 @@ +import Lean4Lean.Verify.Environment.IndexedVecConsReplay + +/-! +# IndexedVec outer normalization-candidate replay + +Exact post-family declaration and constructor-validation executions for the +real one-parameter, one-index `IndexedVec` metadata. The final theorem closes +the complete `buildNormalizationCandidate` call and retains the ordered +`nil`/`cons` candidate package produced in the staged kernel environments. +-/ + +namespace Lean4Lean.InductiveReplayFixtures +open Lean Meta +open Lean4Lean.InductiveFixtures +open IndexedVecConsReplay + +def indexedVecCtorValidationContext : AddInductive.Context := + { indexedVecFamilyCandidate.trace.terminalContext with env := ctorEnv } + +def indexedVecValidationAlpha : Expr := + indexedVecFamilyCandidateContext.freshExpr + +def indexedVecValidationAlphaId : FVarId := + indexedVecFamilyCandidateContext.freshFVarId + +def indexedVecValidationIndexId : FVarId := + ⟨indexedVecFamilyCandidateContext.ngen.next.curr⟩ + +theorem validationTerminalEnv : + indexedVecFamilyCandidate.trace.terminalContext.env = + indexedVecKernelEnv := by + rfl + +theorem validationTerminalLparams : + indexedVecFamilyCandidate.trace.terminalContext.lparams = [`u] := by + rfl + +theorem validationTerminalAllowPrimitive : + indexedVecFamilyCandidate.trace.terminalContext.allowPrimitive = false := by + rfl + +theorem validationFamilyEnvNotContains : + indexedVecKernelEnv.contains ``IndexedVec = false := by + unfold Kernel.Environment.contains + change natMap.contains ``IndexedVec = false + rw [SMap.find?_isSome, indexedVecType_fresh] + rfl + +theorem validationFamilyEnvCheckName : + indexedVecKernelEnv.checkName ``IndexedVec false = .ok () := by + simp [Kernel.Environment.checkName, validationFamilyEnvNotContains, + Kernel.Environment.primitives, NameSet.ofList, NameSet.contains, + Bind.bind, Except.bind, Pure.pure, Except.pure] + +theorem indexedVecDeclareRoot : + AddInductive.declareInductiveTypes indexedVecCandidateInductiveStats 1 + #[indexedVecKernelType] 0 false + indexedVecFamilyCandidateContext = + .ok ctorEnv := by + simp [AddInductive.declareInductiveTypes, + indexedVecCandidateInductiveStats_nindices, + indexedVecCandidateInductiveStats_indConsts, + indexedVecKernelType, indexedVecKernelNil, indexedVecKernelCons, + indexedVecInfo, indexedVecNilInfo, indexedVecConsInfo, + ConstantInfo.name, ConstantInfo.type, ConstantInfo.toConstantVal, + ctorEnv, indexedVecKernelEnv, indexedVecFamilyCandidateContext, + indexedVecTypeMap, + AddInductive.isRec, AddInductive.isRec.loop, + AddInductive.isReflexive, AddInductive.isReflexive.loop, + AddInductive.hasIndOcc, Expr.constName!, + Bind.bind, Pure.pure, Except.bind, Except.pure] + have hcheck : + (Kernel.Environment.ofConstants `_indexedVecCandidate natMap).checkName + ``IndexedVec false = .ok () := by + simpa [indexedVecKernelEnv] using validationFamilyEnvCheckName + rw [hcheck] + rfl + +theorem indexedVecDeclareFromTerminal : + AddInductive.declareInductiveTypes indexedVecCandidateInductiveStats 1 + #[indexedVecKernelType] 0 false + indexedVecFamilyCandidate.trace.terminalContext = + .ok ctorEnv := by + calc + _ = AddInductive.declareInductiveTypes + indexedVecCandidateInductiveStats 1 #[indexedVecKernelType] + 0 false indexedVecFamilyCandidateContext := + AddInductive.declareInductiveTypes_context_eq _ _ _ _ _ _ _ + validationTerminalEnv validationTerminalLparams + validationTerminalAllowPrimitive + _ = .ok ctorEnv := indexedVecDeclareRoot + +example : indexedVecCtorValidationContext.env = ctorEnv := by rfl +example : indexedVecCtorValidationContext.lparams = [`u] := by rfl +example : indexedVecCtorValidationContext.safety = .safe := by rfl +example : indexedVecCtorValidationContext.allowPrimitive = false := by rfl +example : indexedVecCtorValidationContext.fuel = ({} : FuelConfig) := by rfl +example : indexedVecCtorValidationContext.ngen = + ({ namePrefix := `_ind_fresh } : NameGenerator).next.next := by rfl + +def indexedVecValidationParamName : Name := + indexedVecInfo.type.bindingName! + +def indexedVecValidationIndexName : Name := + indexedVecInfo.type.bindingBody!.bindingName! + +def indexedVecValidationParamContext : AddInductive.Context := + indexedVecFamilyCandidateContext.pushLocalDecl + indexedVecValidationParamName .default + (.sort (.succ (.param `u))) + +def indexedVecValidationFamilyContext : AddInductive.Context := + indexedVecValidationParamContext.pushLocalDecl + indexedVecValidationIndexName .default (.const ``Nat []) + +theorem indexedVecValidationTerminalContextShape : + indexedVecFamilyCandidate.trace.terminalContext = + indexedVecValidationFamilyContext := by + rfl + +theorem indexedVecCtorValidationContextShape : + indexedVecCtorValidationContext = + { indexedVecValidationFamilyContext with env := ctorEnv } := by + rfl + +theorem indexedVecValidationParamContextWF : + indexedVecValidationParamContext.lctx.WF := by + have hfresh : indexedVecFamilyCandidateContext.lctx.find? + indexedVecFamilyCandidateContext.freshFVarId = none := by + have h := LocalContext.WF.find?_eq_find?_toList + (fv := indexedVecFamilyCandidateContext.freshFVarId) + LocalContext.WF.nil + change + ({ fvarIdToDecl := PersistentHashMap.empty, + decls := PersistentArray.empty, + auxDeclToFullName := Std.TreeMap.empty } : LocalContext).find? + indexedVecFamilyCandidateContext.freshFVarId = none + rw [h] + simp [LocalContext.toList] + change (({} : LocalContext).mkLocalDecl + indexedVecFamilyCandidateContext.freshFVarId + indexedVecValidationParamName + (.sort (.succ (.param `u))) .default).WF + exact LocalContext.WF.mkLocalDecl LocalContext.WF.nil hfresh + +theorem indexedVecValidationFamilyContextFresh : + indexedVecValidationParamContext.lctx.find? + indexedVecValidationParamContext.freshFVarId = none := by + have h := LocalContext.WF.find?_eq_find?_toList + (fv := indexedVecValidationParamContext.freshFVarId) + indexedVecValidationParamContextWF + rw [h] + simp only [indexedVecValidationParamContext, + indexedVecFamilyCandidateContext, + AddInductive.Context.pushLocalDecl, + AddInductive.Context.freshFVarId] + rw [LocalContext.mkLocalDecl_toList] + rw [show ({} : LocalContext).toList = [] by rfl] + simp [NameGenerator.next, NameGenerator.curr] + intro heq + injection heq with hname + injection hname with hidx + omega + +theorem indexedVecValidationFamilyContextWF : + indexedVecValidationFamilyContext.lctx.WF := by + simpa [indexedVecValidationFamilyContext, + AddInductive.Context.pushLocalDecl] using + (LocalContext.WF.mkLocalDecl indexedVecValidationParamContextWF + indexedVecValidationFamilyContextFresh) + +theorem indexedVecValidationAlphaFind : + indexedVecCtorValidationContext.lctx.find? + indexedVecValidationAlphaId = + some (.cdecl 0 indexedVecValidationAlphaId + indexedVecValidationParamName + (.sort (.succ (.param `u))) .default .default) := by + change indexedVecValidationFamilyContext.lctx.find? + indexedVecValidationAlphaId = _ + rw [indexedVecValidationFamilyContextWF.find?_eq_find?_toList] + simp [indexedVecValidationFamilyContext, + indexedVecValidationParamContext, + indexedVecValidationAlphaId, + indexedVecFamilyCandidateContext, + AddInductive.Context.pushLocalDecl, + AddInductive.Context.freshFVarId, + LocalContext.mkLocalDecl, + LocalContext.toList, LocalDecl.fvarId, + NameGenerator.next, NameGenerator.curr] + +@[simp] theorem indexedVecValidationAlphaShape : indexedVecValidationAlpha = + .fvar indexedVecValidationAlphaId := by rfl + +theorem localContextFindNew + (lctx : LocalContext) (id : FVarId) (name : Name) + (type : Expr) (bi : BinderInfo) (kind : LocalDeclKind) + (hwf : lctx.WF) (hfresh : lctx.find? id = none) : + (lctx.mkLocalDecl id name type bi kind).find? id = + some (.cdecl lctx.decls.size id name type bi kind) := by + have hwf' := LocalContext.WF.mkLocalDecl + (name := name) (ty := type) (bi := bi) (kind := kind) hwf hfresh + rw [hwf'.find?_eq_find?_toList] + rw [LocalContext.mkLocalDecl_toList] + simp [LocalDecl.fvarId] + +theorem localContextFindOld + (lctx : LocalContext) (oldId newId : FVarId) + (newName : Name) (newType : Expr) (newBi : BinderInfo) + (newKind : LocalDeclKind) (oldDecl : LocalDecl) + (hwf : lctx.WF) (hfresh : lctx.find? newId = none) + (hne : oldId ≠ newId) (hold : lctx.find? oldId = some oldDecl) : + (lctx.mkLocalDecl newId newName newType newBi newKind).find? oldId = + some oldDecl := by + have hwf' := LocalContext.WF.mkLocalDecl + (name := newName) (ty := newType) (bi := newBi) + (kind := newKind) hwf hfresh + rw [hwf'.find?_eq_find?_toList] + rw [LocalContext.mkLocalDecl_toList] + simp only [List.find?_cons, LocalDecl.fvarId] + rw [show (oldId == newId) = false by + exact beq_eq_false_iff_ne.mpr hne] + rw [hwf.find?_eq_find?_toList] at hold + simpa only [LocalDecl.fvarId] using hold + +def validationFirstAppState (alphaId : FVarId) : TypeChecker.State := + replayInsert + (replayInsert + (replayInsert ({} : TypeChecker.State) + (.const ``IndexedVec [.param `u]) indexedVecInfo.type) + (.fvar alphaId) (.sort (.succ (.param `u)))) + (replayFirstApp (.fvar alphaId)) vecFamilyTail + +def validationIndexState (alphaId nId : FVarId) : TypeChecker.State := + replayInsert (validationFirstAppState alphaId) + (.fvar nId) (.const ``Nat []) + +def validationIndexedVecState + (alphaId nId : FVarId) : TypeChecker.State := + replayInsert (validationIndexState alphaId nId) + (ctorIndexedVecApp (.fvar alphaId) (.fvar nId)) + (.sort (.succ (.param `u))) + +theorem ctorIndexedVecFVarCheckTypeM + (lctx : LocalContext) (alphaId nId : FVarId) + (hne : alphaId ≠ nId) + (halpha : lctx.find? alphaId = some (.cdecl alphaIndex alphaId + alphaName (.sort (.succ (.param `u))) alphaBi alphaKind)) + (hn : lctx.find? nId = some (.cdecl nIndex nId nName + (.const ``Nat []) nBi nKind)) : + TypeChecker.M.run ctorEnv .safe lctx [`u] ({} : FuelConfig) + (TypeChecker.checkType + (ctorIndexedVecApp (.fvar alphaId) (.fvar nId))) = + .ok (.sort (.succ (.param `u))) := by + have hfirst : + TypeChecker.Inner.inferType' + (replayFirstApp (.fvar alphaId)) false + (TypeChecker.Methods.withFuel 9999) (tcContext lctx) + ({} : TypeChecker.State) = + .ok (vecFamilyTail, validationFirstAppState alphaId) := by + simpa [validationFirstAppState] using + (replayInferFirstAppFVarCore 9999 lctx + ({} : TypeChecker.State) alphaId + (by simp) + (by simp [replayInsert]) + (by simp [replayFirstApp]) + halpha) + have hnmiss : + (validationFirstAppState alphaId).inferTypeC[ + (.fvar nId : Expr)]? = none := by + have halphaN : + ((.fvar alphaId : Expr) == .fvar nId) = false := by + change Expr.eqv (.fvar alphaId) (.fvar nId) = false + rw [Expr.eqv_eq] + simp [Expr.eqv', hne] + simp [validationFirstAppState, replayInsert, replayFirstApp, + halphaN] + have hnrun : + TypeChecker.Inner.inferType' (.fvar nId) false + (TypeChecker.Methods.withFuel 9999) (tcContext lctx) + (validationFirstAppState alphaId) = + .ok (.const ``Nat [], validationIndexState alphaId nId) := by + simpa [validationIndexState, replayInsert] using + (inferTypeFVarCore 9999 lctx + (validationFirstAppState alphaId) nId (.const ``Nat []) + hnmiss hn) + have htail : + (({} : TypeChecker.State).inferTypeC[ + ctorIndexedVecApp (.fvar alphaId) (.fvar nId)]?) = none := by + simp + have hrun : + TypeChecker.Inner.inferType' + (ctorIndexedVecApp (.fvar alphaId) (.fvar nId)) false + (TypeChecker.Methods.withFuel 9999) (tcContext lctx) + ({} : TypeChecker.State) = + .ok (.sort (.succ (.param `u)), + validationIndexedVecState alphaId nId) := by + simpa [validationIndexedVecState] using + (replayInferIndexedVecAppCore 9999 lctx + ({} : TypeChecker.State) (validationFirstAppState alphaId) + (validationIndexState alphaId nId) + (.fvar alphaId) (.fvar nId) + (by simp [ctorIndexedVecApp, Expr.hasLooseBVars, + Expr.looseBVarRange']) + htail hfirst hnrun (by rfl)) + change Except.map (fun x : Expr × TypeChecker.State => x.1) + (TypeChecker.Inner.inferType' + (ctorIndexedVecApp (.fvar alphaId) (.fvar nId)) false + (TypeChecker.Methods.withFuel 9999) (tcContext lctx) + ({} : TypeChecker.State)) = _ + rw [hrun] + rfl + +def indexedVecValidationNilResult : Expr := + ctorIndexedVecApp indexedVecValidationAlpha (.const ``Nat.zero []) + +def indexedVecValidationConsAfterParam : Expr := + consNTypeRaw.instantiate1 indexedVecValidationAlpha + +def indexedVecValidationNId : FVarId := + indexedVecCtorValidationContext.freshFVarId + +def indexedVecValidationNExpr : Expr := + indexedVecCtorValidationContext.freshExpr + +@[simp] theorem indexedVecValidationNExprShape : + indexedVecValidationNExpr = .fvar indexedVecValidationNId := by + rfl + +def indexedVecValidationNContext : AddInductive.Context := + indexedVecCtorValidationContext.pushLocalDecl + consNName .implicit (.const ``Nat []) + +def indexedVecValidationConsAfterN : Expr := + .forallE consHeadName indexedVecValidationAlpha + (.forallE consTailName + (ctorIndexedVecApp indexedVecValidationAlpha + indexedVecValidationNExpr) + (ctorIndexedVecApp indexedVecValidationAlpha + (replaySuccApp indexedVecValidationNExpr)) + .default) + .default + +def indexedVecValidationHeadId : FVarId := + indexedVecValidationNContext.freshFVarId + +def indexedVecValidationHeadExpr : Expr := + indexedVecValidationNContext.freshExpr + +@[simp] theorem indexedVecValidationHeadExprShape : + indexedVecValidationHeadExpr = + .fvar indexedVecValidationHeadId := by + rfl + +def indexedVecValidationHeadContext : AddInductive.Context := + indexedVecValidationNContext.pushLocalDecl + consHeadName .default indexedVecValidationAlpha + +def indexedVecValidationConsAfterHead : Expr := + .forallE consTailName + (ctorIndexedVecApp indexedVecValidationAlpha + indexedVecValidationNExpr) + (ctorIndexedVecApp indexedVecValidationAlpha + (replaySuccApp indexedVecValidationNExpr)) + .default + +def indexedVecValidationTailId : FVarId := + indexedVecValidationHeadContext.freshFVarId + +def indexedVecValidationTailContext : AddInductive.Context := + indexedVecValidationHeadContext.pushLocalDecl consTailName .default + (ctorIndexedVecApp indexedVecValidationAlpha + indexedVecValidationNExpr) + +def indexedVecValidationConsResult : Expr := + ctorIndexedVecApp indexedVecValidationAlpha + (replaySuccApp indexedVecValidationNExpr) + +theorem indexedVecValidationNilResultShape : + indexedVecNilInfo.type.bindingBody!.instantiate1 + indexedVecValidationAlpha = + indexedVecValidationNilResult := by + simp [indexedVecNilInfo, ConstantInfo.type, + ConstantInfo.toConstantVal, indexedVecValidationNilResult, + ctorIndexedVecApp, indexedVecValidationAlpha, + indexedVecFamilyCandidateContext, + Expr.bindingBody!, Expr.instantiate1_eq, Expr.instantiate1', + Expr.liftLooseBVars_zero] + +theorem indexedVecValidationConsAfterParamShape : + indexedVecConsInfo.type.bindingBody!.instantiate1 + indexedVecValidationAlpha = + indexedVecValidationConsAfterParam := by + rw [consInfoTypeShape] + rfl + +theorem indexedVecValidationConsAfterParamExplicitShape : + indexedVecValidationConsAfterParam = + .forallE consNName (.const ``Nat []) + (.forallE consHeadName indexedVecValidationAlpha + (.forallE consTailName + (ctorIndexedVecApp indexedVecValidationAlpha (.bvar 1)) + (ctorIndexedVecApp indexedVecValidationAlpha + (replaySuccApp (.bvar 2))) + .default) + .default) + .implicit := by + simp [indexedVecValidationConsAfterParam, consNTypeRaw, + consHeadTypeRaw, consTailTypeRaw, consTerminalRaw, + ctorIndexedVecApp, replaySuccApp, + Expr.instantiate1_eq, Expr.instantiate1'] + +theorem indexedVecValidationConsAfterNShape : + indexedVecValidationConsAfterParam.bindingBody!.instantiate1 + indexedVecValidationNExpr = + indexedVecValidationConsAfterN := by + simp [indexedVecValidationConsAfterParam, consNTypeRaw, + consHeadTypeRaw, consTailTypeRaw, consTerminalRaw, + indexedVecValidationConsAfterN, + indexedVecValidationNExpr, + indexedVecValidationAlpha, + indexedVecCtorValidationContext, + indexedVecValidationTerminalContextShape, + indexedVecValidationFamilyContext, + indexedVecValidationParamContext, + indexedVecFamilyCandidateContext, + ctorIndexedVecApp, replaySuccApp, + AddInductive.Context.freshExpr, + AddInductive.Context.freshFVarId, + Expr.bindingBody!, Expr.instantiate1_eq, Expr.instantiate1', + NameGenerator.curr] + +theorem indexedVecValidationConsAfterHeadShape : + indexedVecValidationConsAfterN.bindingBody!.instantiate1 + indexedVecValidationHeadExpr = + indexedVecValidationConsAfterHead := by + simp [indexedVecValidationConsAfterN, + indexedVecValidationConsAfterHead, + ctorIndexedVecApp, replaySuccApp, + Expr.bindingBody!, Expr.instantiate1_eq, Expr.instantiate1'] + +theorem indexedVecValidationConsResultShape : + indexedVecValidationConsAfterHead.bindingBody!.instantiate1 + indexedVecValidationHeadContext.freshExpr = + indexedVecValidationConsResult := by + simp [indexedVecValidationConsAfterHead, + indexedVecValidationConsResult, + ctorIndexedVecApp, replaySuccApp, + Expr.bindingBody!, Expr.instantiate1_eq, Expr.instantiate1'] + +theorem indexedVecCtorValidationContextWF : + indexedVecCtorValidationContext.lctx.WF := by + simpa [indexedVecCtorValidationContextShape] using + indexedVecValidationFamilyContextWF + +theorem indexedVecCtorValidationContextLctxSize : + indexedVecCtorValidationContext.lctx.decls.size = 2 := by + change indexedVecFamilyCandidate.trace.terminalContext.lctx.decls.size = 2 + rw [indexedVecValidationTerminalContextShape] + simp [indexedVecValidationFamilyContext, + indexedVecValidationParamContext, + indexedVecFamilyCandidateContext, + AddInductive.Context.pushLocalDecl, + LocalContext.mkLocalDecl] + +theorem indexedVecCtorValidationContextFresh : + indexedVecCtorValidationContext.lctx.find? + indexedVecCtorValidationContext.freshFVarId = none := by + have h := LocalContext.WF.find?_eq_find?_toList + (fv := indexedVecCtorValidationContext.freshFVarId) + indexedVecCtorValidationContextWF + rw [h] + simp only [indexedVecCtorValidationContext, + indexedVecValidationTerminalContextShape, + indexedVecValidationFamilyContext, + indexedVecValidationParamContext, + indexedVecFamilyCandidateContext, + AddInductive.Context.pushLocalDecl, + AddInductive.Context.freshFVarId] + rw [LocalContext.mkLocalDecl_toList, + LocalContext.mkLocalDecl_toList] + rw [show ({} : LocalContext).toList = [] by rfl] + simp [NameGenerator.next, NameGenerator.curr] + constructor <;> intro heq + · injection heq with hname + injection hname with hidx + omega + · injection heq with hname + injection hname with hidx + omega + +theorem indexedVecValidationNContextWF : + indexedVecValidationNContext.lctx.WF := by + simpa [indexedVecValidationNContext, + AddInductive.Context.pushLocalDecl] using + (LocalContext.WF.mkLocalDecl indexedVecCtorValidationContextWF + indexedVecCtorValidationContextFresh) + +theorem indexedVecValidationNContextFresh : + indexedVecValidationNContext.lctx.find? + indexedVecValidationNContext.freshFVarId = none := by + have h := LocalContext.WF.find?_eq_find?_toList + (fv := indexedVecValidationNContext.freshFVarId) + indexedVecValidationNContextWF + rw [h] + simp only [indexedVecValidationNContext, + indexedVecCtorValidationContext, + indexedVecValidationTerminalContextShape, + indexedVecValidationFamilyContext, + indexedVecValidationParamContext, + indexedVecFamilyCandidateContext, + AddInductive.Context.pushLocalDecl, + AddInductive.Context.freshFVarId] + rw [LocalContext.mkLocalDecl_toList, + LocalContext.mkLocalDecl_toList, + LocalContext.mkLocalDecl_toList] + rw [show ({} : LocalContext).toList = [] by rfl] + simp [NameGenerator.next, NameGenerator.curr] + constructor + · intro heq + injection heq with hname + injection hname with hidx + omega + · constructor <;> intro heq + · injection heq with hname + injection hname with hidx + omega + · injection heq with hname + injection hname with hidx + omega + +theorem indexedVecValidationHeadContextWF : + indexedVecValidationHeadContext.lctx.WF := by + simpa [indexedVecValidationHeadContext, + AddInductive.Context.pushLocalDecl] using + (LocalContext.WF.mkLocalDecl indexedVecValidationNContextWF + indexedVecValidationNContextFresh) + +theorem indexedVecValidationAlphaNeN : + indexedVecValidationAlphaId ≠ indexedVecValidationNId := by + change indexedVecValidationAlphaId ≠ + indexedVecCtorValidationContext.freshFVarId + intro heq + have hfresh := indexedVecCtorValidationContextFresh + rw [← heq] at hfresh + rw [indexedVecValidationAlphaFind] at hfresh + contradiction + +theorem indexedVecValidationNNeHead : + indexedVecValidationNId ≠ indexedVecValidationHeadId := by + change indexedVecValidationNId ≠ + indexedVecValidationNContext.freshFVarId + intro heq + have hfresh := indexedVecValidationNContextFresh + rw [← heq] at hfresh + have hnew := localContextFindNew + indexedVecCtorValidationContext.lctx indexedVecValidationNId + consNName (.const ``Nat []) .implicit .default + indexedVecCtorValidationContextWF + indexedVecCtorValidationContextFresh + have hfind : indexedVecValidationNContext.lctx.find? + indexedVecValidationNId = some (.cdecl 2 + indexedVecValidationNId consNName (.const ``Nat []) + .implicit .default) := by + rw [indexedVecCtorValidationContextLctxSize] at hnew + simpa [indexedVecValidationNContext, + indexedVecValidationNId, + AddInductive.Context.pushLocalDecl] using hnew + rw [hfind] at hfresh + contradiction + +theorem indexedVecValidationAlphaFindInN : + indexedVecValidationNContext.lctx.find? + indexedVecValidationAlphaId = + some (.cdecl 0 indexedVecValidationAlphaId + indexedVecValidationParamName + (.sort (.succ (.param `u))) .default .default) := by + have h := localContextFindOld + (lctx := indexedVecCtorValidationContext.lctx) + (oldId := indexedVecValidationAlphaId) + (newId := indexedVecValidationNId) + (newName := consNName) (newType := .const ``Nat []) + (newBi := .implicit) (newKind := .default) + (oldDecl := .cdecl 0 indexedVecValidationAlphaId + indexedVecValidationParamName (.sort (.succ (.param `u))) + .default .default) + indexedVecCtorValidationContextWF + indexedVecCtorValidationContextFresh + indexedVecValidationAlphaNeN indexedVecValidationAlphaFind + simpa [indexedVecValidationNContext, + indexedVecValidationNId, + AddInductive.Context.pushLocalDecl] using h + +theorem indexedVecValidationNFindInHead : + indexedVecValidationHeadContext.lctx.find? + indexedVecValidationNId = + some (.cdecl 2 indexedVecValidationNId consNName + (.const ``Nat []) .implicit .default) := by + have hnew := localContextFindNew + indexedVecCtorValidationContext.lctx indexedVecValidationNId + consNName (.const ``Nat []) .implicit .default + indexedVecCtorValidationContextWF + indexedVecCtorValidationContextFresh + have hold : indexedVecValidationNContext.lctx.find? + indexedVecValidationNId = + some (.cdecl 2 indexedVecValidationNId consNName + (.const ``Nat []) .implicit .default) := by + rw [indexedVecCtorValidationContextLctxSize] at hnew + simpa [indexedVecValidationNContext, + indexedVecValidationNId, + AddInductive.Context.pushLocalDecl] using hnew + have h := localContextFindOld + (lctx := indexedVecValidationNContext.lctx) + (oldId := indexedVecValidationNId) + (newId := indexedVecValidationHeadId) + (newName := consHeadName) + (newType := indexedVecValidationAlpha) + (newBi := .default) (newKind := .default) + (oldDecl := .cdecl 2 indexedVecValidationNId consNName + (.const ``Nat []) .implicit .default) + indexedVecValidationNContextWF indexedVecValidationNContextFresh + indexedVecValidationNNeHead hold + simpa [indexedVecValidationHeadContext, + indexedVecValidationHeadId, + AddInductive.Context.pushLocalDecl] using h + +theorem indexedVecValidationAlphaFindInHead : + indexedVecValidationHeadContext.lctx.find? + indexedVecValidationAlphaId = + some (.cdecl 0 indexedVecValidationAlphaId + indexedVecValidationParamName + (.sort (.succ (.param `u))) .default .default) := by + have hne : indexedVecValidationAlphaId ≠ + indexedVecValidationHeadId := by + change indexedVecValidationAlphaId ≠ + indexedVecValidationNContext.freshFVarId + intro heq + have hfresh := indexedVecValidationNContextFresh + rw [← heq] at hfresh + rw [indexedVecValidationAlphaFindInN] at hfresh + contradiction + have h := localContextFindOld + (lctx := indexedVecValidationNContext.lctx) + (oldId := indexedVecValidationAlphaId) + (newId := indexedVecValidationHeadId) + (newName := consHeadName) + (newType := indexedVecValidationAlpha) + (newBi := .default) (newKind := .default) + (oldDecl := .cdecl 0 indexedVecValidationAlphaId + indexedVecValidationParamName (.sort (.succ (.param `u))) + .default .default) + indexedVecValidationNContextWF indexedVecValidationNContextFresh + hne indexedVecValidationAlphaFindInN + simpa [indexedVecValidationHeadContext, + indexedVecValidationHeadId, + AddInductive.Context.pushLocalDecl] using h + +theorem indexedVecValidationGetTypeAlpha : + AddInductive.getType indexedVecValidationAlpha + indexedVecCtorValidationContext = + .ok (.sort (.succ (.param `u))) := by + unfold AddInductive.getType + simp only [getLCtx, + ReaderT.bind, Bind.bind, ReaderT.pure, Pure.pure, + Except.bind, Except.pure] + change Except.ok ((indexedVecCtorValidationContext.lctx.get! + indexedVecValidationAlpha.fvarId!).type) = _ + rw [show indexedVecValidationAlpha.fvarId! = + indexedVecValidationAlphaId by + rw [indexedVecValidationAlphaShape] + rfl] + simp [LocalContext.get!, indexedVecValidationAlphaFind, + LocalDecl.type] + +theorem indexedVecValidationParamIsDefEq : + TypeChecker.M.run indexedVecCtorValidationContext.env + indexedVecCtorValidationContext.safety + indexedVecCtorValidationContext.lctx + indexedVecCtorValidationContext.lparams + indexedVecCtorValidationContext.fuel + (TypeChecker.isDefEq (.sort (.succ (.param `u))) + (.sort (.succ (.param `u)))) = .ok true := by + exact candidateIsDefEqSelfValid indexedVecCtorValidationContext + (.sort (.succ (.param `u))) 9999 rfl + +theorem indexedVecNilNoMVarNoFVar : + ctorEnv.checkNoMVarNoFVar indexedVecKernelNil.name + indexedVecKernelNil.type = .ok () := by + have hexpr : indexedVecKernelNil.type.data.hasExprMVar = false := by + change indexedVecNilInfo.type.hasExprMVar = false + rw [Expr.hasExprMVar_eq] + rfl + have hlevel : indexedVecKernelNil.type.data.hasLevelMVar = false := by + change indexedVecNilInfo.type.hasLevelMVar = false + rw [Expr.hasLevelMVar_eq] + simp [indexedVecNilInfo, ConstantInfo.type, + ConstantInfo.toConstantVal, Expr.hasLevelMVar', + Level.hasMVar_eq, Level.hasMVar'] + have hfvar : indexedVecKernelNil.type.data.hasFVar = false := by + change indexedVecNilInfo.type.hasFVar = false + rw [Expr.hasFVar_eq] + rfl + unfold Kernel.Environment.checkNoMVarNoFVar + Kernel.Environment.checkNoMVar Kernel.Environment.checkNoFVar + rw [show indexedVecKernelNil.type.hasMVar = false by + change (indexedVecKernelNil.type.data.hasExprMVar || + indexedVecKernelNil.type.data.hasLevelMVar) = false + rw [hexpr, hlevel] + rfl] + rw [show indexedVecKernelNil.type.hasFVar = false by + exact hfvar] + rfl + +theorem indexedVecConsNoMVarNoFVar : + ctorEnv.checkNoMVarNoFVar indexedVecKernelCons.name + indexedVecKernelCons.type = .ok () := by + have hexpr : indexedVecKernelCons.type.data.hasExprMVar = false := by + change indexedVecConsInfo.type.hasExprMVar = false + rw [Expr.hasExprMVar_eq] + rfl + have hlevel : indexedVecKernelCons.type.data.hasLevelMVar = false := by + change indexedVecConsInfo.type.hasLevelMVar = false + rw [Expr.hasLevelMVar_eq] + simp [indexedVecConsInfo, ConstantInfo.type, + ConstantInfo.toConstantVal, Expr.hasLevelMVar', + Level.hasMVar_eq, Level.hasMVar'] + have hfvar : indexedVecKernelCons.type.data.hasFVar = false := by + change indexedVecConsInfo.type.hasFVar = false + rw [Expr.hasFVar_eq] + rfl + unfold Kernel.Environment.checkNoMVarNoFVar + Kernel.Environment.checkNoMVar Kernel.Environment.checkNoFVar + rw [show indexedVecKernelCons.type.hasMVar = false by + change (indexedVecKernelCons.type.data.hasExprMVar || + indexedVecKernelCons.type.data.hasLevelMVar) = false + rw [hexpr, hlevel] + rfl] + rw [show indexedVecKernelCons.type.hasFVar = false by + exact hfvar] + rfl + +theorem indexedVecValidationNilRootCheckTypeM : + TypeChecker.M.run indexedVecCtorValidationContext.env + indexedVecCtorValidationContext.safety {} + indexedVecCtorValidationContext.lparams + indexedVecCtorValidationContext.fuel + (TypeChecker.checkType indexedVecKernelNil.type) = + .ok (.sort nilCtorInferredLevel) := by + change TypeChecker.M.run ctorEnv .safe {} [`u] ({} : FuelConfig) + (TypeChecker.checkType indexedVecKernelNil.type) = + .ok (.sort nilCtorInferredLevel) + simpa [indexedVecKernelNil] using nilRootCheckTypeM + +theorem indexedVecValidationConsRootCheckTypeM : + TypeChecker.M.run indexedVecCtorValidationContext.env + indexedVecCtorValidationContext.safety {} + indexedVecCtorValidationContext.lparams + indexedVecCtorValidationContext.fuel + (TypeChecker.checkType indexedVecKernelCons.type) = + .ok (.sort (.succ (.succ (.param `u)))) := by + change TypeChecker.M.run ctorEnv .safe {} [`u] ({} : FuelConfig) + (TypeChecker.checkType indexedVecKernelCons.type) = + .ok (.sort (.succ (.succ (.param `u)))) + simpa [indexedVecKernelCons, consRootContext, ctorContext] using + replayConsRootCheckTypeM + +def validationInferOnlyInsert + (state : TypeChecker.State) (e type : Expr) : TypeChecker.State := + { state with inferTypeI := state.inferTypeI.insert e type } + +@[simp] theorem inferConstantFamilyOnly (lctx : LocalContext) : + TypeChecker.Inner.inferConstant (tcContext lctx) ``IndexedVec + [.param `u] true = .ok indexedVecInfo.type := by + unfold TypeChecker.Inner.inferConstant + simp only [tcContext] + rw [type_get_family] + simp [indexedVecInfo, + ConstantInfo.levelParams, ConstantInfo.type, + ConstantInfo.instantiateTypeLevelParams, + ConstantInfo.toConstantVal, + ConstantVal.instantiateTypeLevelParams, + Expr.instantiateLevelParams_eq, + Expr.instantiateLevelParamsCore', Level.substParams', + Bind.bind, Except.bind, Pure.pure, Except.pure] + +@[simp] theorem inferConstantNatOnly (lctx : LocalContext) : + TypeChecker.Inner.inferConstant (tcContext lctx) ``Nat [] true = + .ok (.sort (.succ .zero)) := by + unfold TypeChecker.Inner.inferConstant + simp [tcContext, natInfo, + ConstantInfo.levelParams, ConstantInfo.instantiateTypeLevelParams, + ConstantInfo.toConstantVal, + ConstantVal.instantiateTypeLevelParams, + Expr.instantiateLevelParams_eq, + Expr.instantiateLevelParamsCore', Level.substParams', + Bind.bind, Except.bind, Pure.pure, Except.pure] + +theorem inferTypeNatOnlyCore + (fuel : Nat) (lctx : LocalContext) (state : TypeChecker.State) + (hcache : state.inferTypeI[(.const ``Nat [] : Expr)]? = none) : + TypeChecker.Inner.inferType' (.const ``Nat []) true + (TypeChecker.Methods.withFuel fuel) (tcContext lctx) state = + .ok (.sort (.succ .zero), + validationInferOnlyInsert state (.const ``Nat []) + (.sort (.succ .zero))) := by + unfold TypeChecker.Inner.inferType' + simp [Expr.hasLooseBVars, Expr.looseBVarRange', hcache, + validationInferOnlyInsert, Bind.bind, ReaderT.bind, + StateT.bind, Except.bind] + +theorem inferTypeFamilyOnlyCore + (fuel : Nat) (lctx : LocalContext) (state : TypeChecker.State) + (hcache : state.inferTypeI[ + (.const ``IndexedVec [.param `u] : Expr)]? = none) : + TypeChecker.Inner.inferType' + (.const ``IndexedVec [.param `u]) true + (TypeChecker.Methods.withFuel fuel) (tcContext lctx) state = + .ok (indexedVecInfo.type, + validationInferOnlyInsert state + (.const ``IndexedVec [.param `u]) indexedVecInfo.type) := by + unfold TypeChecker.Inner.inferType' + simp [Expr.hasLooseBVars, Expr.looseBVarRange', hcache, + validationInferOnlyInsert, Bind.bind, ReaderT.bind, + StateT.bind, Except.bind] + +theorem inferTypeFVarOnlyCore + (fuel : Nat) (lctx : LocalContext) (state : TypeChecker.State) + (id : FVarId) (type : Expr) + (hcache : state.inferTypeI[(.fvar id : Expr)]? = none) + (hfind : lctx.find? id = some (.cdecl index id name type bi kind)) : + TypeChecker.Inner.inferType' (.fvar id) true + (TypeChecker.Methods.withFuel fuel) (tcContext lctx) state = + .ok (type, validationInferOnlyInsert state (.fvar id) type) := by + unfold TypeChecker.Inner.inferType' + simp [Expr.hasLooseBVars, Expr.looseBVarRange', hcache, + TypeChecker.Inner.inferFVar, tcContext, hfind, LocalDecl.type, + validationInferOnlyInsert, Bind.bind, ReaderT.bind, + StateT.bind, Except.bind] + +def validationFamilyOnlyState : TypeChecker.State := + validationInferOnlyInsert ({} : TypeChecker.State) + (.const ``IndexedVec [.param `u]) indexedVecInfo.type + +def validationIndexedVecOnlyState + (alpha index : Expr) : TypeChecker.State := + validationInferOnlyInsert validationFamilyOnlyState + (ctorIndexedVecApp alpha index) (.sort (.succ (.param `u))) + +@[simp] theorem ctorIndexedVecAppGetAppArgs (alpha index : Expr) : + (ctorIndexedVecApp alpha index).getAppArgs = #[alpha, index] := by + rfl + +@[simp] theorem ctorIndexedVecAppGetAppNumArgs (alpha index : Expr) : + (ctorIndexedVecApp alpha index).getAppNumArgs = 2 := by + rfl + +theorem inferTypeIndexedVecOnlyCore + (fuel : Nat) (lctx : LocalContext) (alpha index : Expr) + (hclosed : (ctorIndexedVecApp alpha index).hasLooseBVars = false) : + TypeChecker.Inner.inferType' + (ctorIndexedVecApp alpha index) true + (TypeChecker.Methods.withFuel (fuel + 1)) (tcContext lctx) + ({} : TypeChecker.State) = + .ok (.sort (.succ (.param `u)), + validationIndexedVecOnlyState alpha index) := by + unfold ctorIndexedVecApp at hclosed ⊢ + have hfn : + (((.const ``IndexedVec [.param `u] : Expr).app alpha).app index).getAppFn = + .const ``IndexedVec [.param `u] := by + rfl + have hargs : + (((.const ``IndexedVec [.param `u] : Expr).app alpha).app index).getAppArgs = + #[alpha, index] := by + rfl + unfold TypeChecker.Inner.inferType' + rw [hclosed] + simp [TypeChecker.Inner.inferApp, + TypeChecker.Inner.inferApp.loop, + hfn, hargs, ctorIndexedVecApp, + validationFamilyOnlyState, validationIndexedVecOnlyState, + validationInferOnlyInsert, + inferTypeFamilyOnlyCore, + indexedVecInfoTypeShape, vecFamilyTail, + Expr.instantiate1', + Bind.bind, ReaderT.bind, StateT.bind, Except.bind] + +theorem ensureTypeMOfInferOnly + (context : AddInductive.Context) (e : Expr) (level : Level) + (finalState : TypeChecker.State) + (hrun : TypeChecker.Inner.inferType e true + (TypeChecker.Methods.withFuel context.fuel.recDepth) + context.toTypeChecker ({} : TypeChecker.State) = + .ok (.sort level, finalState)) : + TypeChecker.M.run context.env context.safety context.lctx + context.lparams context.fuel (TypeChecker.ensureType e) = + .ok (.sort level) := by + unfold TypeChecker.ensureType TypeChecker.inferType + TypeChecker.ensureSort TypeChecker.RecM.run TypeChecker.M.run + simp only [readThe, MonadReaderOf.read, ReaderT.read, + Bind.bind, ReaderT.bind, StateT.bind, Except.bind, + Pure.pure, StateT.pure, Except.pure, StateT.run', + Functor.map, Except.map] + rw [show TypeChecker.Inner.inferType e true + (TypeChecker.Methods.withFuel context.fuel.recDepth) + { env := context.env, lctx := context.lctx, + safety := context.safety, lparams := context.lparams, + fuel := context.fuel } ({} : TypeChecker.State) = + .ok (.sort level, finalState) by + simpa [AddInductive.Context.toTypeChecker] using hrun] + rfl + +def validationNatOnlyState : TypeChecker.State := + validationInferOnlyInsert ({} : TypeChecker.State) + (.const ``Nat []) (.sort (.succ .zero)) + +theorem indexedVecValidationNatInferOnly : + TypeChecker.Inner.inferType (.const ``Nat []) true + (TypeChecker.Methods.withFuel + indexedVecCtorValidationContext.fuel.recDepth) + indexedVecCtorValidationContext.toTypeChecker + ({} : TypeChecker.State) = + .ok (.sort (.succ .zero), validationNatOnlyState) := by + change TypeChecker.Inner.inferType' (.const ``Nat []) true + (TypeChecker.Methods.withFuel 9999) + (tcContext indexedVecCtorValidationContext.lctx) + ({} : TypeChecker.State) = _ + simpa [validationNatOnlyState] using + (inferTypeNatOnlyCore 9999 indexedVecCtorValidationContext.lctx + ({} : TypeChecker.State) (by simp)) + +theorem indexedVecValidationNatEnsureTypeM : + TypeChecker.M.run indexedVecCtorValidationContext.env + indexedVecCtorValidationContext.safety + indexedVecCtorValidationContext.lctx + indexedVecCtorValidationContext.lparams + indexedVecCtorValidationContext.fuel + (TypeChecker.ensureType (.const ``Nat [])) = + .ok (.sort (.succ .zero)) := by + exact ensureTypeMOfInferOnly indexedVecCtorValidationContext + (.const ``Nat []) (.succ .zero) validationNatOnlyState + indexedVecValidationNatInferOnly + +def validationAlphaOnlyState : TypeChecker.State := + validationInferOnlyInsert ({} : TypeChecker.State) + indexedVecValidationAlpha (.sort (.succ (.param `u))) + +theorem indexedVecValidationAlphaInferOnly : + TypeChecker.Inner.inferType indexedVecValidationAlpha true + (TypeChecker.Methods.withFuel + indexedVecValidationNContext.fuel.recDepth) + indexedVecValidationNContext.toTypeChecker + ({} : TypeChecker.State) = + .ok (.sort (.succ (.param `u)), validationAlphaOnlyState) := by + rw [indexedVecValidationAlphaShape] + change TypeChecker.Inner.inferType' + (.fvar indexedVecValidationAlphaId) true + (TypeChecker.Methods.withFuel 9999) + (tcContext indexedVecValidationNContext.lctx) + ({} : TypeChecker.State) = _ + simpa [validationAlphaOnlyState, + indexedVecValidationAlphaShape] using + (inferTypeFVarOnlyCore 9999 indexedVecValidationNContext.lctx + ({} : TypeChecker.State) indexedVecValidationAlphaId + (.sort (.succ (.param `u))) (by simp) + indexedVecValidationAlphaFindInN) + +theorem indexedVecValidationAlphaEnsureTypeM : + TypeChecker.M.run indexedVecValidationNContext.env + indexedVecValidationNContext.safety + indexedVecValidationNContext.lctx + indexedVecValidationNContext.lparams + indexedVecValidationNContext.fuel + (TypeChecker.ensureType indexedVecValidationAlpha) = + .ok (.sort (.succ (.param `u))) := by + exact ensureTypeMOfInferOnly indexedVecValidationNContext + indexedVecValidationAlpha (.succ (.param `u)) + validationAlphaOnlyState indexedVecValidationAlphaInferOnly + +theorem indexedVecValidationTailInferOnly : + TypeChecker.Inner.inferType + (ctorIndexedVecApp indexedVecValidationAlpha + indexedVecValidationNExpr) true + (TypeChecker.Methods.withFuel + indexedVecValidationHeadContext.fuel.recDepth) + indexedVecValidationHeadContext.toTypeChecker + ({} : TypeChecker.State) = + .ok (.sort (.succ (.param `u)), + validationIndexedVecOnlyState indexedVecValidationAlpha + indexedVecValidationNExpr) := by + change TypeChecker.Inner.inferType' + (ctorIndexedVecApp indexedVecValidationAlpha + indexedVecValidationNExpr) true + (TypeChecker.Methods.withFuel 9999) + (tcContext indexedVecValidationHeadContext.lctx) + ({} : TypeChecker.State) = _ + exact inferTypeIndexedVecOnlyCore 9998 + indexedVecValidationHeadContext.lctx + indexedVecValidationAlpha indexedVecValidationNExpr + (by simp [ctorIndexedVecApp, Expr.hasLooseBVars, + Expr.looseBVarRange']) + +theorem indexedVecValidationTailEnsureTypeM : + TypeChecker.M.run indexedVecValidationHeadContext.env + indexedVecValidationHeadContext.safety + indexedVecValidationHeadContext.lctx + indexedVecValidationHeadContext.lparams + indexedVecValidationHeadContext.fuel + (TypeChecker.ensureType + (ctorIndexedVecApp indexedVecValidationAlpha + indexedVecValidationNExpr)) = + .ok (.sort (.succ (.param `u))) := by + exact ensureTypeMOfInferOnly indexedVecValidationHeadContext + (ctorIndexedVecApp indexedVecValidationAlpha + indexedVecValidationNExpr) (.succ (.param `u)) + (validationIndexedVecOnlyState indexedVecValidationAlpha + indexedVecValidationNExpr) + indexedVecValidationTailInferOnly + +theorem indexedVecValidationStatsParams : + indexedVecCandidateInductiveStats.params = + #[indexedVecValidationAlpha] := by + simpa [indexedVecValidationAlpha] using + indexedVecCandidateInductiveStats_params + +@[simp] theorem validationExprBneSelf (e : Expr) : + (e != e) = false := by + change (!Expr.eqv e e) = false + rw [show Expr.eqv e e = true by exact Expr.eqv_refl e] + rfl + +theorem indexedVecValidationAppIsValidIdx (index : Expr) + (hindex : AddInductive.hasIndOcc + indexedVecCandidateInductiveStats.indConsts index = false) : + AddInductive.isValidIndAppIdx indexedVecCandidateInductiveStats + (ctorIndexedVecApp indexedVecValidationAlpha index) 0 = true := by + have hparam : + (indexedVecValidationAlpha != indexedVecValidationAlpha) = false := by + change (!Expr.eqv indexedVecValidationAlpha + indexedVecValidationAlpha) = false + rw [show Expr.eqv indexedVecValidationAlpha + indexedVecValidationAlpha = true by + exact Expr.eqv_refl indexedVecValidationAlpha] + rfl + have hindex' : AddInductive.hasIndOcc + #[.const ``IndexedVec [.param `u]] index = false := by + simpa [indexedVecCandidateInductiveStats_indConsts] using hindex + simp +decide [AddInductive.isValidIndAppIdx, + indexedVecCandidateInductiveStats_nindices, + indexedVecValidationStatsParams, + indexedVecCandidateInductiveStats_indConsts, + ctorIndexedVecAppGetAppFn, ctorIndexedVecAppGetAppArgs, + hindex'] + +theorem indexedVecValidationAppIsValid (index : Expr) + (hindex : AddInductive.hasIndOcc + indexedVecCandidateInductiveStats.indConsts index = false) : + AddInductive.isValidIndApp? indexedVecCandidateInductiveStats + (ctorIndexedVecApp indexedVecValidationAlpha index) = some 0 := by + exact AddInductive.isValidIndApp?_singleton_zero + indexedVecCandidateInductiveStats + (ctorIndexedVecApp indexedVecValidationAlpha index) + (by simp [indexedVecCandidateInductiveStats_indConsts]) + (indexedVecValidationAppIsValidIdx index hindex) + +theorem indexedVecValidationZeroHasNoIndOcc : + AddInductive.hasIndOcc indexedVecCandidateInductiveStats.indConsts + (.const ``Nat.zero []) = false := by + simp [AddInductive.hasIndOcc, + indexedVecCandidateInductiveStats_indConsts, Expr.constName!] + +theorem indexedVecValidationNHasNoIndOcc : + AddInductive.hasIndOcc indexedVecCandidateInductiveStats.indConsts + indexedVecValidationNExpr = false := by + simp [AddInductive.hasIndOcc, + indexedVecCandidateInductiveStats_indConsts, + indexedVecValidationNExprShape] + +theorem indexedVecValidationSuccNHasNoIndOcc : + AddInductive.hasIndOcc indexedVecCandidateInductiveStats.indConsts + (replaySuccApp indexedVecValidationNExpr) = false := by + simp [AddInductive.hasIndOcc, + indexedVecCandidateInductiveStats_indConsts, + replaySuccApp, Expr.constName!] + +theorem indexedVecValidationNilResultIsValid : + AddInductive.isValidIndAppIdx indexedVecCandidateInductiveStats + indexedVecValidationNilResult 0 = true := by + exact indexedVecValidationAppIsValidIdx (.const ``Nat.zero []) + indexedVecValidationZeroHasNoIndOcc + +theorem indexedVecValidationConsResultIsValid : + AddInductive.isValidIndAppIdx indexedVecCandidateInductiveStats + indexedVecValidationConsResult 0 = true := by + exact indexedVecValidationAppIsValidIdx + (replaySuccApp indexedVecValidationNExpr) + indexedVecValidationSuccNHasNoIndOcc + +theorem indexedVecValidationNatHasNoIndOcc : + AddInductive.hasIndOcc indexedVecCandidateInductiveStats.indConsts + (.const ``Nat []) = false := by + simp [AddInductive.hasIndOcc, + indexedVecCandidateInductiveStats_indConsts, Expr.constName!] + +theorem indexedVecValidationAlphaHasNoIndOcc : + AddInductive.hasIndOcc indexedVecCandidateInductiveStats.indConsts + indexedVecValidationAlpha = false := by + simp [AddInductive.hasIndOcc, + indexedVecCandidateInductiveStats_indConsts, + indexedVecValidationAlphaShape] + +theorem indexedVecValidationTailHasIndOcc : + AddInductive.hasIndOcc indexedVecCandidateInductiveStats.indConsts + (ctorIndexedVecApp indexedVecValidationAlpha + indexedVecValidationNExpr) = true := by + simp [AddInductive.hasIndOcc, + indexedVecCandidateInductiveStats_indConsts, + ctorIndexedVecApp, Expr.constName!] + +theorem indexedVecValidationNatPositivity : + AddInductive.checkPositivity indexedVecCandidateInductiveStats + (.const ``Nat []) indexedVecKernelCons.name 1 + indexedVecCtorValidationContext = .ok () := by + unfold AddInductive.checkPositivity + simp only [readThe, MonadReaderOf.read, ReaderT.read, + ReaderT.bind, Bind.bind, Pure.pure, + Except.bind, Except.pure] + rw [show indexedVecCtorValidationContext.fuel.inductiveFuel = + 999 + 1 by rfl] + unfold AddInductive.checkPositivity.loop + simp only [ReaderT.bind, Bind.bind] + rw [AddInductive.liftTypeChecker_apply] + rw [show TypeChecker.M.run indexedVecCtorValidationContext.env + indexedVecCtorValidationContext.safety + indexedVecCtorValidationContext.lctx + indexedVecCtorValidationContext.lparams + indexedVecCtorValidationContext.fuel + (TypeChecker.whnf (.const ``Nat [])) = + .ok (.const ``Nat []) by + change TypeChecker.M.run ctorEnv .safe + indexedVecCtorValidationContext.lctx [`u] ({} : FuelConfig) + (TypeChecker.whnf (.const ``Nat [])) = .ok (.const ``Nat []) + exact ctorNatWhnfM indexedVecCtorValidationContext.lctx] + simp only [Except.bind] + rw [indexedVecValidationNatHasNoIndOcc] + simp only [Bool.not_false, if_true, + ReaderT.pure, Pure.pure, Except.pure] + +theorem indexedVecValidationAlphaPositivity : + AddInductive.checkPositivity indexedVecCandidateInductiveStats + indexedVecValidationAlpha indexedVecKernelCons.name 2 + indexedVecValidationNContext = .ok () := by + unfold AddInductive.checkPositivity + simp only [readThe, MonadReaderOf.read, ReaderT.read, + ReaderT.bind, Bind.bind, Pure.pure, + Except.bind, Except.pure] + rw [show indexedVecValidationNContext.fuel.inductiveFuel = + 999 + 1 by rfl] + unfold AddInductive.checkPositivity.loop + simp only [ReaderT.bind, Bind.bind] + rw [AddInductive.liftTypeChecker_apply] + rw [show TypeChecker.M.run indexedVecValidationNContext.env + indexedVecValidationNContext.safety + indexedVecValidationNContext.lctx + indexedVecValidationNContext.lparams + indexedVecValidationNContext.fuel + (TypeChecker.whnf indexedVecValidationAlpha) = + .ok indexedVecValidationAlpha by + rw [indexedVecValidationAlphaShape] + change TypeChecker.M.run ctorEnv .safe + indexedVecValidationNContext.lctx [`u] ({} : FuelConfig) + (TypeChecker.whnf (.fvar indexedVecValidationAlphaId)) = + .ok (.fvar indexedVecValidationAlphaId) + exact ctorFVarWhnfM indexedVecValidationNContext.lctx + indexedVecValidationAlphaId indexedVecValidationAlphaFindInN] + simp only [Except.bind] + rw [indexedVecValidationAlphaHasNoIndOcc] + simp only [Bool.not_false, if_true, + ReaderT.pure, Pure.pure, Except.pure] + +theorem indexedVecValidationTailPositivity : + AddInductive.checkPositivity indexedVecCandidateInductiveStats + (ctorIndexedVecApp indexedVecValidationAlpha + indexedVecValidationNExpr) + indexedVecKernelCons.name 3 indexedVecValidationHeadContext = + .ok () := by + unfold AddInductive.checkPositivity + simp only [readThe, MonadReaderOf.read, ReaderT.read, + ReaderT.bind, Bind.bind, Pure.pure, + Except.bind, Except.pure] + rw [show indexedVecValidationHeadContext.fuel.inductiveFuel = + 999 + 1 by rfl] + unfold AddInductive.checkPositivity.loop + simp only [ReaderT.bind, Bind.bind] + rw [AddInductive.liftTypeChecker_apply] + rw [show TypeChecker.M.run indexedVecValidationHeadContext.env + indexedVecValidationHeadContext.safety + indexedVecValidationHeadContext.lctx + indexedVecValidationHeadContext.lparams + indexedVecValidationHeadContext.fuel + (TypeChecker.whnf + (ctorIndexedVecApp indexedVecValidationAlpha + indexedVecValidationNExpr)) = + .ok (ctorIndexedVecApp indexedVecValidationAlpha + indexedVecValidationNExpr) by + change TypeChecker.M.run ctorEnv .safe + indexedVecValidationHeadContext.lctx [`u] ({} : FuelConfig) + (TypeChecker.whnf + (ctorIndexedVecApp indexedVecValidationAlpha + indexedVecValidationNExpr)) = + .ok (ctorIndexedVecApp indexedVecValidationAlpha + indexedVecValidationNExpr) + exact ctorIndexedVecWhnfM indexedVecValidationHeadContext.lctx + indexedVecValidationAlpha indexedVecValidationNExpr] + simp only [Except.bind] + rw [indexedVecValidationTailHasIndOcc] + simp only [Bool.not_true, Bool.false_eq_true, if_false, + ReaderT.pure, Pure.pure, ReaderT.bind, Bind.bind, + Except.bind, Except.pure] + rw [indexedVecValidationAppIsValid indexedVecValidationNExpr + indexedVecValidationNHasNoIndOcc] + rfl + +theorem indexedVecValidationNilLoopTerminal : + AddInductive.checkConstructors.loop + indexedVecCandidateInductiveStats false 0 + indexedVecKernelNil.name indexedVecValidationNilResult 1 999 + indexedVecCtorValidationContext = .ok () := by + rw [show 999 = 998 + 1 by rfl] + have hvalid : AddInductive.isValidIndAppIdx + indexedVecCandidateInductiveStats + ((.const ``IndexedVec [.param `u] : Expr).app + (.fvar indexedVecValidationAlphaId) |>.app + (.const ``Nat.zero [])) 0 = + true := by + simpa [indexedVecValidationNilResult, ctorIndexedVecApp, + indexedVecValidationAlphaShape] using + indexedVecValidationNilResultIsValid + unfold indexedVecValidationNilResult ctorIndexedVecApp + unfold AddInductive.checkConstructors.loop + simp [hvalid, + ReaderT.pure, Pure.pure, Except.pure] + +theorem indexedVecValidationNilLoop : + AddInductive.checkConstructors.loop + indexedVecCandidateInductiveStats false 0 + indexedVecKernelNil.name indexedVecKernelNil.type 0 + indexedVecCtorValidationContext.fuel.inductiveFuel + indexedVecCtorValidationContext = .ok () := by + rw [show indexedVecCtorValidationContext.fuel.inductiveFuel = + 999 + 1 by rfl] + unfold AddInductive.checkConstructors.loop + simp only [indexedVecKernelNil, indexedVecNilInfo, + ConstantInfo.name, ConstantInfo.type, ConstantInfo.toConstantVal] + rw [show indexedVecCandidateInductiveStats.params[0]? = + some indexedVecValidationAlpha by + simp [indexedVecValidationStatsParams]] + simp only [ReaderT.bind, Bind.bind] + rw [indexedVecValidationGetTypeAlpha] + simp only [Except.bind] + rw [AddInductive.liftTypeChecker_apply] + rw [indexedVecValidationParamIsDefEq] + simp only [if_true, + ReaderT.bind, Bind.bind, ReaderT.pure, Pure.pure, + Except.bind, Except.pure] + simpa [indexedVecValidationNilResult, ctorIndexedVecApp, + indexedVecKernelNil, indexedVecNilInfo, ConstantInfo.name, + ConstantInfo.toConstantVal, + Expr.instantiate1_eq, Expr.instantiate1', + Expr.liftLooseBVars_zero] using indexedVecValidationNilLoopTerminal + +@[simp] theorem indexedVecValidationConsumeNat : + AddInductive.consumeTypeAnnotations (.const ``Nat []) = + .const ``Nat [] := by + simp [AddInductive.consumeTypeAnnotations] + +@[simp] theorem indexedVecValidationConsumeAlpha : + AddInductive.consumeTypeAnnotations indexedVecValidationAlpha = + indexedVecValidationAlpha := by + rw [indexedVecValidationAlphaShape] + simp [AddInductive.consumeTypeAnnotations] + +@[simp] theorem indexedVecValidationConsumeTail : + AddInductive.consumeTypeAnnotations + (ctorIndexedVecApp indexedVecValidationAlpha + indexedVecValidationNExpr) = + ctorIndexedVecApp indexedVecValidationAlpha + indexedVecValidationNExpr := by + simp [ctorIndexedVecApp, AddInductive.consumeTypeAnnotations] + +theorem indexedVecValidationConsLoopTerminal : + AddInductive.checkConstructors.loop + indexedVecCandidateInductiveStats false 0 + indexedVecKernelCons.name indexedVecValidationConsResult 4 996 + indexedVecValidationTailContext = .ok () := by + rw [show 996 = 995 + 1 by rfl] + have hvalid : AddInductive.isValidIndAppIdx + indexedVecCandidateInductiveStats + (((.const ``IndexedVec [.param `u] : Expr).app + (.fvar indexedVecValidationAlphaId)).app + ((.const ``Nat.succ [] : Expr).app + (.fvar indexedVecValidationNId))) 0 = true := by + simpa [indexedVecValidationConsResult, ctorIndexedVecApp, + replaySuccApp, indexedVecValidationAlphaShape, + indexedVecValidationNExprShape] using + indexedVecValidationConsResultIsValid + unfold indexedVecValidationConsResult ctorIndexedVecApp replaySuccApp + unfold AddInductive.checkConstructors.loop + simp [hvalid, ReaderT.pure, Pure.pure, Except.pure] + +theorem indexedVecValidationConsLoopTail : + AddInductive.checkConstructors.loop + indexedVecCandidateInductiveStats false 0 + indexedVecKernelCons.name indexedVecValidationConsAfterHead 3 997 + indexedVecValidationHeadContext = .ok () := by + rw [show 997 = 996 + 1 by rfl] + unfold indexedVecValidationConsAfterHead + unfold AddInductive.checkConstructors.loop + simp only + rw [show indexedVecCandidateInductiveStats.params[3]? = none by + simp [indexedVecValidationStatsParams]] + simp only [ReaderT.bind, Bind.bind] + rw [AddInductive.liftTypeChecker_apply] + rw [indexedVecValidationTailEnsureTypeM] + simp only [Except.bind, Expr.sortLevel!] + rw [show AddInductive.levelStructGe + indexedVecCandidateInductiveStats.resultLevel + (.succ (.param `u)) = true by + simp [indexedVecCandidateInductiveStats_resultLevel, + AddInductive.levelStructGe, AddInductive.levelStructEq]] + simp only [if_true, Bool.not_false, + ReaderT.bind, Bind.bind, ReaderT.pure, Pure.pure, + Except.bind, Except.pure] + rw [indexedVecValidationTailPositivity] + rw [AddInductive.withLocalDecl_apply] + rw [indexedVecValidationConsumeTail] + rw [show (ctorIndexedVecApp indexedVecValidationAlpha + (replaySuccApp indexedVecValidationNExpr)).instantiate1 + indexedVecValidationHeadContext.freshExpr = + indexedVecValidationConsResult by + simp [indexedVecValidationConsResult, ctorIndexedVecApp, + replaySuccApp, Expr.instantiate1_eq, Expr.instantiate1']] + simpa [indexedVecValidationTailContext, + AddInductive.Context.pushLocalDecl, + ReaderT.pure, Pure.pure, Except.pure] using + indexedVecValidationConsLoopTerminal + +theorem indexedVecValidationConsLoopHead : + AddInductive.checkConstructors.loop + indexedVecCandidateInductiveStats false 0 + indexedVecKernelCons.name indexedVecValidationConsAfterN 2 998 + indexedVecValidationNContext = .ok () := by + rw [show 998 = 997 + 1 by rfl] + unfold indexedVecValidationConsAfterN + unfold AddInductive.checkConstructors.loop + simp only + rw [show indexedVecCandidateInductiveStats.params[2]? = none by + simp [indexedVecValidationStatsParams]] + simp only [ReaderT.bind, Bind.bind] + rw [AddInductive.liftTypeChecker_apply] + rw [indexedVecValidationAlphaEnsureTypeM] + simp only [Except.bind, Expr.sortLevel!] + rw [show AddInductive.levelStructGe + indexedVecCandidateInductiveStats.resultLevel + (.succ (.param `u)) = true by + simp [indexedVecCandidateInductiveStats_resultLevel, + AddInductive.levelStructGe, AddInductive.levelStructEq]] + simp only [if_true, Bool.not_false, + ReaderT.bind, Bind.bind, ReaderT.pure, Pure.pure, + Except.bind, Except.pure] + rw [indexedVecValidationAlphaPositivity] + rw [AddInductive.withLocalDecl_apply] + rw [indexedVecValidationConsumeAlpha] + rw [show + ((.forallE consTailName + (ctorIndexedVecApp indexedVecValidationAlpha + indexedVecValidationNExpr) + (ctorIndexedVecApp indexedVecValidationAlpha + (replaySuccApp indexedVecValidationNExpr)) + .default : Expr).instantiate1 + indexedVecValidationNContext.freshExpr) = + indexedVecValidationConsAfterHead by + simp [indexedVecValidationConsAfterHead, + ctorIndexedVecApp, replaySuccApp, + Expr.instantiate1_eq, Expr.instantiate1']] + simpa [indexedVecValidationHeadContext, + AddInductive.Context.pushLocalDecl, + ReaderT.pure, Pure.pure, Except.pure] using + indexedVecValidationConsLoopTail + +theorem indexedVecValidationConsLoopN : + AddInductive.checkConstructors.loop + indexedVecCandidateInductiveStats false 0 + indexedVecKernelCons.name indexedVecValidationConsAfterParam 1 999 + indexedVecCtorValidationContext = .ok () := by + rw [show 999 = 998 + 1 by rfl] + rw [indexedVecValidationConsAfterParamExplicitShape] + unfold AddInductive.checkConstructors.loop + simp only + rw [show indexedVecCandidateInductiveStats.params[1]? = none by + simp [indexedVecValidationStatsParams]] + simp only [ReaderT.bind, Bind.bind] + rw [AddInductive.liftTypeChecker_apply] + rw [indexedVecValidationNatEnsureTypeM] + simp only [Except.bind, Expr.sortLevel!] + rw [show AddInductive.levelStructGe + indexedVecCandidateInductiveStats.resultLevel (.succ .zero) = + true by + simp [indexedVecCandidateInductiveStats_resultLevel, + AddInductive.levelStructGe]] + simp only [if_true, Bool.not_false, + ReaderT.bind, Bind.bind, ReaderT.pure, Pure.pure, + Except.bind, Except.pure] + rw [indexedVecValidationNatPositivity] + rw [AddInductive.withLocalDecl_apply] + rw [indexedVecValidationConsumeNat] + rw [show + ((.forallE consHeadName indexedVecValidationAlpha + (.forallE consTailName + (ctorIndexedVecApp indexedVecValidationAlpha (.bvar 1)) + (ctorIndexedVecApp indexedVecValidationAlpha + (replaySuccApp (.bvar 2))) + .default) + .default : Expr).instantiate1 + indexedVecCtorValidationContext.freshExpr) = + indexedVecValidationConsAfterN by + simp [indexedVecValidationConsAfterN, + ctorIndexedVecApp, replaySuccApp, + indexedVecValidationNExpr, + AddInductive.Context.freshExpr, + Expr.instantiate1_eq, Expr.instantiate1']] + simpa [indexedVecValidationNContext, + AddInductive.Context.pushLocalDecl, + ReaderT.pure, Pure.pure, Except.pure] using + indexedVecValidationConsLoopHead + +theorem indexedVecValidationConsLoop : + AddInductive.checkConstructors.loop + indexedVecCandidateInductiveStats false 0 + indexedVecKernelCons.name indexedVecKernelCons.type 0 + indexedVecCtorValidationContext.fuel.inductiveFuel + indexedVecCtorValidationContext = .ok () := by + rw [show indexedVecCtorValidationContext.fuel.inductiveFuel = + 999 + 1 by rfl] + rw [show indexedVecKernelCons.type = consCtorTypeRaw by + simpa [indexedVecKernelCons] using consInfoTypeShape] + unfold consCtorTypeRaw + unfold AddInductive.checkConstructors.loop + simp only + rw [show indexedVecCandidateInductiveStats.params[0]? = + some indexedVecValidationAlpha by + simp [indexedVecValidationStatsParams]] + simp only [ReaderT.bind, Bind.bind] + rw [indexedVecValidationGetTypeAlpha] + simp only [Except.bind] + rw [AddInductive.liftTypeChecker_apply] + rw [indexedVecValidationParamIsDefEq] + simp only [if_true, + ReaderT.bind, Bind.bind, ReaderT.pure, Pure.pure, + Except.bind, Except.pure] + simpa [indexedVecValidationConsAfterParam] using + indexedVecValidationConsLoopN + +theorem indexedVecValidationGetEnvM : + TypeChecker.M.run indexedVecCtorValidationContext.env + indexedVecCtorValidationContext.safety + indexedVecCtorValidationContext.lctx + indexedVecCtorValidationContext.lparams + indexedVecCtorValidationContext.fuel TypeChecker.getEnv = + .ok ctorEnv := by + rfl + +theorem indexedVecValidationEmptyDoesNotContainNil : + (∅ : NameSet).contains indexedVecKernelNil.name = false := by + simp +decide + +theorem indexedVecValidationNilSetDoesNotContainCons : + ((∅ : NameSet).insert indexedVecKernelNil.name).contains + indexedVecKernelCons.name = false := by + simp +decide [indexedVecKernelNil, indexedVecKernelCons, + indexedVecNilInfo, indexedVecConsInfo, + ConstantInfo.name, NameSet.contains, NameSet.insert, + Std.TreeSet.contains_insert] + +set_option linter.unusedSimpArgs false in +theorem indexedVecValidationCheckConstructors : + AddInductive.checkConstructors #[indexedVecKernelType] + indexedVecCandidateInductiveStats false + indexedVecCtorValidationContext = .ok () := by + unfold AddInductive.checkConstructors + simp only [ReaderT.bind, Bind.bind] + rw [AddInductive.liftTypeChecker_apply] + rw [indexedVecValidationGetEnvM] + simp only [Except.bind] + simp only [indexedVecKernelType, + Std.Legacy.Range.forIn'_eq_forIn'_range', Std.Legacy.Range.size, + List.range', List.forIn'_cons, List.forIn'_nil, + List.forIn_cons, List.forIn_nil, + List.size_toArray, List.length_cons, List.length_nil, + List.getElem_toArray, List.getElem_cons_zero, + Nat.sub_zero, Nat.zero_add, Nat.add_sub_cancel, Nat.div_one] + rw [indexedVecValidationEmptyDoesNotContainNil] + simp only [Bool.false_eq_true, if_false, + ReaderT.bind, Bind.bind, ReaderT.pure, Pure.pure, + Except.bind, Except.pure] + rw [indexedVecNilNoMVarNoFVar] + simp only [ReaderT.bind, Bind.bind, ReaderT.pure, Pure.pure, + Except.bind, Except.pure, AddInductive.liftExcept_apply] + rw [AddInductive.withEmptyLocalContext_apply] + rw [AddInductive.liftTypeChecker_apply] + rw [indexedVecValidationNilRootCheckTypeM] + simp only [Except.bind, readThe, MonadReaderOf.read, ReaderT.read, + ReaderT.pure, Pure.pure, Except.pure] + rw [indexedVecValidationNilLoop] + simp only [Except.bind, ReaderT.pure, Pure.pure, Except.pure] + rw [indexedVecValidationNilSetDoesNotContainCons] + simp only [Bool.false_eq_true, if_false, + ReaderT.bind, Bind.bind, ReaderT.pure, Pure.pure, + Except.bind, Except.pure] + rw [indexedVecConsNoMVarNoFVar] + simp only [ReaderT.bind, Bind.bind, ReaderT.pure, Pure.pure, + Except.bind, Except.pure, AddInductive.liftExcept_apply] + rw [AddInductive.withEmptyLocalContext_apply] + rw [AddInductive.liftTypeChecker_apply] + rw [indexedVecValidationConsRootCheckTypeM] + simp only [Except.bind, readThe, MonadReaderOf.read, ReaderT.read, + ReaderT.pure, Pure.pure, Except.pure] + rw [indexedVecValidationConsLoop] + rfl + +/-- The complete one-parameter, one-index IndexedVec request produces the +exact ordered family/nil/cons normalization candidate. -/ +theorem indexedVecNormalizationCandidateProduced : + AddInductive.buildNormalizationCandidate 1 + [indexedVecKernelType] 0 false + indexedVecFamilyCandidateContext = + .ok indexedVecNormalizationCandidate := by + unfold AddInductive.buildNormalizationCandidate + rw [indexedVec_checkInductiveTypes] + simp only [ReaderT.bind, Bind.bind] + rw [show + (withReader (fun _ : AddInductive.Context => + { indexedVecFamilyCandidateContext with lctx := {} }) + (AddInductive.normalizeCandidateFamilyTypeList + [indexedVecKernelType])) indexedVecFamilyCandidate.trace.terminalContext = + .ok (.cons indexedVecFamilyListCandidate.familyType .nil) by + simpa using indexedVecFamilyTypeListCandidateProduced] + simp only [Except.bind] + rw [indexedVecDeclareFromTerminal] + unfold AddInductive.withEnv + change (ReaderT.bind + (AddInductive.checkConstructors #[indexedVecKernelType] + indexedVecCandidateInductiveStats false) + (fun _ => ReaderT.bind + (fun _ : AddInductive.Context => + AddInductive.normalizeCandidateFamilyList + (.cons indexedVecFamilyListCandidate.familyType .nil) + ctorContext) + (fun families => pure + (⟨families⟩ : AddInductive.NormalizationCandidate + [indexedVecKernelType])))) + indexedVecCtorValidationContext = _ + simp only [ReaderT.bind, Bind.bind] + rw [indexedVecValidationCheckConstructors] + simp only [Except.bind] + rw [indexedVecFamilyListCandidateProduced] + rfl + +/-- +info: 'Lean4Lean.InductiveReplayFixtures.indexedVecNormalizationCandidateProduced' depends on axioms: [propext, + sorryAx, + Classical.choice, + Quot.sound, + Expr.eqv_eq, + Expr.instantiate1_eq, + Expr.instantiateRevRange_eq, + Expr.instantiateRev_eq, + Expr.instantiate_eq, + Expr.looseBVarRange_eq, + Expr.mkAppData_eq, + Expr.mkData_eq, + Expr.replace_eq, + Level.hasMVar_eq, + Level.hasParam_eq, + Level.instLawfulBEqLevel, + PersistentArray.toList'_push, + PersistentHashMap.findAux_isSome, + Syntax.structEq_eq, + PersistentHashMap.WF.find?_eq, + PersistentHashMap.WF.toList'_insert] +-/ +#guard_msgs in +#print axioms indexedVecNormalizationCandidateProduced + +end Lean4Lean.InductiveReplayFixtures diff --git a/Lean4Lean/Verify/Environment/IndexedVecSemanticReplay.lean b/Lean4Lean/Verify/Environment/IndexedVecSemanticReplay.lean new file mode 100644 index 00000000..cc54fa9e --- /dev/null +++ b/Lean4Lean/Verify/Environment/IndexedVecSemanticReplay.lean @@ -0,0 +1,864 @@ +import Lean4Lean.Verify.Environment.IndexedVecOuterReplay + +/-! +# Complete semantic replay of the IndexedVec normalization candidate + +This module connects the exact executable family/`nil`/`cons` candidate +produced by `buildNormalizationCandidate` to its Theory generation +certificate and the E1 kernel-environment replay. Every retained candidate +node is interpreted in its exact pre-family or post-family verifier context; +the final transaction therefore consumes the certificate projected from the +same producer-selected package rather than an independently supplied +well-formedness proof. +-/ + +namespace Lean4Lean.InductiveReplayFixtures +open Lean Meta +open Lean4Lean.InductiveFixtures +open IndexedVecConsReplay + +theorem indexedVecSemanticNatHasPrimitives : VEnv.HasPrimitives natFinalEnv := by + have absent (n : Name) (hlookup : natFinalEnv.constants n = none) : + ¬ natFinalEnv.contains n := by + rintro ⟨ci, hci⟩ + rw [hlookup] at hci + contradiction + refine { + bool := fun h => (absent ``Bool rfl h).elim + boolFalse := fun h => by + change none = some _ at h + contradiction + boolTrue := fun h => by + change none = some _ at h + contradiction + nat := fun _ => ⟨⟨_, rfl⟩, ⟨_, rfl⟩⟩ + natZero := fun h => by + change some natType.ctors[0].toVConstant = some _ at h + exact (Option.some.inj h).symm + natSucc := fun h => by + change some natType.ctors[1].toVConstant = some _ at h + exact (Option.some.inj h).symm + natAdd := fun h => (absent ``Nat.add rfl h).elim + natSub := fun h => (absent ``Nat.sub rfl h).elim + natMul := fun h => (absent ``Nat.mul rfl h).elim + natPow := fun h => (absent ``Nat.pow rfl h).elim + natGcd := fun h => (absent ``Nat.gcd rfl h).elim + natMod := fun h => (absent ``Nat.mod rfl h).elim + natDiv := fun h => (absent ``Nat.div rfl h).elim + natBEq := fun h => (absent ``Nat.beq rfl h).elim + natBLE := fun h => (absent ``Nat.ble rfl h).elim + natLAnd := fun h => (absent ``Nat.land rfl h).elim + natLOr := fun h => (absent ``Nat.lor rfl h).elim + natXor := fun h => (absent ``Nat.xor rfl h).elim + natShiftLeft := fun h => (absent ``Nat.shiftLeft rfl h).elim + natShiftRight := fun h => (absent ``Nat.shiftRight rfl h).elim + charOfNat := fun h => by + change none = some _ at h + contradiction + stringOfList := fun h => by + change none = some _ at h + contradiction } + +theorem indexedVecSemanticNatSafePrimitives : + indexedVecKernelEnv.find? n = some ci → + Kernel.Environment.primitives.contains n → + ci.safety = .safe ∧ ci.levelParams = [] := by + intro hfind hprim + change natMap.find?' n = some ci at hfind + rw [natMap_wf.find?'_eq_find?, natMap, + natCtorMap_wf.find?_insert] at hfind + split at hfind + · rename_i heq + simp at heq + subst n + simp at hfind + subst ci + simp [Kernel.Environment.primitives, NameSet.ofList] at hprim + simp +decide [NameSet.contains] at hprim + · rw [natCtorMap, natZeroMap_wf.find?_insert] at hfind + split at hfind + · rename_i heq + simp at heq + subst n + simp at hfind + subst ci + exact ⟨rfl, rfl⟩ + · rw [natZeroMap, natTypeMap_wf.find?_insert] at hfind + split at hfind + · rename_i heq + simp at heq + subst n + simp at hfind + subst ci + exact ⟨rfl, rfl⟩ + · rw [natTypeMap, + SMap.WF.find?_insert (s := ({} : ConstMap)) SMap.WF.empty] + at hfind + split at hfind + · rename_i heq + simp at heq + subst n + simp at hfind + subst ci + exact ⟨rfl, rfl⟩ + · simp [SMap.find?] at hfind + +def indexedVecSemanticNatVEnvs : VEnvs where + venv _ := natFinalEnv + +theorem indexedVecSemanticNatVEnvsWF : indexedVecSemanticNatVEnvs.WF indexedVecKernelEnv where + tr := by + intro safety + change TrEnv' _ natMap false natFinalEnv + exact nat_trEnv'.sf_mono DefinitionSafety.le_safe + hasPrimitives := indexedVecSemanticNatHasPrimitives + safePrimitives := indexedVecSemanticNatSafePrimitives + mono := fun _ => .rfl + +def indexedVecSemanticAddType : + AddInductConstant .induct natMap natFinalEnv + indexedVecType.toVConstVal indexedVecTypeMap indexedVecTypeEnv where + info := indexedVecInfo + kind_eq := by simp [indexedVecInfo, InductConstantKind.Matches] + tr := indexedVecInfo_tr + map_fresh := by simpa [indexedVecType] using indexedVecType_fresh + env_add := rfl + map_add := rfl + +theorem indexedVecSemanticFamilyPrefixNe : + indexedVecFamilyCandidateContext.ngen.namePrefix ≠ + (({} : TypeChecker.VState).ngen).namePrefix := by + decide + +def indexedVecSemanticFamilyContextRun : + TypeChecker.CandidateContextRun indexedVecFamilyCandidateContext := + TypeChecker.CandidateContextRun.root indexedVecSemanticNatVEnvsWF rfl + indexedVecSemanticFamilyPrefixNe + +theorem indexedVecSemanticFamilySourceTr : + TrExprS natFinalEnv [`u] [] indexedVecInfo.type indexedVecType.type := + indexedVecInfo_tr.1.2.2 + +def indexedVecPreFamilyStage : + TypeChecker.CandidateSemanticStage indexedVecFamilyCandidateContext + natFinalEnv [`u] where + contextRun := indexedVecSemanticFamilyContextRun + venv_eq := rfl + lparams_eq := rfl + vlctx_eq := rfl + +def indexedVecFamilyValidationRun : + AddInductive.CandidateExprTrace.FamilyValidationRun + indexedVecKernelType indexedVecFamilyCandidate.trace where + nparams := 1 + resultLevel := .succ (.param `u) + stats := indexedVecCandidateInductiveStats + stats_eq := rfl + terminal_eq := indexedVecFamilyCandidate_terminalResult + run := indexedVec_checkInductiveTypes + +def indexedVecFamilyStage : + VInductDecl.CandidateFamilyStagedInput + indexedVecFamilyCandidateContext ctorContext natFinalEnv [`u] + indexedVecFamilyListCandidate.familyType indexedVecType + indexedVecPreFamilyStage where + name_eq := rfl + uvars_eq := rfl + type := { + context_eq := rfl + source_tr := indexedVecSemanticFamilySourceTr + whnfFuel := 9999 + whnfDepth := rfl } + validation := indexedVecFamilyValidationRun + typeEnv := indexedVecTypeEnv + addInduct := indexedVecSemanticAddType + family_lctx_eq := rfl + constructorContext_eq := rfl + quotInit_eq := rfl + name_not_reflected := by decide + name_not_primitive := by + simp [indexedVecType, Kernel.Environment.primitives, + NameSet.ofList] + simp +decide [NameSet.contains] + +def indexedVecSemanticCtorContextRun : + TypeChecker.CandidateContextRun ctorContext := + indexedVecFamilyStage.postContextRun + +theorem indexedVecSemanticNilSourceTr : + TrExprS indexedVecTypeEnv [`u] [] indexedVecNilInfo.type + indexedVecType.ctors[0].type := + indexedVecNilInfo_tr.1.2.2 + +theorem indexedVecSemanticConsIsType : + indexedVecTypeEnv.IsType 1 [] indexedVecType.ctors[1].type := by + have hwf := + (indexedVecChecked.wf_of_decl indexedVecDecl_wf).identityGeneration + nat_env_wf.ordered + have hctor := hwf.rawCtor_isType (envT := indexedVecTypeEnv) rfl + (ctor := indexedVecChecked.identityGeneration.block.ctorPairs[1]) + (by simp) + simpa only [ + show indexedVecDecl.uvars = 1 by rfl, + show indexedVecChecked.identityGeneration.block.ctorPairs[1].raw.type = + indexedVecType.ctors[1].type by rfl] using hctor + +theorem indexedVecSemanticConsSourceTr : + TrExprS indexedVecTypeEnv [`u] [] indexedVecConsInfo.type + indexedVecType.ctors[1].type := by + have hshape : TrTypeExpr indexedVecTypeEnv [`u] [] + indexedVecConsInfo.type indexedVecType.ctors[1].type := by + tr_type_expr_tac + obtain ⟨u, htype⟩ := indexedVecSemanticConsIsType + exact hshape.to_trExprS indexedVecTypeEnv_ordered trivial + ⟨.sort u, htype⟩ + +def indexedVecStagedSemanticInput : + VInductDecl.StagedNormalizationCandidateSemanticInput + indexedVecFamilyCandidateContext ctorContext natFinalEnv [`u] + indexedVecNormalizationCandidate indexedVecDecl where + raw := indexedVecType + raw_types_eq := rfl + declaration_uvars_eq := rfl + preFamily := indexedVecPreFamilyStage + family := indexedVecFamilyStage + constructors := .cons { + name_eq := rfl + uvars_eq := rfl + type := { + context_eq := rfl + source_tr := indexedVecSemanticNilSourceTr + whnfFuel := 9999 + whnfDepth := rfl } } (.cons { + name_eq := rfl + uvars_eq := rfl + type := { + context_eq := rfl + source_tr := indexedVecSemanticConsSourceTr + whnfFuel := 9999 + whnfDepth := rfl } } .nil) + familyTypesProduced := indexedVecFamilyTypeListProduced + familiesProduced := indexedVecFamilyListProduced + +/-- Generic automatic assembly joins the arbitrary-length operational list +witnesses to the complete retained semantic hierarchy for the two-constructor +fixture. No expected normalized view is an input to this theorem. -/ +theorem indexedVecProducedSemanticHierarchy_exists : + Nonempty (VInductDecl.ProducedNormalizationCandidateSemanticRun + indexedVecFamilyCandidateContext ctorContext natFinalEnv [`u] + indexedVecNormalizationCandidate indexedVecDecl) := + indexedVecStagedSemanticInput.exists + +/-- The automatically assembled hierarchy retains both constructor headers in +the producer's `nil`/`cons` source order. This inspects the semantic result, +not the separately constructed concrete replay below. -/ +theorem indexedVecProducedSemanticHierarchy_constructorHeaders : + ∃ run : VInductDecl.ProducedNormalizationCandidateSemanticRun + indexedVecFamilyCandidateContext ctorContext natFinalEnv [`u] + indexedVecNormalizationCandidate indexedVecDecl, + VInductDecl.sameCtorHeaders indexedVecType.ctors + run.semantic.family.root.constructors.views = true := by + obtain ⟨run⟩ := indexedVecProducedSemanticHierarchy_exists + have hraw : run.semantic.raw = indexedVecType := by + have htypes : [indexedVecType] = [run.semantic.raw] := by + simpa [indexedVecDecl] using run.semantic.raw_types_eq + injection htypes with h + exact h.symm + exact ⟨run, by + simpa only [hraw] using + run.semantic.family.root.constructors.sameHeaders⟩ + +private def indexedVecReorderedViewType : VInductiveType := + { indexedVecType with + ctors := [indexedVecType.ctors[1], indexedVecType.ctors[0]] } + +private def indexedVecReorderedViewDecl : VInductDecl := + { indexedVecDecl with types := [indexedVecReorderedViewType] } + +/-- Swapping the two otherwise unchanged constructor payloads fails the +computational normalization-shape gate before semantic or generation evidence +can be attached. -/ +theorem indexedVecReorderedView_rejected : + VInductDecl.normalization? indexedVecDecl + indexedVecReorderedViewDecl = none := rfl + +theorem indexedVecSemanticFamilyViewTr : + TrExpr natFinalEnv [`u] [] indexedVecFamilyCandidate.view + indexedVecType.type := by + rw [indexedVecFamilyCandidate_view_eq] + obtain ⟨u, htype⟩ := indexedVecType_wf + exact ⟨_, indexedVecSemanticFamilySourceTr, ⟨_, htype⟩⟩ + +theorem indexedVecSemanticNilViewTr : + TrExpr indexedVecTypeEnv [`u] [] nilCandidate.view + indexedVecType.ctors[0].type := by + rw [nilCandidate_view_eq] + obtain ⟨u, htype⟩ := indexedVecNil_wf + exact ⟨_, indexedVecSemanticNilSourceTr, ⟨_, htype⟩⟩ + +theorem indexedVecSemanticConsViewTr : + TrExpr indexedVecTypeEnv [`u] [] consCandidate.view + indexedVecType.ctors[1].type := by + rw [consCandidate_view_eq] + obtain ⟨u, htype⟩ := indexedVecSemanticConsIsType + exact ⟨_, indexedVecSemanticConsSourceTr, ⟨_, htype⟩⟩ + +def indexedVecSemanticFamilyRootRun : + TypeChecker.CandidateExprRootRun natFinalEnv [`u] + indexedVecFamilyCandidate indexedVecType.type indexedVecType.type where + contextRun := indexedVecSemanticFamilyContextRun + venv_eq := rfl + lparams_eq := rfl + vlctx_eq := rfl + source_tr := indexedVecSemanticFamilySourceTr + view_tr := indexedVecSemanticFamilyViewTr + whnfFuel := 9999 + whnfDepth := rfl + +def indexedVecSemanticNilRootRun : + TypeChecker.CandidateExprRootRun indexedVecTypeEnv [`u] + nilCandidate indexedVecType.ctors[0].type + indexedVecType.ctors[0].type where + contextRun := by + simpa [nilCandidate, nilCandidateContext] using indexedVecSemanticCtorContextRun + venv_eq := rfl + lparams_eq := rfl + vlctx_eq := rfl + source_tr := indexedVecSemanticNilSourceTr + view_tr := indexedVecSemanticNilViewTr + whnfFuel := 9999 + whnfDepth := rfl + +def indexedVecSemanticConsRootRun : + TypeChecker.CandidateExprRootRun indexedVecTypeEnv [`u] + consCandidate indexedVecType.ctors[1].type + indexedVecType.ctors[1].type where + contextRun := by + simpa [consCandidate, consRootContext] using indexedVecSemanticCtorContextRun + venv_eq := rfl + lparams_eq := rfl + vlctx_eq := rfl + source_tr := indexedVecSemanticConsSourceTr + view_tr := indexedVecSemanticConsViewTr + whnfFuel := 9999 + whnfDepth := rfl + +def indexedVecSemanticFamilySemanticRootRun : + TypeChecker.CandidateExprSemanticRootRun natFinalEnv [`u] + indexedVecFamilyCandidate indexedVecType.type := + indexedVecSemanticFamilyRootRun.semanticOfIdentity + indexedVecFamilyCandidate_identity + +def indexedVecSemanticNilSemanticRootRun : + TypeChecker.CandidateExprSemanticRootRun indexedVecTypeEnv [`u] + nilCandidate indexedVecType.ctors[0].type := + indexedVecSemanticNilRootRun.semanticOfIdentity nilCandidate_identity + +def indexedVecSemanticConsSemanticRootRun : + TypeChecker.CandidateExprSemanticRootRun indexedVecTypeEnv [`u] + consCandidate indexedVecType.ctors[1].type := + indexedVecSemanticConsRootRun.semanticOfIdentity consCandidate_identity + +def indexedVecSemanticNilConstructorSemanticRun : + VInductDecl.CandidateConstructorSemanticRun indexedVecTypeEnv [`u] + indexedVecNilConstructorCandidate indexedVecType.ctors[0] where + name_eq := rfl + uvars_eq := rfl + type := indexedVecSemanticNilSemanticRootRun + +def indexedVecSemanticConsConstructorSemanticRun : + VInductDecl.CandidateConstructorSemanticRun indexedVecTypeEnv [`u] + indexedVecConsConstructorCandidate indexedVecType.ctors[1] where + name_eq := rfl + uvars_eq := rfl + type := indexedVecSemanticConsSemanticRootRun + +def indexedVecSemanticNilConstructorRun : + VInductDecl.CandidateConstructorRun indexedVecTypeEnv [`u] + indexedVecNilConstructorCandidate indexedVecType.ctors[0] := + indexedVecSemanticNilConstructorSemanticRun.root + +def indexedVecSemanticConsConstructorRun : + VInductDecl.CandidateConstructorRun indexedVecTypeEnv [`u] + indexedVecConsConstructorCandidate indexedVecType.ctors[1] := + indexedVecSemanticConsConstructorSemanticRun.root + +def indexedVecSemanticConstructorSemanticListRun : + VInductDecl.CandidateConstructorSemanticListRun indexedVecTypeEnv [`u] + indexedVecFamilyListCandidate.constructors indexedVecType.ctors := by + exact .cons indexedVecSemanticNilConstructorSemanticRun + (.cons indexedVecSemanticConsConstructorSemanticRun .nil) + +def indexedVecSemanticConstructorListRun : + VInductDecl.CandidateConstructorListRun indexedVecTypeEnv [`u] + indexedVecFamilyListCandidate.constructors indexedVecType.ctors := + indexedVecSemanticConstructorSemanticListRun.roots + +def indexedVecSemanticFamilySemanticRun : + VInductDecl.CandidateFamilySemanticRun natFinalEnv [`u] + indexedVecFamilyListCandidate indexedVecType where + name_eq := rfl + uvars_eq := rfl + type := indexedVecSemanticFamilySemanticRootRun + typeEnv := indexedVecTypeEnv + addType := rfl + constructors := indexedVecSemanticConstructorSemanticListRun + +def indexedVecSemanticFamilyRun : + VInductDecl.CandidateFamilyRun natFinalEnv [`u] + indexedVecFamilyListCandidate indexedVecType := + indexedVecSemanticFamilySemanticRun.root + +/-- Temporary L4L-01A compatibility witness. The two-stage owner proves a +semantic run exists without choosing this concrete identity value; L4L-01E +removes the explicit downstream witness. -/ +def indexedVecSemanticNormalizationCandidateSemanticRun : + VInductDecl.NormalizationCandidateSemanticRun natFinalEnv [`u] + indexedVecNormalizationCandidate indexedVecDecl where + raw := indexedVecType + raw_types_eq := rfl + uvars_eq := rfl + family := indexedVecSemanticFamilySemanticRun + +def indexedVecSemanticNormalizationCandidateRun : + VInductDecl.NormalizationCandidateRun natFinalEnv [`u] + indexedVecNormalizationCandidate indexedVecDecl := + indexedVecSemanticNormalizationCandidateSemanticRun.root + +/-- Reconstructing every family and constructor payload leaves the identity +IndexedVec declaration unchanged. -/ +theorem indexedVecSemantic_viewDecl_eq : + indexedVecSemanticNormalizationCandidateRun.viewDecl = + indexedVecDecl := rfl + +/-- The candidate-derived normalization is exactly the analyzer's canonical +identity normalization, not merely propositionally interchangeable with it. -/ +theorem indexedVecSemantic_normalization_eq : + indexedVecSemanticNormalizationCandidateRun.normalization = + indexedVecChecked.identityGeneration.block.normalization := rfl + +def indexedVecSemanticFamilySpineRun : + TypeChecker.CandidateExprSpineRun natFinalEnv [`u] + indexedVecFamilyCandidate indexedVecType.type + indexedVecType.type := + indexedVecSemanticFamilySemanticRootRun.spine + indexedVecFamilyCandidate_identity.storedSpine + +def indexedVecSemanticNilSpineRun : + TypeChecker.CandidateExprSpineRun indexedVecTypeEnv [`u] + nilCandidate indexedVecType.ctors[0].type + indexedVecType.ctors[0].type := + indexedVecSemanticNilSemanticRootRun.spine + nilCandidate_identity.storedSpine + +def indexedVecSemanticConsSpineRun : + TypeChecker.CandidateExprSpineRun indexedVecTypeEnv [`u] + consCandidate indexedVecType.ctors[1].type + indexedVecType.ctors[1].type := + indexedVecSemanticConsSemanticRootRun.spine + consCandidate_identity.storedSpine + +theorem indexedVecSemanticCandidate_generationShape : + indexedVecSemanticNormalizationCandidateSemanticRun.generationShape = + true := by + change ((indexedVecFamilyCandidate.trace.storedSpine && true) && + ((nilCandidate.trace.storedSpine && true) && + ((consCandidate.trace.storedSpine && true) && true))) = true + rw [indexedVecFamilyCandidate_identity.storedSpine, + nilCandidate_identity.storedSpine, + consCandidate_identity.storedSpine] + rfl + +/-- The consolidated constructor gate rejects truncation in either direction +before dependent semantic generation is assembled. -/ +theorem indexedVecSemanticCandidate_missingRawShape_rejected : + VInductDecl.candidateConstructorSemanticGenerationShape indexedVecDecl + (.cons indexedVecNilConstructorCandidate .nil) [] = false := + rfl + +theorem indexedVecSemanticCandidate_extraRawShape_rejected : + VInductDecl.candidateConstructorSemanticGenerationShape indexedVecDecl + .nil [indexedVecType.ctors[0]] = false := + rfl + +/-- Temporary L4L-01A view-WF compatibility premise. L4L-01D derives this +from retained validation and L4L-01E removes it from package construction. -/ +theorem indexedVecSemanticCandidate_viewDecl_wf : + indexedVecSemanticNormalizationCandidateRun.viewDecl.WF natFinalEnv := by + change indexedVecDecl.WF natFinalEnv + exact indexedVecDecl_wf + +def indexedVecSemanticProducedGenerationShapeCandidate : + VInductDecl.ProducedGenerationShapeCandidate indexedVecDecl indexedVecType + indexedVecKernelType 0 false indexedVecFamilyCandidateContext where + candidate := indexedVecNormalizationCandidate + produced := indexedVecNormalizationCandidateProduced + shape := indexedVecSemanticCandidate_generationShape + +/-- The strengthened outer gate retains the complete parameter/index and +ordered `nil`/`cons` generation layout in the same produced result. -/ +theorem indexedVecSemanticGenerationShapeCandidate_produced : + VInductDecl.produceGenerationShapeCandidate indexedVecDecl indexedVecType + indexedVecKernelType 0 false indexedVecFamilyCandidateContext = + .ok indexedVecSemanticProducedGenerationShapeCandidate := by + have produced : + AddInductive.buildNormalizationCandidate indexedVecDecl.nparams + [indexedVecKernelType] 0 false indexedVecFamilyCandidateContext = + .ok indexedVecNormalizationCandidate := + indexedVecNormalizationCandidateProduced + simpa only [indexedVecSemanticProducedGenerationShapeCandidate] using + VInductDecl.produceGenerationShapeCandidate_eq_ok + (source := indexedVecDecl) (raw := indexedVecType) + produced indexedVecSemanticCandidate_generationShape + +def indexedVecSemanticGenerationCandidateSemanticRun : + VInductDecl.GenerationCandidateSemanticRun + indexedVecSemanticNormalizationCandidateSemanticRun + indexedVecChecked.identityGeneration := + VInductDecl.GenerationCandidateSemanticRun.ofGenerationShape + indexedVecSemanticNormalizationCandidateSemanticRun + indexedVecChecked.identityGeneration rfl + indexedVecSemanticCandidate_viewDecl_wf + indexedVecSemanticCandidate_generationShape + +def indexedVecSemanticGenerationCandidateRun : + VInductDecl.GenerationCandidateRun + indexedVecSemanticNormalizationCandidateRun + indexedVecChecked.identityGeneration := + indexedVecSemanticGenerationCandidateSemanticRun.run + +def indexedVecSemanticGenerationCandidatePackage : + VInductDecl.GenerationCandidatePackage natFinalEnv [`u] := + indexedVecSemanticGenerationCandidateSemanticRun.package + +def indexedVecSemanticProducedGenerationCandidatePackage : + VInductDecl.ProducedGenerationCandidatePackage natFinalEnv [`u] := + indexedVecSemanticProducedGenerationShapeCandidate.producedPackage + indexedVecSemanticNormalizationCandidateSemanticRun rfl + indexedVecChecked.identityGeneration rfl + indexedVecSemanticCandidate_viewDecl_wf + +def indexedVecSemanticGenerationCertificate : + indexedVecDecl.GenerationCertificate natFinalEnv := + indexedVecSemanticProducedGenerationCandidatePackage.package.certificate + +theorem indexedVecSemantic_addInductCertified : + natFinalEnv.addInductCertified indexedVecSemanticGenerationCertificate = + some indexedVecFinalEnv := by + rfl + +theorem indexedVecSemanticCertified_trace : + Nonempty (VEnv.AddInductGenerationTrace natFinalEnv + indexedVecFinalEnv indexedVecChecked.identityGeneration) := + VEnv.addInductCertified_trace indexedVecSemantic_addInductCertified + +theorem indexedVecSemanticCertified_ordered : + indexedVecFinalEnv.Ordered := + VEnv.addInductCertified_WF nat_env_wf.ordered + indexedVecSemantic_addInductCertified + +def indexedVecSemanticAddInductTraceChecked : + AddInductTrace natMap natFinalEnv indexedVecDecl indexedVecMap + indexedVecFinalEnv := by + refine indexedVecSemanticProducedGenerationCandidatePackage.package.addInductTrace + indexedVecTypeMap indexedVecTypeEnv indexedVecCtorMap + indexedVecCtorEnv indexedVecRecEnv ?_ ?_ ?_ ⟨rfl⟩ + · exact { + info := indexedVecInfo + kind_eq := by simp [indexedVecInfo, InductConstantKind.Matches] + tr := indexedVecInfo_tr + map_fresh := by + rw [show + indexedVecSemanticProducedGenerationCandidatePackage.package.generation.block.sourceType.name = + ``IndexedVec by rfl] + exact indexedVecType_fresh + env_add := rfl + map_add := rfl } + · refine .cons (m₂ := indexedVecNilMap) + (env₂ := indexedVecNilEnv) ?_ ?_ + · exact { + info := indexedVecNilInfo + kind_eq := by simp [indexedVecNilInfo, InductConstantKind.Matches] + tr := indexedVecNilInfo_tr + map_fresh := by simpa [indexedVecType] using indexedVecNil_fresh + env_add := rfl + map_add := rfl } + · refine .cons ?_ .nil + exact { + info := indexedVecConsInfo + kind_eq := by simp [indexedVecConsInfo, InductConstantKind.Matches] + tr := indexedVecConsInfo_tr + map_fresh := by simpa [indexedVecType] using indexedVecCons_fresh + env_add := rfl + map_add := rfl } + · exact { + info := indexedVecRecInfo + kind_eq := by simp [indexedVecRecInfo, InductConstantKind.Matches] + tr := indexedVecRecInfo_tr + map_fresh := by + rw [show + (inductGenerationRecVal + indexedVecSemanticProducedGenerationCandidatePackage.package.generation).name = + ``IndexedVec.rec by rfl] + exact indexedVecRec_fresh + env_add := rfl + map_add := rfl } + +theorem indexedVecSemantic_addInduct_checked : + AddInduct natMap natFinalEnv indexedVecDecl indexedVecMap + indexedVecFinalEnv := + ⟨indexedVecSemanticAddInductTraceChecked⟩ + +theorem indexedVecSemantic_trEnv'_checked : + TrEnv' .safe indexedVecMap false indexedVecFinalEnv := + .induct indexedVecSemantic_addInduct_checked nat_trEnv' + +theorem indexedVecSemantic_env_wf_checked : indexedVecFinalEnv.WF := + indexedVecSemantic_trEnv'_checked.wf + +theorem indexedVecSemantic_aligned_checked : + Aligned .safe indexedVecMap indexedVecFinalEnv := + indexedVecSemantic_trEnv'_checked.aligned + +/- +The semantic assembly, executable producer, and final E1 replay intentionally +inherit the existing transitional verifier closure. These guards make +additions to that closure visible at the public roots of this module. +-/ +/-- +info: 'Lean4Lean.InductiveReplayFixtures.indexedVecProducedSemanticHierarchy_exists' depends on axioms: [propext, + sorryAx, + Classical.choice, + ptrEqConstantInfo_eq, + ptrEqExpr_eq, + Quot.sound, + Expr.abstractRange_eq, + Expr.abstract_eq, + Expr.eqv_eq, + Expr.hasLooseBVar_eq, + Expr.instantiate1_eq, + Expr.instantiateRange_eq, + Expr.instantiateRevRange_eq, + Expr.instantiateRev_eq, + Expr.instantiate_eq, + Expr.looseBVarRange_eq, + Expr.lowerLooseBVars_eq, + Expr.mkAppData_eq, + Expr.mkData_eq, + Expr.replace_eq, + Level.hasMVar_eq, + Level.hasParam_eq, + Level.instLawfulBEqLevel, + PersistentArray.toList'_push, + PersistentHashMap.findAux_isSome, + Syntax.structEq_eq, + PersistentHashMap.WF.find?_eq, + PersistentHashMap.WF.toList'_insert] +-/ +#guard_msgs in +#print axioms indexedVecProducedSemanticHierarchy_exists + +/-- +info: 'Lean4Lean.InductiveReplayFixtures.indexedVecProducedSemanticHierarchy_constructorHeaders' depends on axioms: [propext, + sorryAx, + Classical.choice, + ptrEqConstantInfo_eq, + ptrEqExpr_eq, + Quot.sound, + Expr.abstractRange_eq, + Expr.abstract_eq, + Expr.eqv_eq, + Expr.hasLooseBVar_eq, + Expr.instantiate1_eq, + Expr.instantiateRange_eq, + Expr.instantiateRevRange_eq, + Expr.instantiateRev_eq, + Expr.instantiate_eq, + Expr.looseBVarRange_eq, + Expr.lowerLooseBVars_eq, + Expr.mkAppData_eq, + Expr.mkData_eq, + Expr.replace_eq, + Level.hasMVar_eq, + Level.hasParam_eq, + Level.instLawfulBEqLevel, + PersistentArray.toList'_push, + PersistentHashMap.findAux_isSome, + Syntax.structEq_eq, + PersistentHashMap.WF.find?_eq, + PersistentHashMap.WF.toList'_insert] +-/ +#guard_msgs in +#print axioms indexedVecProducedSemanticHierarchy_constructorHeaders + +/-- +info: 'Lean4Lean.InductiveReplayFixtures.indexedVecReorderedView_rejected' depends on axioms: [propext] +-/ +#guard_msgs in +#print axioms indexedVecReorderedView_rejected + +/-- +info: 'Lean4Lean.InductiveReplayFixtures.indexedVecSemanticCandidate_missingRawShape_rejected' depends on axioms: [propext, + sorryAx, + Classical.choice, + Quot.sound, + Expr.eqv_eq, + Expr.instantiate1_eq, + Expr.instantiateRev_eq, + Expr.instantiate_eq, + Expr.looseBVarRange_eq, + Expr.mkAppData_eq, + Expr.mkData_eq, + Expr.replace_eq, + Level.hasParam_eq, + Level.instLawfulBEqLevel, + PersistentArray.toList'_push, + PersistentHashMap.findAux_isSome, + Syntax.structEq_eq, + PersistentHashMap.WF.find?_eq, + PersistentHashMap.WF.toList'_insert] +-/ +#guard_msgs in +#print axioms indexedVecSemanticCandidate_missingRawShape_rejected + +/-- +info: 'Lean4Lean.InductiveReplayFixtures.indexedVecSemanticCandidate_extraRawShape_rejected' depends on axioms: [propext, + Classical.choice, + Quot.sound] +-/ +#guard_msgs in +#print axioms indexedVecSemanticCandidate_extraRawShape_rejected + +/-- +info: 'Lean4Lean.InductiveReplayFixtures.indexedVecSemanticGenerationShapeCandidate_produced' depends on axioms: [propext, + sorryAx, + Classical.choice, + ptrEqConstantInfo_eq, + ptrEqExpr_eq, + Quot.sound, + Expr.abstractRange_eq, + Expr.abstract_eq, + Expr.eqv_eq, + Expr.hasLooseBVar_eq, + Expr.instantiate1_eq, + Expr.instantiateRange_eq, + Expr.instantiateRevRange_eq, + Expr.instantiateRev_eq, + Expr.instantiate_eq, + Expr.looseBVarRange_eq, + Expr.lowerLooseBVars_eq, + Expr.mkAppData_eq, + Expr.mkData_eq, + Expr.replace_eq, + Level.hasMVar_eq, + Level.hasParam_eq, + Level.instLawfulBEqLevel, + PersistentArray.toList'_push, + PersistentHashMap.findAux_isSome, + Syntax.structEq_eq, + PersistentHashMap.WF.find?_eq, + PersistentHashMap.WF.toList'_insert] +-/ +#guard_msgs in +#print axioms indexedVecSemanticGenerationShapeCandidate_produced + +/-- +info: 'Lean4Lean.InductiveReplayFixtures.indexedVecSemanticGenerationCandidateSemanticRun' depends on axioms: [propext, + sorryAx, + Classical.choice, + ptrEqConstantInfo_eq, + ptrEqExpr_eq, + Quot.sound, + Expr.abstractRange_eq, + Expr.abstract_eq, + Expr.eqv_eq, + Expr.hasLooseBVar_eq, + Expr.instantiate1_eq, + Expr.instantiateRange_eq, + Expr.instantiateRevRange_eq, + Expr.instantiateRev_eq, + Expr.instantiate_eq, + Expr.looseBVarRange_eq, + Expr.lowerLooseBVars_eq, + Expr.mkAppData_eq, + Expr.mkData_eq, + Expr.replace_eq, + Level.hasMVar_eq, + Level.hasParam_eq, + Level.instLawfulBEqLevel, + PersistentArray.toList'_push, + PersistentHashMap.findAux_isSome, + Syntax.structEq_eq, + PersistentHashMap.WF.find?_eq, + PersistentHashMap.WF.toList'_insert] +-/ +#guard_msgs in +#print axioms indexedVecSemanticGenerationCandidateSemanticRun + +/-- +info: 'Lean4Lean.InductiveReplayFixtures.indexedVecSemanticProducedGenerationCandidatePackage' depends on axioms: [propext, + sorryAx, + Classical.choice, + ptrEqConstantInfo_eq, + ptrEqExpr_eq, + Quot.sound, + Expr.abstractRange_eq, + Expr.abstract_eq, + Expr.eqv_eq, + Expr.hasLooseBVar_eq, + Expr.instantiate1_eq, + Expr.instantiateRange_eq, + Expr.instantiateRevRange_eq, + Expr.instantiateRev_eq, + Expr.instantiate_eq, + Expr.looseBVarRange_eq, + Expr.lowerLooseBVars_eq, + Expr.mkAppData_eq, + Expr.mkData_eq, + Expr.replace_eq, + Level.hasMVar_eq, + Level.hasParam_eq, + Level.instLawfulBEqLevel, + PersistentArray.toList'_push, + PersistentHashMap.findAux_isSome, + Syntax.structEq_eq, + PersistentHashMap.WF.find?_eq, + PersistentHashMap.WF.toList'_insert] +-/ +#guard_msgs in +#print axioms indexedVecSemanticProducedGenerationCandidatePackage + +/-- +info: 'Lean4Lean.InductiveReplayFixtures.indexedVecSemantic_trEnv'_checked' depends on axioms: [propext, + sorryAx, + Classical.choice, + ptrEqConstantInfo_eq, + ptrEqExpr_eq, + Quot.sound, + Expr.abstractRange_eq, + Expr.abstract_eq, + Expr.eqv_eq, + Expr.hasLooseBVar_eq, + Expr.instantiate1_eq, + Expr.instantiateRange_eq, + Expr.instantiateRevRange_eq, + Expr.instantiateRev_eq, + Expr.instantiate_eq, + Expr.looseBVarRange_eq, + Expr.lowerLooseBVars_eq, + Expr.mkAppData_eq, + Expr.mkData_eq, + Expr.replace_eq, + Level.hasMVar_eq, + Level.hasParam_eq, + Level.instLawfulBEqLevel, + PersistentArray.toList'_push, + PersistentHashMap.findAux_isSome, + Syntax.structEq_eq, + PersistentHashMap.WF.find?_eq, + PersistentHashMap.WF.toList'_insert] +-/ +#guard_msgs in +#print axioms indexedVecSemantic_trEnv'_checked + +end Lean4Lean.InductiveReplayFixtures diff --git a/Lean4Lean/Verify/Environment/InductiveFixtures.lean b/Lean4Lean/Verify/Environment/InductiveFixtures.lean index 6027cad4..29245f7b 100644 --- a/Lean4Lean/Verify/Environment/InductiveFixtures.lean +++ b/Lean4Lean/Verify/Environment/InductiveFixtures.lean @@ -4,6 +4,7 @@ import Lean4Lean.Inductive.Add import Lean4Lean.Theory.Meta import Lean4Lean.Theory.InductiveFixtures import Lean4Lean.Theory.Typing.Meta +import Batteries.Data.UnionFind.Lemmas /-! End-to-end replay fixtures for inductive environment alignment. @@ -307,7 +308,9 @@ theorem nat_addInduct : info := natInfo kind_eq := by simp [natInfo, InductConstantKind.Matches] tr := natInfo_tr - map_fresh := by simpa [natType] using natType_fresh + map_fresh := by + change ({} : ConstMap).find? ``Nat = none + exact natType_fresh env_add := rfl map_add := rfl } addCtors := ?_ @@ -315,7 +318,9 @@ theorem nat_addInduct : info := natRecInfo kind_eq := by simp [natRecInfo, InductConstantKind.Matches] tr := natRecInfo_tr - map_fresh := by simpa [inductRecVal, natDecl, natType] using natRec_fresh + map_fresh := by + change natCtorMap.find? ``Nat.rec = none + exact natRec_fresh env_add := rfl map_add := rfl } addRules := ⟨rfl⟩ }⟩ @@ -330,7 +335,9 @@ theorem nat_addInduct : info := natSuccInfo kind_eq := by simp [natSuccInfo, InductConstantKind.Matches] tr := natSuccInfo_tr - map_fresh := by simpa [natType] using natSucc_fresh + map_fresh := by + change natZeroMap.find? ``Nat.succ = none + exact natSucc_fresh env_add := rfl map_add := rfl } .nil) @@ -561,7 +568,9 @@ theorem seedNat_addInduct : info := natInfo kind_eq := by simp [natInfo, InductConstantKind.Matches] tr := seedNatInfo_tr - map_fresh := by simpa [natType] using seedNatType_fresh + map_fresh := by + change seedMap.find? ``Nat = none + exact seedNatType_fresh env_add := rfl map_add := rfl } addCtors := ?_ @@ -569,7 +578,9 @@ theorem seedNat_addInduct : info := natRecInfo kind_eq := by simp [natRecInfo, InductConstantKind.Matches] tr := seedNatRecInfo_tr - map_fresh := by simpa [inductRecVal, natDecl, natType] using seedNatRec_fresh + map_fresh := by + change seedNatCtorMap.find? ``Nat.rec = none + exact seedNatRec_fresh env_add := rfl map_add := rfl } addRules := ⟨rfl⟩ }⟩ @@ -584,7 +595,9 @@ theorem seedNat_addInduct : info := natSuccInfo kind_eq := by simp [natSuccInfo, InductConstantKind.Matches] tr := seedNatSuccInfo_tr - map_fresh := by simpa [natType] using seedNatSucc_fresh + map_fresh := by + change seedNatZeroMap.find? ``Nat.succ = none + exact seedNatSucc_fresh env_add := rfl map_add := rfl } .nil) @@ -808,7 +821,9 @@ theorem eq_addInduct : info := eqInfo kind_eq := by simp [eqInfo, InductConstantKind.Matches] tr := eqInfo_tr - map_fresh := by simpa [eqType] using eqType_fresh + map_fresh := by + change ({} : ConstMap).find? ``Eq = none + exact eqType_fresh env_add := rfl map_add := rfl } addCtors := ?_ @@ -816,7 +831,9 @@ theorem eq_addInduct : info := eqRecInfo kind_eq := by simp [eqRecInfo, InductConstantKind.Matches] tr := eqRecInfo_tr - map_fresh := by simpa [inductRecVal, eqDecl, eqType] using eqRec_fresh + map_fresh := by + change eqCtorMap.find? ``Eq.rec = none + exact eqRec_fresh env_add := rfl map_add := rfl } addRules := ⟨rfl⟩ }⟩ @@ -1295,7 +1312,9 @@ theorem indexedVec_addInduct : info := indexedVecInfo kind_eq := by simp [indexedVecInfo, InductConstantKind.Matches] tr := indexedVecInfo_tr - map_fresh := by simpa [indexedVecType] using indexedVecType_fresh + map_fresh := by + change natMap.find? ``IndexedVec = none + exact indexedVecType_fresh env_add := rfl map_add := rfl } addCtors := ?_ @@ -1304,8 +1323,8 @@ theorem indexedVec_addInduct : kind_eq := by simp [indexedVecRecInfo, InductConstantKind.Matches] tr := indexedVecRecInfo_tr map_fresh := by - simpa [inductRecVal, indexedVecDecl, indexedVecType] using - indexedVecRec_fresh + change indexedVecCtorMap.find? ``IndexedVec.rec = none + exact indexedVecRec_fresh env_add := rfl map_add := rfl } addRules := ⟨rfl⟩ }⟩ @@ -1320,7 +1339,9 @@ theorem indexedVec_addInduct : info := indexedVecConsInfo kind_eq := by simp [indexedVecConsInfo, InductConstantKind.Matches] tr := indexedVecConsInfo_tr - map_fresh := by simpa [indexedVecType] using indexedVecCons_fresh + map_fresh := by + change indexedVecNilMap.find? ``IndexedVec.cons = none + exact indexedVecCons_fresh env_add := rfl map_add := rfl } .nil) @@ -1600,7 +1621,9 @@ theorem acc_addInduct : info := accInfo kind_eq := by simp [accInfo, InductConstantKind.Matches] tr := accInfo_tr - map_fresh := by simpa [accType] using accType_fresh + map_fresh := by + change ({} : ConstMap).find? ``Acc = none + exact accType_fresh env_add := rfl map_add := rfl } addCtors := ?_ @@ -1609,7 +1632,8 @@ theorem acc_addInduct : kind_eq := by simp [accRecInfo, InductConstantKind.Matches] tr := accRecInfo_tr map_fresh := by - simpa [inductRecVal, accDecl, accType] using accRec_fresh + change accCtorMap.find? ``Acc.rec = none + exact accRec_fresh env_add := rfl map_add := rfl } addRules := ⟨rfl⟩ }⟩ @@ -1916,7 +1940,8 @@ private def aliasFormerAddInductTraceWith kind_eq := by simp [aliasFormerInfo, InductConstantKind.Matches] tr := aliasFormerInfo_tr map_fresh := by - simpa [aliasFormerRawType] using aliasFormerType_fresh + change typeFamilyAliasMap.find? ``AliasFormer = none + exact aliasFormerType_fresh env_add := rfl map_add := rfl } addCtors := ?_ @@ -1925,8 +1950,8 @@ private def aliasFormerAddInductTraceWith kind_eq := by simp [aliasFormerRecInfo, InductConstantKind.Matches] tr := aliasFormerRecInfo_tr map_fresh := by - simpa [inductGenerationRecVal, aliasFormerRawType] using - aliasFormerRec_fresh + change aliasFormerCtorMap.find? ``AliasFormer.rec = none + exact aliasFormerRec_fresh env_add := rfl map_add := rfl } addRules := ⟨rfl⟩ } @@ -2217,7 +2242,9 @@ private def aliasRecAddInductTraceWith info := aliasRecInfo kind_eq := by simp [aliasRecInfo, InductConstantKind.Matches] tr := aliasRecInfo_tr - map_fresh := by simpa [aliasRecRawType] using aliasRecType_fresh + map_fresh := by + change recAliasMap.find? ``AliasRec = none + exact aliasRecType_fresh env_add := rfl map_add := rfl } addCtors := ?_ @@ -2226,8 +2253,8 @@ private def aliasRecAddInductTraceWith kind_eq := by simp [aliasRecRecInfo, InductConstantKind.Matches] tr := aliasRecRecInfo_tr map_fresh := by - simpa [inductGenerationRecVal, aliasRecRawType] using - aliasRecRec_fresh + change aliasRecCtorMap.find? ``AliasRec.rec = none + exact aliasRecRec_fresh env_add := rfl map_add := rfl } addRules := ⟨rfl⟩ } @@ -2299,6 +2326,862 @@ theorem aliasRec_rec_lookup_unique : aliasRec_aligned.find?_uniq aliasRec_rec_map_lookup aliasRecFinalEnv_rec_lookup +/-! ## Binder annotation candidate fixtures -/ + +/- These four definitions are quoted from the running kernel rather than +reconstructed. The resulting minimal environment is sufficient for the +ordinary checker to delta-reduce every annotation gadget while leaving the +shared `Nat` endpoint opaque. -/ +private def annotationOutParamInfo : ConstantInfo := + .defnInfo (kernelDefVal% outParam) + +private def annotationSemiOutParamInfo : ConstantInfo := + .defnInfo (kernelDefVal% semiOutParam) + +private def annotationOptParamInfo : ConstantInfo := + .defnInfo (kernelDefVal% optParam) + +private def annotationAutoParamInfo : ConstantInfo := + .defnInfo (kernelDefVal% autoParam) + +private def annotationKernelMap : ConstMap := + ((({} : ConstMap).insert ``outParam annotationOutParamInfo).insert + ``semiOutParam annotationSemiOutParamInfo).insert + ``optParam annotationOptParamInfo |>.insert + ``autoParam annotationAutoParamInfo + +private def annotationKernelEnv : Kernel.Environment := + Kernel.Environment.ofConstants `_annotationCandidate annotationKernelMap + +private def annotationCandidateContext : AddInductive.Context where + env := annotationKernelEnv + lparams := [] + safety := .safe + allowPrimitive := false + +private def annotationNatExpr : Expr := .const ``Nat [] + +private def outParamDomain : Expr := + .app (.const ``outParam [.succ .zero]) annotationNatExpr + +private def semiOutParamDomain : Expr := + .app (.const ``semiOutParam [.succ .zero]) annotationNatExpr + +private def optParamDomain : Expr := + .app (.app (.const ``optParam [.succ .zero]) annotationNatExpr) + (.lit (.natVal 0)) + +private def autoParamDomain : Expr := + .app (.app (.const ``autoParam [.succ .zero]) annotationNatExpr) + (.const ``Lean.Syntax.missing []) + +/- Each constructor is inhabited at its precise source and consumed indices; +the guards below additionally ensure the executable structural mirror chooses +that constructor. -/ +private def outParamTrace : + AddInductive.CandidateTypeAnnotationTrace + outParamDomain annotationNatExpr := + .outParam [.succ .zero] annotationNatExpr (.identity _) + +private def semiOutParamTrace : + AddInductive.CandidateTypeAnnotationTrace + semiOutParamDomain annotationNatExpr := + .semiOutParam [.succ .zero] annotationNatExpr (.identity _) + +private def optParamTrace : + AddInductive.CandidateTypeAnnotationTrace + optParamDomain annotationNatExpr := + .optParam [.succ .zero] annotationNatExpr + (.lit (.natVal 0)) (.identity _) + +private def autoParamTrace : + AddInductive.CandidateTypeAnnotationTrace + autoParamDomain annotationNatExpr := + .autoParam [.succ .zero] annotationNatExpr + (.const ``Lean.Syntax.missing []) (.identity _) + +private def annotationTraceTag : + AddInductive.CandidateTypeAnnotationTrace source consumed → Nat + | .identity _ => 0 + | .outParam .. => 1 + | .semiOutParam .. => 2 + | .optParam .. => 3 + | .autoParam .. => 4 + +#guard let ⟨consumed, trace⟩ := + AddInductive.CandidateTypeAnnotationTrace.build outParamDomain + consumed.equal annotationNatExpr && annotationTraceTag trace == 1 + +#guard let ⟨consumed, trace⟩ := + AddInductive.CandidateTypeAnnotationTrace.build semiOutParamDomain + consumed.equal annotationNatExpr && annotationTraceTag trace == 2 + +#guard let ⟨consumed, trace⟩ := + AddInductive.CandidateTypeAnnotationTrace.build optParamDomain + consumed.equal annotationNatExpr && annotationTraceTag trace == 3 + +#guard let ⟨consumed, trace⟩ := + AddInductive.CandidateTypeAnnotationTrace.build autoParamDomain + consumed.equal annotationNatExpr && annotationTraceTag trace == 4 + +private def annotationCandidateAccepted (domain expected : Expr) : Bool := + match AddInductive.buildCandidateTypeAnnotations domain with + | .error _ => false + | .ok annotations => + annotations.consumed.equal expected && + match AddInductive.observeCandidateIsDefEq annotationCandidateContext + domain annotations.consumed with + | .ok _ => true + | .error _ => false + +/- These guards cover the complete binder-annotation seam used by the +candidate producer: the transparent structural implementation remains +differentially equal to Lean's opaque helper, followed by an exact successful +ordinary-checker equality observation. -/ +#guard AddInductive.candidateTypeAnnotationsAgree outParamDomain +#guard AddInductive.candidateTypeAnnotationsAgree semiOutParamDomain +#guard AddInductive.candidateTypeAnnotationsAgree optParamDomain +#guard AddInductive.candidateTypeAnnotationsAgree autoParamDomain +#guard annotationCandidateAccepted outParamDomain annotationNatExpr +#guard annotationCandidateAccepted semiOutParamDomain annotationNatExpr +#guard annotationCandidateAccepted optParamDomain annotationNatExpr +#guard annotationCandidateAccepted autoParamDomain annotationNatExpr + +private def annotationIsDefEq (lhs rhs : Expr) := + TypeChecker.M.run annotationCandidateContext.env + annotationCandidateContext.safety annotationCandidateContext.lctx + annotationCandidateContext.lparams annotationCandidateContext.fuel + (TypeChecker.isDefEq lhs rhs) + +/- A genuinely unequal domain is observed as `.ok false`, not a checker +failure, and the candidate boundary rejects it with the dedicated error. -/ +#guard match annotationIsDefEq (.sort .zero) (.sort (.succ .zero)) with + | .ok false => true + | _ => false + +#guard match AddInductive.observeCandidateIsDefEq annotationCandidateContext + (.sort .zero) (.sort (.succ .zero)) with + | .error (.other message) => + message == "normalization candidate changed a binder domain" + | _ => false + +/-! ## Annotated recursive-Pi candidate -/ + +/-- Exact kernel definition and Theory value used to interpret `outParam` +inside a complete recursive constructor candidate. -/ +private def outParamKernelDef : DefinitionVal := + kernelDefVal% outParam + +private def outParamVal : VDefVal where + name := ``outParam + uvars := (vconst(type_of% @outParam) : VConstant).uvars + type := (vconst(type_of% @outParam) : VConstant).type + value := outParamDefEq.rhs + +private theorem outParamInfo_tr : + TrDefVal .safe VEnv.empty annotationOutParamInfo outParamVal := by + refine ⟨⟨⟨by decide, rfl, ?_⟩, rfl⟩, ?_⟩ + · exact .forallE + ⟨_, VEnv.HasType.sort (by decide)⟩ + ⟨_, VEnv.HasType.sort (by decide)⟩ + (.sort rfl) (.sort rfl) + · exact .lam + ⟨_, VEnv.HasType.sort (by decide)⟩ + (.sort rfl) (.bvar rfl) + +private theorem outParamVal_wf : outParamVal.WF VEnv.empty := by + exact VEnv.HasType.lam + (VEnv.HasType.sort (by decide)) + (VEnv.HasType.bvar .zero) + +private def outParamMap : ConstMap := + ({} : ConstMap).insert ``outParam annotationOutParamInfo + +private theorem outParamMap_fresh : + ({} : ConstMap).find? ``outParam = none := by + simp [SMap.find?] + +private theorem outParam_trEnv' : + TrEnv' .safe outParamMap false outParamEnv := + .defn (ci := outParamKernelDef) (ci' := outParamVal) + outParamInfo_tr outParamMap_fresh outParamVal_wf rfl .empty + +private theorem outParamMap_wf : outParamMap.WF := + outParam_trEnv'.map_wf + +private def outParamKernelEnv : Kernel.Environment := + Kernel.Environment.ofConstants `_annotatedPiCandidate outParamMap + +private theorem outParam_trEnv : + TrEnv .safe outParamKernelEnv outParamEnv := by + simpa [TrEnv, outParamKernelEnv, Kernel.Environment.ofConstants] using + outParam_trEnv' + +private theorem outParam_hasPrimitives : + VEnv.HasPrimitives outParamEnv := by + apply TypeChecker.VEnv.HasPrimitives.of_avoids + intro n hn + simp only [TypeChecker.reflectedPrimitiveNames, List.mem_cons, + List.not_mem_nil, or_false] at hn + rcases hn with rfl | rfl | rfl | rfl | rfl | rfl | rfl | rfl | + rfl | rfl | rfl | rfl | rfl | rfl | rfl | rfl | rfl | rfl | + rfl | rfl | rfl | rfl <;> + rfl + +private theorem outParam_safePrimitives : + outParamKernelEnv.find? n = some ci → + Kernel.Environment.primitives.contains n → + ci.safety = .safe ∧ ci.levelParams = [] := by + intro hfind hprim + change outParamMap.find?' n = some ci at hfind + rw [outParamMap_wf.find?'_eq_find?, outParamMap, + SMap.WF.find?_insert (s := ({} : ConstMap)) SMap.WF.empty] at hfind + simp [SMap.find?] at hfind + obtain ⟨rfl, rfl⟩ := hfind + simp [Kernel.Environment.primitives, NameSet.ofList] at hprim + simp +decide [NameSet.contains] at hprim + +private def outParamVEnvs : VEnvs where + venv _ := outParamEnv + +private theorem outParamVEnvs_wf : outParamVEnvs.WF outParamKernelEnv where + tr := by + intro safety + exact outParam_trEnv'.sf_mono DefinitionSafety.le_safe + hasPrimitives := outParam_hasPrimitives + safePrimitives := outParam_safePrimitives + mono := fun _ => .rfl + +def annotatedPiInfo : ConstantInfo := kernelInductInfo% AnnotatedPi +def annotatedPiMkInfo : ConstantInfo := kernelCtorInfo% AnnotatedPi.mk +def annotatedPiRecInfo : ConstantInfo := kernelRecInfo% AnnotatedPi.rec +def annotatedPiKernelRuleRhs : VExpr := + kernelRecRuleRhs% AnnotatedPi.rec 0 + +example : annotatedPiKernelRuleRhs = + annotatedPiGenerationChecked.generatedRules[0].rhs := rfl + +private def annotatedPiKernelCtor : Constructor where + name := annotatedPiMkInfo.name + type := annotatedPiMkInfo.type + +private def annotatedPiKernelType : InductiveType where + name := annotatedPiInfo.name + type := annotatedPiInfo.type + ctors := [annotatedPiKernelCtor] + +/- The whole-candidate negative keeps the actual AnnotatedPi family and +constructor metadata, but gives the annotation symbol its correct type as an +opaque constant. Ordinary metadata typing can therefore reach the recursive +constructor candidate, while `outParam Prop` is no longer definitionally equal +to the syntactically consumed `Prop`. -/ +private def annotatedPiOpaqueOutParamInfo : ConstantInfo := + .axiomInfo { + name := ``outParam + levelParams := outParamKernelDef.levelParams + type := outParamKernelDef.type + isUnsafe := false } + +private def annotatedPiOpaqueOutParamMap : ConstMap := + ({} : ConstMap).insert ``outParam annotatedPiOpaqueOutParamInfo + +private def annotatedPiOpaqueOutParamEnv : Kernel.Environment := + Kernel.Environment.ofConstants `_annotatedPiOpaqueAnnotation + annotatedPiOpaqueOutParamMap + +private def annotatedPiOpaqueOutParamContext : AddInductive.Context where + env := annotatedPiOpaqueOutParamEnv + lparams := [] + safety := .safe + allowPrimitive := false + +/- This is a complete family/constructor candidate rejection, not the earlier +leaf-level `isDefEq` test. The dedicated message proves failure occurs at the +raw-to-consumed binder equality boundary before any semantic package or +transaction can be assembled. -/ +#guard match AddInductive.buildNormalizationCandidate 0 + [annotatedPiKernelType] 0 false annotatedPiOpaqueOutParamContext with + | .error (.other message) => + message == "normalization candidate changed a binder domain" + | _ => false + +private theorem annotatedPiRawType_wf : + annotatedPiRawType.toVConstant.WF outParamEnv := by + exact ⟨_, VEnv.HasType.sort (by decide)⟩ + +private theorem annotatedPiInfo_tr : + TrConstVal .safe outParamEnv annotatedPiInfo + annotatedPiRawType.toVConstVal := by + refine ⟨⟨by decide, rfl, ?_⟩, rfl⟩ + have hshape : TrTypeExpr outParamEnv annotatedPiInfo.levelParams [] + annotatedPiInfo.type annotatedPiRawType.type := by + tr_type_expr_tac + obtain ⟨u, htype⟩ := annotatedPiRawType_wf + exact hshape.to_trExprS outParamEnv_ordered trivial ⟨.sort u, htype⟩ + +private def annotatedPiTypeEnv : VEnv := + (outParamEnv.addConst annotatedPiRawType.name + annotatedPiRawType.toVConstant).get! + +private def annotatedPiTypeMap : ConstMap := + outParamMap.insert ``AnnotatedPi annotatedPiInfo + +private theorem annotatedPiType_fresh : + outParamMap.find? ``AnnotatedPi = none := by + rw [outParamMap, SMap.WF.find?_insert + (s := ({} : ConstMap)) SMap.WF.empty] + simp [SMap.find?] + +private theorem annotatedPiTypeMap_wf : annotatedPiTypeMap.WF := + outParamMap_wf.insert _ _ annotatedPiType_fresh + +private def annotatedPiAddType : + AddInductConstant .induct outParamMap outParamEnv + annotatedPiRawType.toVConstVal annotatedPiTypeMap + annotatedPiTypeEnv where + info := annotatedPiInfo + kind_eq := by simp [annotatedPiInfo, InductConstantKind.Matches] + tr := annotatedPiInfo_tr + map_fresh := by simpa [annotatedPiRawType] using annotatedPiType_fresh + env_add := rfl + map_add := rfl + +private def annotatedPiTypeKernelEnv : Kernel.Environment := + Kernel.Environment.ofConstants `_annotatedPiCandidate annotatedPiTypeMap + +private theorem annotatedPiTypeEnv_ordered : annotatedPiTypeEnv.Ordered := + .const (n := annotatedPiRawType.name) + (ci := annotatedPiRawType.toVConstant) + outParamEnv_ordered annotatedPiRawType_wf rfl + +private def annotatedPiFamilyCandidateContext : AddInductive.Context where + env := outParamKernelEnv + lparams := [] + safety := .safe + allowPrimitive := false + +private def annotatedPiCtorCandidateContext : AddInductive.Context where + env := annotatedPiTypeKernelEnv + lparams := [] + safety := .safe + allowPrimitive := false + +private theorem annotatedPiType_lookup_outParam : + annotatedPiTypeKernelEnv.find? ``outParam = + some annotationOutParamInfo := by + change annotatedPiTypeMap.find?' ``outParam = + some annotationOutParamInfo + rw [annotatedPiTypeMap_wf.find?'_eq_find?, annotatedPiTypeMap, + outParamMap_wf.find?_insert] + rw [outParamMap, SMap.WF.find?_insert + (s := ({} : ConstMap)) SMap.WF.empty] + rfl + +private theorem annotatedPiType_lookup_family : + annotatedPiTypeKernelEnv.find? ``AnnotatedPi = + some annotatedPiInfo := by + change annotatedPiTypeMap.find?' ``AnnotatedPi = some annotatedPiInfo + rw [annotatedPiTypeMap_wf.find?'_eq_find?, annotatedPiTypeMap, + outParamMap_wf.find?_insert] + rfl + +@[simp] private theorem annotatedPiType_get_outParam : + annotatedPiTypeKernelEnv.get ``outParam = + .ok annotationOutParamInfo := by + unfold Kernel.Environment.get + rw [annotatedPiType_lookup_outParam] + rfl + +@[simp] private theorem annotatedPiType_get_family : + annotatedPiTypeKernelEnv.get ``AnnotatedPi = + .ok annotatedPiInfo := by + unfold Kernel.Environment.get + rw [annotatedPiType_lookup_family] + rfl + +@[simp] private theorem annotatedPi_checkLevelZero + (context : TypeChecker.Context) : + TypeChecker.Inner.checkLevel context .zero = .ok () := by + simp [TypeChecker.Inner.checkLevel, Level.getUndefParam, Level.forEach, + Level.hasParam_eq, Level.hasParam'] + rfl + +@[simp] private theorem annotatedPi_checkLevelSuccZero + (context : TypeChecker.Context) : + TypeChecker.Inner.checkLevel context (.succ .zero) = .ok () := by + simp [TypeChecker.Inner.checkLevel, Level.getUndefParam, Level.forEach, + Level.hasParam_eq, Level.hasParam'] + rfl + +open private mkLevelIMaxCore mkLevelMaxCore from Lean.Level in +@[simp] private theorem annotatedPi_mkLevelIMaxSuccZero : + mkLevelIMax' (.succ .zero) (.succ .zero) = .succ .zero := by + simp [mkLevelIMax', mkLevelIMaxCore, mkLevelMax', mkLevelMaxCore] + +private theorem annotatedPiExceptPure + {α} (a : α) : + (pure a : Except Kernel.Exception α) = .ok a := rfl + +@[simp] private theorem annotatedPiInferConstantOutParam + (lctx : LocalContext) : + TypeChecker.Inner.inferConstant + ({ env := annotatedPiTypeKernelEnv, lctx := lctx } : + TypeChecker.Context) + ``outParam [.succ .zero] false = + .ok (.forallE `α (.sort (.succ .zero)) + (.sort (.succ .zero)) .default) := by + unfold TypeChecker.Inner.inferConstant + rw [show annotatedPiTypeKernelEnv.get ``outParam = + .ok annotationOutParamInfo by exact annotatedPiType_get_outParam] + simp [annotationOutParamInfo, Bind.bind, Except.bind, + annotatedPiExceptPure, + ConstantInfo.levelParams, ConstantInfo.isUnsafe, + ConstantInfo.instantiateTypeLevelParams, + ConstantInfo.toConstantVal, + ConstantVal.instantiateTypeLevelParams, + Expr.instantiateLevelParams_eq, Expr.instantiateLevelParamsCore', + Level.substParams'] + +@[simp] private theorem annotatedPiInferConstantFamily + (lctx : LocalContext) : + TypeChecker.Inner.inferConstant + ({ env := annotatedPiTypeKernelEnv, lctx := lctx } : + TypeChecker.Context) + ``AnnotatedPi [] false = + .ok (.sort (.succ .zero)) := by + unfold TypeChecker.Inner.inferConstant + rw [show annotatedPiTypeKernelEnv.get ``AnnotatedPi = + .ok annotatedPiInfo by exact annotatedPiType_get_family] + rfl + +@[simp] private theorem annotatedPiInferConstantOutParamCandidate : + TypeChecker.Inner.inferConstant + annotatedPiCtorCandidateContext.toTypeChecker + ``outParam [.succ .zero] false = + .ok (.forallE `α (.sort (.succ .zero)) + (.sort (.succ .zero)) .default) := by + simpa [annotatedPiCtorCandidateContext, + AddInductive.Context.toTypeChecker] using + annotatedPiInferConstantOutParam ({} : LocalContext) + +@[simp] private theorem annotatedPiEnsureForall + (name dom body bi source methods context state) : + TypeChecker.Inner.ensureForallCore (.forallE name dom body bi) source + methods context state = + .ok (.forallE name dom body bi, state) := by + unfold TypeChecker.Inner.ensureForallCore + rfl + +@[simp] private theorem annotatedPiEnsureSort + (u source methods context state) : + TypeChecker.Inner.ensureSortCore (.sort u) source methods context state = + .ok (.sort u, state) := by + unfold TypeChecker.Inner.ensureSortCore + rfl + +@[simp] private theorem annotatedPiForall_bindingDomain + (name dom body bi) : + (Expr.forallE name dom body bi).bindingDomain! = dom := rfl + +@[simp] private theorem annotatedPiForall_bindingBody + (name dom body bi) : + (Expr.forallE name dom body bi).bindingBody! = body := rfl + +@[simp] private theorem annotatedPiSort_instantiate1' + (u arg) : + (Expr.sort u).instantiate1' arg = .sort u := rfl + +@[simp] private theorem annotatedPiConst_beq_sort + (name levels u) : + ((.const name levels : Expr) == .sort u) = false := by + change Expr.eqv (.const name levels) (.sort u) = false + rw [Expr.eqv_eq] + rfl + +@[simp] private theorem annotatedPiSort_beq_const + (u name levels) : + ((.sort u : Expr) == .const name levels) = false := by + change Expr.eqv (.sort u) (.const name levels) = false + rw [Expr.eqv_eq] + rfl + +@[simp] private theorem annotatedPiApp_beq_const + (fn arg name levels) : + ((.app fn arg : Expr) == .const name levels) = false := by + change Expr.eqv (.app fn arg) (.const name levels) = false + rw [Expr.eqv_eq] + rfl + +@[simp] private theorem annotatedPiForall_beq_const + (binderName dom body bi name levels) : + ((.forallE binderName dom body bi : Expr) == .const name levels) = + false := by + change Expr.eqv (.forallE binderName dom body bi) + (.const name levels) = false + rw [Expr.eqv_eq] + rfl + +@[simp] private theorem annotatedPiOutParam_beq_family : + ((.const ``outParam [.succ .zero] : Expr) == + .const ``AnnotatedPi []) = false := by + change Expr.eqv (.const ``outParam [.succ .zero]) + (.const ``AnnotatedPi []) = false + rw [Expr.eqv_eq] + rfl + +@[simp] private theorem annotatedPiFamilyCacheAfterForall + (cache : InferCache) (name : Name) (dom body result : Expr) + (bi : BinderInfo) : + (((cache.insert (.const ``AnnotatedPi []) (.sort (.succ .zero))).insert + (.forallE name dom body bi) result)[ + (.const ``AnnotatedPi [] : Expr)]?) = + some (.sort (.succ .zero)) := by + rw [Std.HashMap.getElem?_insert, + annotatedPiForall_beq_const] + exact Std.HashMap.getElem?_insert_self + +private def annotatedPiOutParamFnType : Expr := + .forallE `α (.sort (.succ .zero)) + (.sort (.succ .zero)) .default + +@[simp] private theorem annotatedPiOutParamFnType_bindingDomain : + annotatedPiOutParamFnType.bindingDomain! = + .sort (.succ .zero) := rfl + +@[simp] private theorem annotatedPiOutParamFnType_instantiatedBody : + annotatedPiOutParamFnType.bindingBody!.instantiate1 (.sort .zero) = + .sort (.succ .zero) := by + simp [annotatedPiOutParamFnType, Expr.bindingBody!, + Expr.instantiate1_eq, Expr.instantiate1'] + +@[simp] private theorem annotatedPiSort_notEagerReduce : + (Expr.sort .zero).isAppOfArity ``eagerReduce 2 = false := rfl + +private def annotatedPiOutParamFnState : TypeChecker.State := + { ({} : TypeChecker.State) with + inferTypeC := ({} : TypeChecker.State).inferTypeC.insert + (.const ``outParam [.succ .zero]) annotatedPiOutParamFnType } + +private def annotatedPiOutParamArgState : TypeChecker.State := + { annotatedPiOutParamFnState with + inferTypeC := annotatedPiOutParamFnState.inferTypeC.insert + (.sort .zero) (.sort (.succ .zero)) } + +private def annotatedPiWithEqvManager + (state : TypeChecker.State) (m : EquivManager) : + TypeChecker.State := + { state with eqvManager := m } + +private theorem annotatedPiIsDefEqSort + (fuel : Nat) + (context : TypeChecker.Context) + (initial : TypeChecker.State) : + TypeChecker.Inner.isDefEq + (.sort (.succ .zero)) (.sort (.succ .zero)) + (TypeChecker.Methods.withFuel fuel) context initial = + .ok (true, initial) := by + unfold TypeChecker.Inner.isDefEq + rw [if_pos (Expr.eqv_refl _)] + rfl + +private def annotatedPiCtorExpectedView : Expr := + match annotatedPiMkInfo.type with + | .forallE outerName (.forallE innerName _ innerBody innerInfo) + outerBody outerInfo => + .forallE outerName + (.forallE innerName (.sort .zero) innerBody innerInfo) + outerBody outerInfo + | source => source + +private def annotatedPiOuterName : Name := + .mkNum + (.mkStr + (.mkStr (.mkStr (.mkStr .anonymous "a") "_@") "_internal") + "_hyg") + 0 + +@[simp] private theorem annotatedPiFamilyType_noLooseBVars : + annotatedPiInfo.type.hasLooseBVars = false := by + rw [show annotatedPiInfo.type = .sort (.succ .zero) by rfl] + simp [annotatedPiInfo, Expr.hasLooseBVars, Expr.looseBVarRange'] + +@[simp] private theorem emptyCheckTypeCache_annotatedPiFamily : + (({} : TypeChecker.State).inferTypeC)[annotatedPiInfo.type]? = none := by + exact Std.HashMap.getElem?_empty + +@[simp] private theorem annotatedPiFamily_checkLevel : + TypeChecker.Inner.checkLevel + annotatedPiFamilyCandidateContext.toTypeChecker (.succ .zero) = + .ok () := by + simp [TypeChecker.Inner.checkLevel, annotatedPiFamilyCandidateContext, + AddInductive.Context.toTypeChecker, Level.getUndefParam, Level.forEach, + Level.hasParam_eq, Level.hasParam'] + rfl + +@[simp] private theorem annotatedPiRecMGet (methods context state) : + (get : TypeChecker.RecM TypeChecker.State) methods context state = + .ok (state, state) := rfl + +@[simp] private theorem annotatedPiRecMReadContext + (methods context state) : + (readThe TypeChecker.Context : TypeChecker.RecM TypeChecker.Context) + methods context state = + .ok (context, state) := rfl + +@[simp] private theorem annotatedPiRecMModify + (f : TypeChecker.State → TypeChecker.State) + (methods context state) : + (modify f : TypeChecker.RecM PUnit) methods context state = + .ok (.unit, f state) := rfl + +@[simp] private theorem annotatedPiRecMPure + {α} (a : α) (methods context state) : + (pure a : TypeChecker.RecM α) methods context state = + .ok (a, state) := rfl + +@[simp] private theorem annotatedPiRecMBind + {α β} (x : TypeChecker.RecM α) + (f : α → TypeChecker.RecM β) (methods context state) : + (x >>= f) methods context state = + match x methods context state with + | .error e => .error e + | .ok (a, state') => f a methods context state' := by + simp [Bind.bind, ReaderT.bind, StateT.bind, Except.bind] + cases h : x methods context state with + | error => rfl + | ok value => cases value; rfl + +@[simp] private theorem annotatedPiRecMLiftExceptOk + {α} (a : α) (methods context state) : + (liftM (.ok a : Except Kernel.Exception α) : + TypeChecker.RecM α) methods context state = + .ok (a, state) := rfl + +@[simp] private theorem annotatedPiGetNGen + (context : TypeChecker.Context) (state : TypeChecker.State) : + (getNGen : TypeChecker.M NameGenerator) context state = + .ok (state.ngen, state) := rfl + +@[simp] private theorem annotatedPiSetNGen + (ngen : NameGenerator) (context : TypeChecker.Context) + (state : TypeChecker.State) : + (setNGen ngen : TypeChecker.M PUnit) context state = + .ok (.unit, { state with ngen }) := rfl + +@[simp] private theorem annotatedPiMPure + {α} (a : α) (context : TypeChecker.Context) + (state : TypeChecker.State) : + (pure a : TypeChecker.M α) context state = + .ok (a, state) := rfl + +@[simp] private theorem annotatedPiRecMWithReader + {α} (f : LocalContext → LocalContext) + (x : TypeChecker.RecM α) (methods : TypeChecker.Methods) + (context : TypeChecker.Context) (state : TypeChecker.State) : + (MonadWithReaderOf.withReader (m := TypeChecker.RecM) f x) + methods context state = + x methods { context with lctx := f context.lctx } state := rfl + +private theorem annotatedPiWithLocalDecl + {α} (name : Name) (bi : BinderInfo) (ty : Expr) + (k : Expr → TypeChecker.RecM α) + (methods : TypeChecker.Methods) (context : TypeChecker.Context) + (state : TypeChecker.State) : + (withLocalDecl (m := TypeChecker.RecM) name bi ty k) + methods context state = + k (.fvar ⟨state.ngen.curr⟩) methods + { context with + lctx := context.lctx.mkLocalDecl + ⟨state.ngen.curr⟩ name ty bi } + { state with ngen := state.ngen.next } := rfl + +@[simp] private theorem annotatedPiInferTypeFuel + (n e inferOnly context state) : + TypeChecker.Inner.inferType e inferOnly + (TypeChecker.Methods.withFuel (n + 1)) context state = + TypeChecker.Inner.inferType' e inferOnly + (TypeChecker.Methods.withFuel n) context state := rfl + +@[simp] private theorem annotatedPiInferTypeFamilyCore + (n : Nat) (lctx : LocalContext) (state : TypeChecker.State) + (hcache : + state.inferTypeC[(.const ``AnnotatedPi [] : Expr)]? = none) : + TypeChecker.Inner.inferType' (.const ``AnnotatedPi []) false + (TypeChecker.Methods.withFuel n) + ({ env := annotatedPiTypeKernelEnv, lctx := lctx } : + TypeChecker.Context) + state = + .ok (.sort (.succ .zero), + { state with + inferTypeC := state.inferTypeC.insert + (.const ``AnnotatedPi []) (.sort (.succ .zero)) }) := by + unfold TypeChecker.Inner.inferType' + simp [Expr.hasLooseBVars, Expr.looseBVarRange', hcache, + Bind.bind, ReaderT.bind, StateT.bind, Except.bind] + +@[simp] private theorem annotatedPiInferTypeFamily + (n : Nat) (lctx : LocalContext) (state : TypeChecker.State) + (hcache : + state.inferTypeC[(.const ``AnnotatedPi [] : Expr)]? = none) : + TypeChecker.Inner.inferType (.const ``AnnotatedPi []) false + (TypeChecker.Methods.withFuel (n + 1)) + ({ env := annotatedPiTypeKernelEnv, lctx := lctx } : + TypeChecker.Context) + state = + .ok (.sort (.succ .zero), + { state with + inferTypeC := state.inferTypeC.insert + (.const ``AnnotatedPi []) (.sort (.succ .zero)) }) := + annotatedPiInferTypeFamilyCore n lctx state hcache + +@[simp] private theorem annotatedPiInferTypeFamilyCached + (n : Nat) (lctx : LocalContext) (state : TypeChecker.State) + (hcache : + state.inferTypeC[(.const ``AnnotatedPi [] : Expr)]? = + some (.sort (.succ .zero))) : + TypeChecker.Inner.inferType' (.const ``AnnotatedPi []) false + (TypeChecker.Methods.withFuel n) + ({ env := annotatedPiTypeKernelEnv, lctx := lctx } : + TypeChecker.Context) + state = + .ok (.sort (.succ .zero), state) := by + unfold TypeChecker.Inner.inferType' + simp [Expr.hasLooseBVars, Expr.looseBVarRange', hcache, + Bind.bind, ReaderT.bind, StateT.bind, Except.bind] + +@[simp] private theorem annotatedPiInferTypeFamilyAfterForall + (n : Nat) (lctx : LocalContext) (state : TypeChecker.State) + (name : Name) (dom body result : Expr) (bi : BinderInfo) : + let state' : TypeChecker.State := + { state with + inferTypeC := + (state.inferTypeC.insert + (.const ``AnnotatedPi []) (.sort (.succ .zero))).insert + (.forallE name dom body bi) result } + TypeChecker.Inner.inferType' (.const ``AnnotatedPi []) false + (TypeChecker.Methods.withFuel n) + ({ env := annotatedPiTypeKernelEnv, lctx := lctx } : + TypeChecker.Context) + state' = + .ok (.sort (.succ .zero), state') := by + dsimp only + apply annotatedPiInferTypeFamilyCached + exact annotatedPiFamilyCacheAfterForall + state.inferTypeC name dom body result bi + +private def annotatedPiFamilyCheckTypeState : TypeChecker.State := + { ({} : TypeChecker.State) with + inferTypeC := ({} : TypeChecker.State).inferTypeC.insert + (.sort (.succ .zero)) (.sort (.succ (.succ .zero))) } + +private theorem annotatedPiFamily_checkTypeInner : + TypeChecker.Inner.inferType annotatedPiInfo.type false + (TypeChecker.Methods.withFuel 10000) + annotatedPiFamilyCandidateContext.toTypeChecker + ({} : TypeChecker.State) = + .ok (.sort (.succ (.succ .zero)), + annotatedPiFamilyCheckTypeState) := by + change + TypeChecker.Inner.inferType' (.sort (.succ .zero)) false + (TypeChecker.Methods.withFuel 9999) + annotatedPiFamilyCandidateContext.toTypeChecker + ({} : TypeChecker.State) = + .ok (.sort (.succ (.succ .zero)), + annotatedPiFamilyCheckTypeState) + unfold TypeChecker.Inner.inferType' + simp [annotatedPiFamilyCheckTypeState, annotatedPiInfo, + Expr.hasLooseBVars, Expr.looseBVarRange', Bind.bind, ReaderT.bind, + StateT.bind, Except.bind] + +private theorem annotatedPiFamily_checkTypeM : + TypeChecker.M.run annotatedPiFamilyCandidateContext.env + annotatedPiFamilyCandidateContext.safety + annotatedPiFamilyCandidateContext.lctx + annotatedPiFamilyCandidateContext.lparams + annotatedPiFamilyCandidateContext.fuel + (TypeChecker.checkType annotatedPiInfo.type) = + .ok (.sort (.succ (.succ .zero))) := by + change + Except.map (fun x : Expr × TypeChecker.State => x.1) + (TypeChecker.Inner.inferType annotatedPiInfo.type false + (TypeChecker.Methods.withFuel 10000) + annotatedPiFamilyCandidateContext.toTypeChecker + ({} : TypeChecker.State)) = + .ok (.sort (.succ (.succ .zero))) + rw [annotatedPiFamily_checkTypeInner] + rfl + +private theorem annotatedPiFamily_whnfM : + TypeChecker.M.run annotatedPiFamilyCandidateContext.env + annotatedPiFamilyCandidateContext.safety + annotatedPiFamilyCandidateContext.lctx + annotatedPiFamilyCandidateContext.lparams + annotatedPiFamilyCandidateContext.fuel + (TypeChecker.whnf annotatedPiInfo.type) = + .ok annotatedPiInfo.type := by rfl + +private theorem annotatedPiCtor_checkTypeM : + TypeChecker.M.run annotatedPiCtorCandidateContext.env + annotatedPiCtorCandidateContext.safety + annotatedPiCtorCandidateContext.lctx + annotatedPiCtorCandidateContext.lparams + annotatedPiCtorCandidateContext.fuel + (TypeChecker.checkType annotatedPiMkInfo.type) = + .ok (.sort (.succ .zero)) := by + change + Except.map (fun x : Expr × TypeChecker.State => x.1) + (TypeChecker.Inner.inferType annotatedPiMkInfo.type false + (TypeChecker.Methods.withFuel 10000) + annotatedPiCtorCandidateContext.toTypeChecker + ({} : TypeChecker.State)) = + .ok (.sort (.succ .zero)) + rw [show annotatedPiMkInfo.type = + .forallE annotatedPiOuterName + (.forallE `p + (.app (.const ``outParam [.succ .zero]) (.sort .zero)) + (.const ``AnnotatedPi []) .default) + (.const ``AnnotatedPi []) .default by rfl] + change + Except.map (fun x : Expr × TypeChecker.State => x.1) + (TypeChecker.Inner.inferType' + (.forallE annotatedPiOuterName + (.forallE `p + (.app (.const ``outParam [.succ .zero]) (.sort .zero)) + (.const ``AnnotatedPi []) .default) + (.const ``AnnotatedPi []) .default) + false (TypeChecker.Methods.withFuel 9999) + annotatedPiCtorCandidateContext.toTypeChecker + ({} : TypeChecker.State)) = + .ok (.sort (.succ .zero)) + unfold TypeChecker.Inner.inferType' + simp [Expr.hasLooseBVars, Expr.looseBVarRange', + Expr.eqv_eq, Std.HashMap.getElem?_insert, + TypeChecker.Inner.inferType', + TypeChecker.Inner.inferForall, TypeChecker.Inner.inferForall.loop, + TypeChecker.Inner.inferApp, + Bind.bind, ReaderT.bind, StateT.bind, Except.bind] + rw [annotatedPiIsDefEqSort 9997] + simp [annotatedPiOutParamFnType, annotatedPiOutParamArgState, + annotatedPiOutParamFnState, Expr.bindingBody!, + Expr.instantiate1_eq, Expr.instantiate1', + annotatedPiWithLocalDecl, annotatedPiCtorCandidateContext, + AddInductive.Context.toTypeChecker, + Std.HashMap.getElem?_insert, + Bind.bind, ReaderT.bind, StateT.bind, Except.bind] + rw [annotatedPiInferTypeFamilyCached (hcache := by + apply annotatedPiFamilyCacheAfterForall)] + simp [Expr.sortLevel!, annotatedPi_mkLevelIMaxSuccZero] + rfl + +private theorem annotatedPiCtor_whnfM : + TypeChecker.M.run annotatedPiCtorCandidateContext.env + annotatedPiCtorCandidateContext.safety + annotatedPiCtorCandidateContext.lctx + annotatedPiCtorCandidateContext.lparams + annotatedPiCtorCandidateContext.fuel + (TypeChecker.whnf annotatedPiMkInfo.type) = + .ok annotatedPiMkInfo.type := by rfl + /-! ## Checker-produced alias normalization certificates -/ /-- Minimal kernel environment used to replay family-result WHNF without @@ -2309,7 +3192,8 @@ private def aliasFormerNormalizationKernelEnv : Kernel.Environment := private theorem aliasFormerNormalization_trEnv : TrEnv .safe aliasFormerNormalizationKernelEnv typeFamilyAliasEnv := by - simpa [TrEnv, aliasFormerNormalizationKernelEnv] using + simpa [TrEnv, aliasFormerNormalizationKernelEnv, + Kernel.Environment.ofConstants] using typeFamilyAlias_trEnv' private theorem aliasFormerNormalization_hasPrimitives : @@ -2378,91 +3262,20 @@ private def aliasFormerCtorNormalizationAddType : env_add := rfl map_add := rfl -private theorem aliasFormerCtorNormalization_trEnv' : - TrEnv' .safe aliasFormerTypeMap false aliasFormerTypeEnv := - .inductStaging aliasFormerCtorNormalizationAddType - (by - show typeFamilyAliasEnv.IsType aliasFormerRawType.uvars [] - aliasFormerRawType.type - refine ⟨.succ (.succ .zero), ?_⟩ - change typeFamilyAliasEnv.HasType 0 [] - (.const ``TypeFamilyAlias []) (.sort (.succ (.succ .zero))) - exact VEnv.HasType.const - (ci := (vconst(type_of% @TypeFamilyAlias) : VConstant)) - (ls := []) rfl (by simp) rfl) - typeFamilyAlias_trEnv' - private def aliasFormerCtorNormalizationKernelEnv : Kernel.Environment := - Kernel.Environment.ofConstants `_aliasFormerCtorNormalization + Kernel.Environment.ofConstants `_aliasFormerNormalization aliasFormerTypeMap -private theorem aliasFormerCtorNormalization_trEnv : - TrEnv .safe aliasFormerCtorNormalizationKernelEnv - aliasFormerTypeEnv := by - simpa [TrEnv, aliasFormerCtorNormalizationKernelEnv] using - aliasFormerCtorNormalization_trEnv' +private def aliasFormerCtorNormalizationRawContext : TypeChecker.Context where + env := aliasFormerCtorNormalizationKernelEnv + fuel := { whnf := 2 } -private theorem aliasFormerCtorNormalization_hasPrimitives : - VEnv.HasPrimitives aliasFormerTypeEnv := by - apply TypeChecker.VEnv.HasPrimitives.of_avoids - intro n hn - simp only [TypeChecker.reflectedPrimitiveNames, List.mem_cons, - List.not_mem_nil, or_false] at hn - rcases hn with rfl | rfl | rfl | rfl | rfl | rfl | rfl | rfl | - rfl | rfl | rfl | rfl | rfl | rfl | rfl | rfl | rfl | rfl | - rfl | rfl | rfl | rfl <;> - rfl - -private theorem aliasFormerCtorNormalization_safePrimitives : - aliasFormerCtorNormalizationKernelEnv.find? n = some ci → - Kernel.Environment.primitives.contains n → - ci.safety = .safe ∧ ci.levelParams = [] := by - intro hfind hprim - change aliasFormerTypeMap.find?' n = some ci at hfind - rw [aliasFormerTypeMap_wf.find?'_eq_find?, - aliasFormerTypeMap, typeFamilyAliasMap_wf.find?_insert] at hfind - split at hfind - · rename_i heq - simp at heq - subst n - simp [Kernel.Environment.primitives, NameSet.ofList] at hprim - simp +decide [NameSet.contains] at hprim - · rw [typeFamilyAliasMap, - SMap.WF.find?_insert (s := ({} : ConstMap)) SMap.WF.empty] at hfind - simp [SMap.find?] at hfind - obtain ⟨rfl, rfl⟩ := hfind - simp [Kernel.Environment.primitives, NameSet.ofList] at hprim - simp +decide [NameSet.contains] at hprim - -private def aliasFormerCtorNormalizationVEnvs : VEnvs where - venv _ := aliasFormerTypeEnv - -private theorem aliasFormerCtorNormalizationVEnvs_wf : - aliasFormerCtorNormalizationVEnvs.WF - aliasFormerCtorNormalizationKernelEnv where - tr := by - intro safety - change TrEnv' _ aliasFormerTypeMap false aliasFormerTypeEnv - exact aliasFormerCtorNormalization_trEnv'.sf_mono - DefinitionSafety.le_safe - hasPrimitives := aliasFormerCtorNormalization_hasPrimitives - safePrimitives := aliasFormerCtorNormalization_safePrimitives - mono := fun _ => .rfl - -private def aliasFormerCtorNormalizationContext : TypeChecker.VContext := - TypeChecker.VContext.mk' aliasFormerCtorNormalizationVEnvs_wf - (fuel := { whnf := 2 }) - -private def aliasFormerCtorNormalizationRawContext : TypeChecker.Context where - env := aliasFormerCtorNormalizationKernelEnv - fuel := { whnf := 2 } - -private def aliasFormerCtorCheckTypeState (state : TypeChecker.State) : - TypeChecker.State := - { state with - inferTypeC := state.inferTypeC.insert - (.const ``AliasFormer []) - (.const ``TypeFamilyAlias []) } +private def aliasFormerCtorCheckTypeState (state : TypeChecker.State) : + TypeChecker.State := + { state with + inferTypeC := state.inferTypeC.insert + (.const ``AliasFormer []) + (.const ``TypeFamilyAlias []) } /-- Insert only the raw `AliasRec` family into the replay environment. This is the exact staging at which constructor domains are normalized. -/ @@ -2487,7 +3300,8 @@ private def aliasRecNormalizationKernelEnv : Kernel.Environment := private theorem aliasRecNormalization_trEnv : TrEnv .safe aliasRecNormalizationKernelEnv aliasRecTypeEnv := by - simpa [TrEnv, aliasRecNormalizationKernelEnv] using + simpa [TrEnv, aliasRecNormalizationKernelEnv, + Kernel.Environment.ofConstants] using aliasRecNormalization_trEnv' private theorem aliasRecNormalization_hasPrimitives : @@ -2557,6 +3371,16 @@ private def aliasFormerCtorCandidateContext : AddInductive.Context where allowPrimitive := false fuel := { whnf := 2 } +/-- Exact kernel request indexed by the singleton normalization candidate. -/ +private def aliasFormerKernelCtor : Constructor where + name := aliasFormerMkInfo.name + type := aliasFormerMkInfo.type + +private def aliasFormerKernelType : InductiveType where + name := aliasFormerInfo.name + type := aliasFormerInfo.type + ctors := [aliasFormerKernelCtor] + private theorem aliasFormerNormalization_lookup : aliasFormerNormalizationKernelEnv.find? ``TypeFamilyAlias = some typeFamilyAliasInfo := by @@ -2975,12 +3799,27 @@ private theorem unfoldTypeFamilyAlias (methods state) : Expr.getAppFn, aliasFormerNormalizationRawContext, aliasFormerNormalization_lookup, Bind.bind, ReaderT.bind, StateT.bind, Except.bind, typeFamilyAliasInfo, - typeFamilyAliasKernelDef, ConstantInfo.hasValue, + typeFamilyAliasKernelDef, ConstantInfo.deltaValue?, + TypeChecker.Inner.instantiateDeltaValue, ConstantInfo.numLevelParams, ConstantInfo.instantiateValueLevelParams!, ConstantInfo.levelParams, ConstantInfo.value!, ConstantInfo.toConstantVal, Expr.instantiateLevelParams] +private theorem unfoldAliasFormer (methods state) : + TypeChecker.Inner.unfoldDefinition (.const ``AliasFormer []) + methods aliasFormerCtorNormalizationRawContext state = + .ok (none, state) := by + change + TypeChecker.Inner.unfoldDefinitionCore (.const ``AliasFormer []) + methods aliasFormerCtorNormalizationRawContext state = + .ok (none, state) + simp [TypeChecker.Inner.unfoldDefinitionCore, TypeChecker.Inner.isDelta, + Expr.getAppFn, aliasFormerCtorNormalizationRawContext, + aliasFormerCtorNormalization_lookup, Bind.bind, ReaderT.bind, + StateT.bind, Except.bind, aliasFormerInfo, + ConstantInfo.deltaValue?] + private theorem unfoldRecAliasInitial (methods) : TypeChecker.Inner.unfoldDefinition (.const ``RecAlias [.succ .zero]) @@ -2995,7 +3834,8 @@ private theorem unfoldRecAliasInitial (methods) : Expr.getAppFn, aliasRecNormalizationRawContext, aliasRecNormalization_lookup, Bind.bind, ReaderT.bind, StateT.bind, Except.bind, recAliasInfo, recAliasKernelDef, - ConstantInfo.hasValue, ConstantInfo.numLevelParams, + ConstantInfo.deltaValue?, TypeChecker.Inner.instantiateDeltaValue, + ConstantInfo.numLevelParams, ConstantInfo.instantiateValueLevelParams!, ConstantInfo.levelParams, ConstantInfo.value!, ConstantInfo.toConstantVal, Expr.instantiateLevelParams, recAliasWhnfKernelExpr, @@ -3046,6 +3886,13 @@ private theorem whnfLoopTypeFamilyAlias (methods state) : unfold TypeChecker.Inner.whnf'.loop simp +private theorem whnfLoopAliasFormer (methods state) : + TypeChecker.Inner.whnf'.loop (.const ``AliasFormer []) 2 + methods aliasFormerCtorNormalizationRawContext state = + .ok (.const ``AliasFormer [], state) := by + unfold TypeChecker.Inner.whnf'.loop + simp [unfoldAliasFormer] + private theorem whnfLoopRecAlias (methods) : TypeChecker.Inner.whnf'.loop (.const ``RecAlias [.succ .zero]) 2 @@ -3073,6 +3920,24 @@ theorem aliasFormerFamily_whnf : rw [whnfLoopTypeFamilyAlias] simp [Functor.map, StateT.map, Except.map] +/-- Constructor normalization is staged after inserting the raw family. The +family constant is opaque, so this exact checker run retains the constructor +type unchanged. -/ +theorem aliasFormerCtor_whnf : + ∃ state : TypeChecker.State, + TypeChecker.Inner.whnf' (.const ``AliasFormer []) + (TypeChecker.Methods.withFuel 9999) + aliasFormerCtorNormalizationRawContext + ({} : TypeChecker.State) = + .ok (.const ``AliasFormer [], state) := by + unfold TypeChecker.Inner.whnf' + simp + rw [show (if aliasFormerCtorNormalizationRawContext.eagerReduce then + aliasFormerCtorNormalizationRawContext.fuel.whnfEager + else aliasFormerCtorNormalizationRawContext.fuel.whnf) = 2 by rfl] + rw [whnfLoopAliasFormer] + simp [Functor.map, StateT.map, Except.map] + /-- The full non-inference-only checker run for the raw AliasFormer family type. The returned sort is recorded together with the checker's cache update, rather than supplied as an external Theory premise. -/ @@ -3084,8 +3949,11 @@ theorem aliasFormerFamily_checkType : ({} : TypeChecker.State) = .ok (.sort (.succ (.succ .zero)), state) := by exact ⟨aliasFormerCheckTypeState {}, by - simpa [aliasFormerInfo, aliasFormerNormalizationContext, - TypeChecker.VContext.mk', aliasFormerNormalizationRawContext] using + simpa [aliasFormerInfo, ConstantInfo.type, + ConstantInfo.toConstantVal, + aliasFormerNormalizationContext, + TypeChecker.VContext.mk', TypeChecker.MLCtx.lctx, + aliasFormerNormalizationRawContext] using checkTypeTypeFamilyAlias⟩ /-- The exact full checker run for the actual AliasFormer constructor type, @@ -3095,12 +3963,14 @@ theorem aliasFormerCtor_checkType : ∃ state : TypeChecker.State, TypeChecker.Inner.inferType aliasFormerMkInfo.type false (TypeChecker.Methods.withFuel 9999) - aliasFormerCtorNormalizationContext.toContext + aliasFormerCtorCandidateContext.toTypeChecker ({} : TypeChecker.State) = .ok (.const ``TypeFamilyAlias [], state) := by exact ⟨aliasFormerCtorCheckTypeState {}, by - simpa [aliasFormerMkInfo, aliasFormerCtorNormalizationContext, - TypeChecker.VContext.mk', + simpa [aliasFormerMkInfo, ConstantInfo.type, + ConstantInfo.toConstantVal, + aliasFormerCtorCandidateContext, + AddInductive.Context.toTypeChecker, aliasFormerCtorNormalizationRawContext] using checkTypeAliasFormer⟩ @@ -3166,624 +4036,3621 @@ private theorem aliasFormerCtor_checkTypeM : rw [checkTypeAliasFormerCandidate] rfl -private def aliasFormerFamilyCandidateStep : - AddInductive.CandidateWhnfStep where - context := aliasFormerCandidateContext - source := aliasFormerInfo.type - result := .sort (.succ .zero) - -private theorem aliasFormerFamilyCandidateStep_valid : - aliasFormerFamilyCandidateStep.Valid := by +private theorem aliasFormerCtor_whnfM : + TypeChecker.M.run aliasFormerCtorNormalizationKernelEnv .safe {} [] + { whnf := 2 } (TypeChecker.whnf aliasFormerMkInfo.type) = + .ok (.const ``AliasFormer []) := by change - TypeChecker.M.run aliasFormerNormalizationKernelEnv .safe {} [] - { whnf := 2 } (TypeChecker.whnf aliasFormerInfo.type) = - .ok (.sort (.succ .zero)) - exact aliasFormerFamily_whnfM + Except.map (fun x : Expr × TypeChecker.State => x.1) + (TypeChecker.Inner.whnf' + (.const ``AliasFormer []) + (TypeChecker.Methods.withFuel 9999) + aliasFormerCtorNormalizationRawContext ({} : TypeChecker.State)) = + Except.ok (.const ``AliasFormer []) + obtain ⟨state, hrun⟩ := aliasFormerCtor_whnf + rw [hrun] + rfl -private def aliasFormerFamilyCheckTypeStep : - AddInductive.CandidateCheckTypeStep where - context := aliasFormerCandidateContext - source := aliasFormerInfo.type - inferred := .sort (.succ (.succ .zero)) +private def annotatedPiRawDomainKernel : Expr := + .app (.const ``outParam [.succ .zero]) (.sort .zero) -private theorem aliasFormerFamilyCheckTypeStep_valid : - aliasFormerFamilyCheckTypeStep.Valid := by - change - TypeChecker.M.run aliasFormerNormalizationKernelEnv .safe {} [] - { whnf := 2 } (TypeChecker.checkType aliasFormerInfo.type) = - .ok (.sort (.succ (.succ .zero))) - exact aliasFormerFamily_checkTypeM +private def annotatedPiInnerKernel : Expr := + .forallE `p annotatedPiRawDomainKernel + (.const ``AnnotatedPi []) .default -private def aliasFormerCtorCheckTypeStep : - AddInductive.CandidateCheckTypeStep where - context := aliasFormerCtorCandidateContext - source := aliasFormerMkInfo.type - inferred := .const ``TypeFamilyAlias [] +@[simp] private theorem annotatedPiRawDomain_getAppFn : + annotatedPiRawDomainKernel.getAppFn = + .const ``outParam [.succ .zero] := rfl -private theorem aliasFormerCtorCheckTypeStep_valid : - aliasFormerCtorCheckTypeStep.Valid := by - change - TypeChecker.M.run aliasFormerCtorNormalizationKernelEnv .safe {} [] - { whnf := 2 } (TypeChecker.checkType aliasFormerMkInfo.type) = - .ok (.const ``TypeFamilyAlias []) - exact aliasFormerCtor_checkTypeM +@[simp] private theorem annotatedPiRawDomain_getAppRevArgs : + annotatedPiRawDomainKernel.getAppRevArgs = #[.sort .zero] := rfl -private def aliasFormerFamilyCandidate : - AddInductive.CandidateExpr aliasFormerInfo.type := - ⟨aliasFormerCandidateContext, - .terminal aliasFormerCandidateContext aliasFormerInfo.type - (.sort (.succ (.succ .zero))) (.sort (.succ .zero)) - aliasFormerFamilyCheckTypeStep_valid - aliasFormerFamilyCandidateStep_valid⟩ +private def annotatedPiOutParamWhnfKernelExpr : Expr := + annotationOutParamInfo.instantiateValueLevelParams! [.succ .zero] -/-- The generic candidate traversal retains the exact context, input, and -result of the actual AliasFormer family WHNF observation. -/ -theorem aliasFormerFamily_candidateTrace : - AddInductive.buildCandidateExpr aliasFormerInfo.type - aliasFormerCandidateContext = - .ok aliasFormerFamilyCandidate := by - apply AddInductive.buildCandidateExpr_of_whnf_nonForall - · decide - · rfl +private theorem annotatedPiOutParamWhnfKernelExpr_eq : + annotatedPiOutParamWhnfKernelExpr = + .lam `α (.sort (.succ .zero)) (.bvar 0) .default := by + simp [annotatedPiOutParamWhnfKernelExpr, annotationOutParamInfo, + outParamKernelDef, ConstantInfo.instantiateValueLevelParams!, + ConstantInfo.levelParams, ConstantInfo.value!, + ConstantInfo.toConstantVal, + Expr.instantiateLevelParams_eq, Expr.instantiateLevelParamsCore', + Level.substParams'] -/-- Erasing the retained trace produces the expected AliasFormer analysis -view at the same checker boundary. -/ -theorem aliasFormerFamily_candidate : - AddInductive.normalizeCandidateExpr aliasFormerInfo.type - aliasFormerCandidateContext = - .ok (.sort (.succ .zero)) := by - apply AddInductive.normalizeCandidateExpr_of_whnf_nonForall - · decide - · simpa [aliasFormerCandidateContext] using - aliasFormerFamily_checkTypeM - · simpa [aliasFormerCandidateContext] using - aliasFormerFamily_whnfM - · rfl +private def annotatedPiOutParamUnfoldState (state : TypeChecker.State) : + TypeChecker.State := + { state with + unfold := state.unfold.insert + (.const ``outParam [.succ .zero]) + annotatedPiOutParamWhnfKernelExpr } -private def aliasRecFieldFnType : Expr := - .forallE `α (.sort (.succ .zero)) - (.sort (.succ .zero)) .default +private def annotatedPiDomainBetaKernel : Expr := + .app annotatedPiOutParamWhnfKernelExpr (.sort .zero) -@[simp] private theorem aliasRecFieldFnType_isForall : - aliasRecFieldFnType.isForall = true := rfl +private def annotatedPiDomainBetaState (state : TypeChecker.State) : + TypeChecker.State := + { state with + whnfCoreCache := state.whnfCoreCache.insert + annotatedPiDomainBetaKernel (.sort .zero) } + +@[simp] private theorem annotatedPiType_quotInit : + annotatedPiTypeKernelEnv.quotInit = false := rfl + +private theorem annotatedPiInductiveReduceRecDomain + {m : Type → Type} [Monad m] + (whnf inferType : Expr → m Expr) + (isDefEq : Expr → Expr → m Bool) : + inductiveReduceRec annotatedPiTypeKernelEnv annotatedPiRawDomainKernel + whnf inferType isDefEq = + pure none := by + unfold inductiveReduceRec + rw [show annotatedPiRawDomainKernel.getAppFn = + .const ``outParam [.succ .zero] by rfl] + simp only + rw [annotatedPiType_lookup_outParam] + rfl -@[simp] private theorem aliasRecFieldFnType_bindingDomain : - aliasRecFieldFnType.bindingDomain! = - .sort (.succ .zero) := rfl +private theorem annotatedPiReduceRecursorDomain + (methods state) (cheapProj : Bool := false) : + TypeChecker.Inner.reduceRecursor annotatedPiRawDomainKernel + (cheapRec := false) (cheapProj := cheapProj) + methods annotatedPiCtorCandidateContext.toTypeChecker state = + .ok (none, state) := by + unfold TypeChecker.Inner.reduceRecursor + simp only [normalizationRecMBind, normalizationRecMGetEnv] + simp only [annotatedPiCtorCandidateContext, + AddInductive.Context.toTypeChecker] + rw [annotatedPiType_quotInit] + simp only [Bool.false_eq_true, if_false, normalizationRecMPure] + rw [annotatedPiInductiveReduceRecDomain] + rfl -@[simp] private theorem aliasRecFieldFnType_instantiatedBody : - aliasRecFieldFnType.bindingBody!.instantiate1 - (.const ``AliasRec []) = - .sort (.succ .zero) := by - simp [aliasRecFieldFnType, Expr.bindingBody!, - Expr.instantiate1_eq, - Expr.instantiate1'] +@[simp] private theorem annotatedPiWhnfCoreOutParamConst (n state) : + TypeChecker.Inner.whnfCore + (.const ``outParam [.succ .zero]) false false + (TypeChecker.Methods.withFuel (n + 1)) + annotatedPiCtorCandidateContext.toTypeChecker state = + .ok (.const ``outParam [.succ .zero], state) := by + rfl -@[simp] private theorem aliasRecFamily_notEagerReduce : - (Expr.const ``AliasRec []).isAppOfArity ``eagerReduce 2 = - false := rfl +private theorem annotatedPiWhnfCoreDomainInitial (n) : + TypeChecker.Inner.whnfCore' annotatedPiRawDomainKernel + (cheapRec := false) (cheapProj := false) + (TypeChecker.Methods.withFuel (n + 1)) + annotatedPiCtorCandidateContext.toTypeChecker + ({} : TypeChecker.State) = + .ok (annotatedPiRawDomainKernel, ({} : TypeChecker.State)) := by + change + TypeChecker.Inner.whnfCore' + (.app (.const ``outParam [.succ .zero]) (.sort .zero)) + (cheapRec := false) (cheapProj := false) + (TypeChecker.Methods.withFuel (n + 1)) + annotatedPiCtorCandidateContext.toTypeChecker + ({} : TypeChecker.State) = + .ok (.app (.const ``outParam [.succ .zero]) (.sort .zero), + ({} : TypeChecker.State)) + unfold TypeChecker.Inner.whnfCore' + simp only [normalizationRecMPure, normalizationRecMBind, + normalizationRecMGet, Std.HashMap.getElem?_empty] + rw [Expr.withRevApp_eq] + simp only [normalizationRecMBind] + rw [show + (Expr.app (.const ``outParam [.succ .zero]) + (.sort .zero)).getAppFn = + .const ``outParam [.succ .zero] by rfl] + rw [annotatedPiWhnfCoreOutParamConst n ({} : TypeChecker.State)] + simp [annotatedPiRawDomainKernel, annotatedPiReduceRecursorDomain, + Expr.eqv_eq, + Bind.bind, ReaderT.bind, StateT.bind, Except.bind] + rw [show + .app (.const ``outParam [.succ .zero]) (.sort .zero) = + annotatedPiRawDomainKernel by rfl] + rw [annotatedPiReduceRecursorDomain] + rfl -private def aliasRecFieldFnState (state : TypeChecker.State) : - TypeChecker.State := - { state with - inferTypeC := state.inferTypeC.insert - (.const ``RecAlias [.succ .zero]) aliasRecFieldFnType } +private theorem annotatedPiUnfoldOutParamCoreInitial (methods) : + TypeChecker.Inner.unfoldDefinitionCore + (.const ``outParam [.succ .zero]) + methods annotatedPiCtorCandidateContext.toTypeChecker + ({} : TypeChecker.State) = + .ok (some annotatedPiOutParamWhnfKernelExpr, + annotatedPiOutParamUnfoldState {}) := by + simp [TypeChecker.Inner.unfoldDefinitionCore, TypeChecker.Inner.isDelta, + Expr.getAppFn, annotatedPiCtorCandidateContext, + AddInductive.Context.toTypeChecker, annotatedPiType_lookup_outParam, + Bind.bind, ReaderT.bind, StateT.bind, Except.bind, + annotationOutParamInfo, outParamKernelDef, ConstantInfo.deltaValue?, + TypeChecker.Inner.instantiateDeltaValue, + ConstantInfo.numLevelParams, + ConstantInfo.instantiateValueLevelParams!, ConstantInfo.levelParams, + ConstantInfo.value!, ConstantInfo.toConstantVal, + Expr.instantiateLevelParams, annotatedPiOutParamWhnfKernelExpr, + annotatedPiOutParamUnfoldState] + +private theorem annotatedPiUnfoldDomainInitial (methods) : + TypeChecker.Inner.unfoldDefinition annotatedPiRawDomainKernel + methods annotatedPiCtorCandidateContext.toTypeChecker + ({} : TypeChecker.State) = + .ok (some annotatedPiDomainBetaKernel, + annotatedPiOutParamUnfoldState {}) := by + change + TypeChecker.Inner.unfoldDefinition + (.app (.const ``outParam [.succ .zero]) (.sort .zero)) + methods annotatedPiCtorCandidateContext.toTypeChecker + ({} : TypeChecker.State) = + .ok (some annotatedPiDomainBetaKernel, + annotatedPiOutParamUnfoldState {}) + unfold TypeChecker.Inner.unfoldDefinition + simp only [Expr.isApp] + rw [if_pos True.intro] + rw [show + (Expr.app (.const ``outParam [.succ .zero]) + (.sort .zero)).getAppFn = + .const ``outParam [.succ .zero] by rfl] + simp only [normalizationRecMBind] + rw [annotatedPiUnfoldOutParamCoreInitial] + rw [show + (Expr.app (.const ``outParam [.succ .zero]) + (.sort .zero)).getAppRevArgs = #[.sort .zero] by rfl] + simp only [normalizationRecMPure] + rw [Expr.mkAppRevRange_eq + (l₁ := []) (l₂ := [.sort .zero]) (l₃ := []) + (by simp) (by rfl) (by rfl)] + rfl -private def aliasRecFieldArgState (state : TypeChecker.State) : - TypeChecker.State := - { state with - inferTypeC := state.inferTypeC.insert - (.const ``AliasRec []) (.sort (.succ .zero)) } +@[simp] private theorem annotatedPiWhnfCoreOutParamIdentity (n state) : + TypeChecker.Inner.whnfCore + (.lam `α (.sort (.succ .zero)) (.bvar 0) .default) + false false (TypeChecker.Methods.withFuel (n + 1)) + annotatedPiCtorCandidateContext.toTypeChecker state = + .ok (.lam `α (.sort (.succ .zero)) (.bvar 0) .default, + state) := by + rfl -private def aliasRecFieldResultState (state : TypeChecker.State) : - TypeChecker.State := - { state with - inferTypeC := state.inferTypeC.insert - aliasRecFieldKernelExpr (.sort (.succ .zero)) } +@[simp] private theorem annotatedPiWhnfCoreDomainSort (n state) : + TypeChecker.Inner.whnfCore (.sort .zero) false false + (TypeChecker.Methods.withFuel (n + 1)) + annotatedPiCtorCandidateContext.toTypeChecker state = + .ok (.sort .zero, state) := by + rfl + +@[simp] private theorem annotatedPiSort_mkAppRevRangeZero : + (Expr.sort .zero).mkAppRevRange 0 0 #[.sort .zero] = + .sort .zero := by + rw [Expr.mkAppRevRange_eq + (l₁ := []) (l₂ := []) (l₃ := [.sort .zero]) + (by simp) (by rfl) (by rfl)] + rfl -@[simp] private theorem aliasRecFieldArgState_eqvManager : - (aliasRecFieldArgState - (aliasRecFieldFnState {})).eqvManager = {} := rfl +private theorem annotatedPiWhnfCoreDomainBeta (n) : + TypeChecker.Inner.whnfCore' annotatedPiDomainBetaKernel + (cheapRec := false) (cheapProj := false) + (TypeChecker.Methods.withFuel (n + 1)) + annotatedPiCtorCandidateContext.toTypeChecker + (annotatedPiOutParamUnfoldState {}) = + .ok (.sort .zero, + annotatedPiDomainBetaState + (annotatedPiOutParamUnfoldState {})) := by + rw [annotatedPiDomainBetaKernel, + annotatedPiOutParamWhnfKernelExpr_eq] + unfold TypeChecker.Inner.whnfCore' + simp only [normalizationRecMPure, normalizationRecMBind, + normalizationRecMGet, annotatedPiOutParamUnfoldState, + Std.HashMap.getElem?_empty] + rw [Expr.withRevApp_eq] + simp only [normalizationRecMBind] + rw [show + (Expr.app + (.lam `α (.sort (.succ .zero)) (.bvar 0) .default) + (.sort .zero)).getAppFn = + .lam `α (.sort (.succ .zero)) (.bvar 0) .default by rfl] + rw [annotatedPiWhnfCoreOutParamIdentity] + rw [show + (Expr.app + (.lam `α (.sort (.succ .zero)) (.bvar 0) .default) + (.sort .zero)).getAppRevArgs = #[.sort .zero] by rfl] + simp [TypeChecker.Inner.whnfCore'.loop, + TypeChecker.Inner.whnfCore'.loop.cont, + TypeChecker.Inner.whnfCore'.save, + annotatedPiDomainBetaKernel, + annotatedPiOutParamWhnfKernelExpr_eq, + annotatedPiOutParamUnfoldState, annotatedPiDomainBetaState, + Expr.instantiateRange, Expr.instantiateRevRange, + Expr.instantiate1_eq, Expr.instantiate1', Expr.eqv_eq, + Bind.bind, ReaderT.bind, StateT.bind, Except.bind] -@[simp] private theorem aliasRecFieldFnCache_miss : - (({} : Lean4Lean.InferCache).insert - (Expr.const ``RecAlias [.succ .zero]) aliasRecFieldFnType)[ - Expr.const ``AliasRec []]? = none := by - rw [Std.HashMap.getElem?_insert] - have h : - (Expr.const ``RecAlias [.succ .zero] == - Expr.const ``AliasRec []) = false := by - change Expr.eqv - (Expr.const ``RecAlias [.succ .zero]) - (Expr.const ``AliasRec []) = false - rw [Expr.eqv_eq] - rfl - rw [h] - exact Std.HashMap.getElem?_empty +@[simp] private theorem annotatedPiReduceNativeDomain + (env methods state) : + (liftM (TypeChecker.Inner.reduceNative env annotatedPiRawDomainKernel) : + TypeChecker.RecM (Option Expr)) + methods annotatedPiCtorCandidateContext.toTypeChecker state = + .ok (none, state) := by + rfl -@[simp] private theorem aliasRecFieldFnState_cache_miss : - (aliasRecFieldFnState {}).inferTypeC[ - Expr.const ``AliasRec []]? = none := by +@[simp] private theorem annotatedPiReduceNatDomain (methods state) : + TypeChecker.Inner.reduceNat annotatedPiRawDomainKernel + methods annotatedPiCtorCandidateContext.toTypeChecker state = + .ok (none, state) := by change - (({} : Lean4Lean.InferCache).insert - (Expr.const ``RecAlias [.succ .zero]) aliasRecFieldFnType)[ - Expr.const ``AliasRec []]? = none - exact aliasRecFieldFnCache_miss + TypeChecker.Inner.reduceNat + (.app (.const ``outParam [.succ .zero]) (.sort .zero)) + methods annotatedPiCtorCandidateContext.toTypeChecker state = + .ok (none, state) + simp [TypeChecker.Inner.reduceNat, Expr.getAppNumArgs_eq, + Expr.getAppArgsRevList, Expr.appFn!, Expr.eqv_const] + +private theorem annotatedPiWhnfLoopDomain : + TypeChecker.Inner.whnf'.loop annotatedPiRawDomainKernel 100000 + (TypeChecker.Methods.withFuel 9999) + annotatedPiCtorCandidateContext.toTypeChecker + ({} : TypeChecker.State) = + .ok (.sort .zero, + annotatedPiDomainBetaState + (annotatedPiOutParamUnfoldState {})) := by + rw [show 100000 = 99999 + 1 by rfl] + unfold TypeChecker.Inner.whnf'.loop + rw [show 9999 = 9998 + 1 by rfl] + simp only [normalizationRecMBind, normalizationRecMGetEnv] + rw [annotatedPiWhnfCoreDomainInitial] + simp only [normalizationRecMBind] + rw [annotatedPiReduceNativeDomain] + simp only [normalizationRecMBind, normalizationRecMPure] + rw [annotatedPiReduceNatDomain] + simp only [normalizationRecMBind, normalizationRecMPure] + rw [annotatedPiUnfoldDomainInitial] + simp only [normalizationRecMBind, normalizationRecMPure] + unfold TypeChecker.Inner.whnf'.loop + simp only [normalizationRecMBind, normalizationRecMGetEnv] + rw [annotatedPiWhnfCoreDomainBeta] + simp only [normalizationRecMBind] + rw [normalizationReduceNativeSort] + simp only [normalizationRecMBind, normalizationRecMPure] + rw [normalizationReduceNatSort] + simp only [normalizationRecMBind, normalizationRecMPure] + rw [normalizationUnfoldSort] + rfl + +private theorem annotatedPiWhnfLoopDomainConcrete : + TypeChecker.Inner.whnf'.loop + (.app (.const ``outParam [.succ .zero]) (.sort .zero)) 100000 + (TypeChecker.Methods.withFuel 9999) + annotatedPiCtorCandidateContext.toTypeChecker + ({} : TypeChecker.State) = + .ok (.sort .zero, + annotatedPiDomainBetaState + (annotatedPiOutParamUnfoldState {})) := by + exact annotatedPiWhnfLoopDomain + +private theorem annotatedPiDomain_checkTypeM : + TypeChecker.M.run annotatedPiCtorCandidateContext.env + annotatedPiCtorCandidateContext.safety + annotatedPiCtorCandidateContext.lctx + annotatedPiCtorCandidateContext.lparams + annotatedPiCtorCandidateContext.fuel + (TypeChecker.checkType annotatedPiRawDomainKernel) = + .ok (.sort (.succ .zero)) := by + change + Except.map (fun x : Expr × TypeChecker.State => x.1) + (TypeChecker.Inner.inferType annotatedPiRawDomainKernel false + (TypeChecker.Methods.withFuel 10000) + annotatedPiCtorCandidateContext.toTypeChecker + ({} : TypeChecker.State)) = + .ok (.sort (.succ .zero)) + change + Except.map (fun x : Expr × TypeChecker.State => x.1) + (TypeChecker.Inner.inferType' annotatedPiRawDomainKernel false + (TypeChecker.Methods.withFuel 9999) + annotatedPiCtorCandidateContext.toTypeChecker + ({} : TypeChecker.State)) = + .ok (.sort (.succ .zero)) + unfold annotatedPiRawDomainKernel TypeChecker.Inner.inferType' + simp [Expr.hasLooseBVars, Expr.looseBVarRange', + TypeChecker.Inner.inferType', TypeChecker.Inner.inferApp, + Bind.bind, ReaderT.bind, StateT.bind, Except.bind] + rw [annotatedPiIsDefEqSort 9999] + simp [annotatedPiOutParamFnType, annotatedPiOutParamArgState, + annotatedPiOutParamFnState, Expr.bindingBody!, + Expr.instantiate1_eq, Expr.instantiate1', + Bind.bind, ReaderT.bind, StateT.bind, Except.bind] + rfl + +private theorem annotatedPiDomain_whnfM : + TypeChecker.M.run annotatedPiCtorCandidateContext.env + annotatedPiCtorCandidateContext.safety + annotatedPiCtorCandidateContext.lctx + annotatedPiCtorCandidateContext.lparams + annotatedPiCtorCandidateContext.fuel + (TypeChecker.whnf annotatedPiRawDomainKernel) = + .ok (.sort .zero) := by + change + Except.map (fun x : Expr × TypeChecker.State => x.1) + (TypeChecker.Inner.whnf' annotatedPiRawDomainKernel + (TypeChecker.Methods.withFuel 9999) + annotatedPiCtorCandidateContext.toTypeChecker + ({} : TypeChecker.State)) = + .ok (.sort .zero) + rw [show annotatedPiRawDomainKernel = + .app (.const ``outParam [.succ .zero]) (.sort .zero) by rfl] + unfold TypeChecker.Inner.whnf' + simp + rw [show + (if annotatedPiCtorCandidateContext.toTypeChecker.eagerReduce then + annotatedPiCtorCandidateContext.toTypeChecker.fuel.whnfEager + else annotatedPiCtorCandidateContext.toTypeChecker.fuel.whnf) = + 100000 by rfl] + rw [annotatedPiWhnfLoopDomainConcrete] + simp [Functor.map, StateT.map, Except.map] + +private theorem annotatedPiPtrDomainSortFalse : + ptrEqExpr annotatedPiRawDomainKernel (.sort .zero) = false := by + apply Bool.eq_false_iff.mpr + intro h + have heq := ptrEqExpr_eq h + cases heq + +@[simp] private theorem annotatedPiApp_beq_sort + (fn arg : Expr) (u : Level) : + ((.app fn arg : Expr) == .sort u) = false := by + change Expr.eqv (.app fn arg) (.sort u) = false + rw [Expr.eqv_eq] + rfl -private theorem aliasRecEmptyEqv_isEquivSort : +@[simp] private theorem annotatedPiUnionFind_coe_root + (self : Batteries.UnionFind) (x : Fin self.size) : + (self.root x : Nat) = self.rootD x := by + rw [Batteries.UnionFind.rootD, dif_pos x.isLt] + +private theorem annotatedPiEmptyEqv_isEquivDomainSort : ∃ m : EquivManager, EquivManager.isEquiv true - (.sort (.succ .zero)) (.sort (.succ .zero)) + annotatedPiRawDomainKernel (.sort .zero) ({} : EquivManager) = - (true, m) := by + (false, m) := by let r := EquivManager.isEquiv true - (.sort (.succ .zero)) (.sort (.succ .zero)) + annotatedPiRawDomainKernel (.sort .zero) ({} : EquivManager) refine ⟨r.2, Prod.ext ?_ rfl⟩ dsimp only [r] rw [EquivManager.isEquiv.eq_def] - by_cases h : - ptrEqExpr (.sort (.succ .zero)) (.sort (.succ .zero)) = true - · rw [if_pos h] - rfl - · rw [if_neg h] - simp [Expr.isBVar, StateT.pure, pure, Bind.bind, StateT.bind, - EquivManager.toNode, EquivManager.find, EquivManager.merge] - -private def aliasRecWithEqvManager - (state : TypeChecker.State) (m : EquivManager) : - TypeChecker.State := - { state with eqvManager := m } - -private theorem quickIsDefEqSort + simp only [annotatedPiPtrDomainSortFalse, Bool.false_eq_true, + if_false, Bool.true_and] + split + · rfl + · have hroot (n : Nat) : + ({} : Batteries.UnionFind).rootD n = n := by rfl + simp [annotatedPiRawDomainKernel, Expr.isBVar, + annotatedPiApp_beq_sort, + StateT.pure, pure, Bind.bind, StateT.bind, + EquivManager.toNode, EquivManager.find, + EquivManager.merge, hroot] + +private theorem annotatedPiQuickIsDefEqDomainInitial (methods : TypeChecker.Methods) - (context : TypeChecker.Context) - (initial : TypeChecker.State) - (heqv : initial.eqvManager = {}) : - ∃ state : TypeChecker.State, + (context : TypeChecker.Context) : + ∃ m : EquivManager, TypeChecker.Inner.quickIsDefEq - (.sort (.succ .zero)) (.sort (.succ .zero)) true - methods context initial = - .ok (.true, state) := by - obtain ⟨m, hm⟩ := aliasRecEmptyEqv_isEquivSort - refine ⟨aliasRecWithEqvManager initial m, ?_⟩ + annotatedPiRawDomainKernel (.sort .zero) true + methods context ({} : TypeChecker.State) = + .ok (.undef, + annotatedPiWithEqvManager ({} : TypeChecker.State) m) := by + obtain ⟨m, hm⟩ := annotatedPiEmptyEqv_isEquivDomainSort + refine ⟨m, ?_⟩ + rw [show annotatedPiRawDomainKernel = + .app (.const ``outParam [.succ .zero]) (.sort .zero) by rfl] + at hm ⊢ unfold TypeChecker.Inner.quickIsDefEq simp [modifyGet, MonadStateOf.modifyGet, monadLift, MonadLift.monadLift, StateT.modifyGet, pure, ReaderT.pure, - StateT.pure, Except.pure, heqv, hm, aliasRecWithEqvManager, + StateT.pure, Except.pure, hm, annotatedPiWithEqvManager, Bind.bind, ReaderT.bind, StateT.bind, Except.bind] -private theorem isDefEqCoreSort - (methods : TypeChecker.Methods) - (context : TypeChecker.Context) - (initial : TypeChecker.State) - (heqv : initial.eqvManager = {}) : - ∃ state : TypeChecker.State, - TypeChecker.Inner.isDefEqCore' - (.sort (.succ .zero)) (.sort (.succ .zero)) - methods context initial = - .ok (true, state) := by - obtain ⟨state, hr⟩ := - quickIsDefEqSort methods context initial heqv - refine ⟨state, ?_⟩ - unfold TypeChecker.Inner.isDefEqCore' - simp only [Bind.bind, ReaderT.bind, StateT.bind, Except.bind] - rw [hr] +@[simp] private theorem annotatedPiWhnfCoreOutParamConstCheap + (m : EquivManager) : + TypeChecker.Inner.whnfCore + (.const ``outParam [.succ .zero]) false true + (TypeChecker.Methods.withFuel 9998) + annotatedPiCtorCandidateContext.toTypeChecker + ({ eqvManager := m } : TypeChecker.State) = + .ok (.const ``outParam [.succ .zero], + ({ eqvManager := m } : TypeChecker.State)) := by rfl -private def aliasRecAfterAddEquiv - (state : TypeChecker.State) : TypeChecker.State := - { state with - eqvManager := state.eqvManager.addEquiv - (.sort (.succ .zero)) (.sort (.succ .zero)) } - -private theorem isDefEqSort - (context : TypeChecker.Context) - (initial : TypeChecker.State) - (heqv : initial.eqvManager = {}) : - ∃ state : TypeChecker.State, - TypeChecker.Inner.isDefEq - (.sort (.succ .zero)) (.sort (.succ .zero)) - (TypeChecker.Methods.withFuel 9998) context initial = - .ok (true, state) := by - obtain ⟨state, hr⟩ := - isDefEqCoreSort (TypeChecker.Methods.withFuel 9997) - context initial heqv - have hr' : - TypeChecker.Inner.isDefEqCore - (.sort (.succ .zero)) (.sort (.succ .zero)) - (TypeChecker.Methods.withFuel 9998) context initial = - .ok (true, state) := by - change - TypeChecker.Inner.isDefEqCore' - (.sort (.succ .zero)) (.sort (.succ .zero)) - (TypeChecker.Methods.withFuel 9997) context initial = - .ok (true, state) - exact hr - refine ⟨aliasRecAfterAddEquiv state, ?_⟩ - unfold TypeChecker.Inner.isDefEq - simp only [Bind.bind, ReaderT.bind, StateT.bind, Except.bind] - rw [hr'] +private theorem annotatedPiWhnfCoreDomainCheap (m : EquivManager) : + TypeChecker.Inner.whnfCore annotatedPiRawDomainKernel false true + (TypeChecker.Methods.withFuel 9999) + annotatedPiCtorCandidateContext.toTypeChecker + (annotatedPiWithEqvManager ({} : TypeChecker.State) m) = + .ok (annotatedPiRawDomainKernel, + annotatedPiWithEqvManager ({} : TypeChecker.State) m) := by + change + TypeChecker.Inner.whnfCore' + (.app (.const ``outParam [.succ .zero]) (.sort .zero)) + false true (TypeChecker.Methods.withFuel 9998) + annotatedPiCtorCandidateContext.toTypeChecker + (annotatedPiWithEqvManager ({} : TypeChecker.State) m) = + .ok (.app (.const ``outParam [.succ .zero]) (.sort .zero), + annotatedPiWithEqvManager ({} : TypeChecker.State) m) + unfold TypeChecker.Inner.whnfCore' + simp only [normalizationRecMPure, normalizationRecMBind, + normalizationRecMGet, annotatedPiWithEqvManager, + Std.HashMap.getElem?_empty] + rw [Expr.withRevApp_eq] + simp only [normalizationRecMBind] + rw [show + (Expr.app (.const ``outParam [.succ .zero]) + (.sort .zero)).getAppFn = + .const ``outParam [.succ .zero] by rfl] + rw [annotatedPiWhnfCoreOutParamConstCheap] + simp [annotatedPiRawDomainKernel, annotatedPiReduceRecursorDomain, + annotatedPiWithEqvManager, Expr.eqv_eq, + Bind.bind, ReaderT.bind, StateT.bind, Except.bind] + rw [show + .app (.const ``outParam [.succ .zero]) (.sort .zero) = + annotatedPiRawDomainKernel by rfl] + rw [annotatedPiReduceRecursorDomain (cheapProj := true)] rfl -private theorem inferTypeRecAliasInitial : - TypeChecker.Inner.inferType' - (.const ``RecAlias [.succ .zero]) false +@[simp] private theorem annotatedPiInferConstantOutParamCandidateOnly : + TypeChecker.Inner.inferConstant + annotatedPiCtorCandidateContext.toTypeChecker + ``outParam [.succ .zero] true = + .ok annotatedPiOutParamFnType := by + unfold TypeChecker.Inner.inferConstant + simp only [annotatedPiCtorCandidateContext, + AddInductive.Context.toTypeChecker] + rw [show annotatedPiTypeKernelEnv.get ``outParam = + .ok annotationOutParamInfo by exact annotatedPiType_get_outParam] + simp [annotatedPiCtorCandidateContext, + AddInductive.Context.toTypeChecker, annotationOutParamInfo, + annotatedPiOutParamFnType, Bind.bind, Except.bind, + annotatedPiExceptPure, ConstantInfo.levelParams, + ConstantInfo.instantiateTypeLevelParams, + ConstantInfo.toConstantVal, + ConstantVal.instantiateTypeLevelParams, + Expr.instantiateLevelParams_eq, Expr.instantiateLevelParamsCore', + Level.substParams'] + +private def annotatedPiOutParamInferOnlyState + (m : EquivManager) : TypeChecker.State := + { inferTypeI := ({} : InferCache).insert + (.const ``outParam [.succ .zero]) annotatedPiOutParamFnType, + eqvManager := m } + +private theorem annotatedPiInferTypeOutParamOnly (m : EquivManager) : + TypeChecker.Inner.inferType + (.const ``outParam [.succ .zero]) true (TypeChecker.Methods.withFuel 9998) - aliasRecNormalizationRawContext ({} : TypeChecker.State) = - .ok (aliasRecFieldFnType, aliasRecFieldFnState {}) := by + annotatedPiCtorCandidateContext.toTypeChecker + ({ eqvManager := m } : TypeChecker.State) = + .ok (annotatedPiOutParamFnType, + annotatedPiOutParamInferOnlyState m) := by + change + TypeChecker.Inner.inferType' + (.const ``outParam [.succ .zero]) true + (TypeChecker.Methods.withFuel 9997) + annotatedPiCtorCandidateContext.toTypeChecker + ({ eqvManager := m } : TypeChecker.State) = + .ok (annotatedPiOutParamFnType, + annotatedPiOutParamInferOnlyState m) unfold TypeChecker.Inner.inferType' - simp [aliasRecFieldFnType, aliasRecFieldFnState, + simp [annotatedPiOutParamInferOnlyState, + Expr.hasLooseBVars, Expr.looseBVarRange', Bind.bind, ReaderT.bind, StateT.bind, Except.bind] -private theorem inferTypeAliasRecAfterRecAlias : - TypeChecker.Inner.inferType' - (.const ``AliasRec []) false +private theorem annotatedPiInferAppDomainOnly (m : EquivManager) : + TypeChecker.Inner.inferApp annotatedPiRawDomainKernel (TypeChecker.Methods.withFuel 9998) - aliasRecNormalizationRawContext (aliasRecFieldFnState {}) = + annotatedPiCtorCandidateContext.toTypeChecker + ({ eqvManager := m } : TypeChecker.State) = .ok (.sort (.succ .zero), - aliasRecFieldArgState (aliasRecFieldFnState {})) := by + annotatedPiOutParamInferOnlyState m) := by + unfold TypeChecker.Inner.inferApp + rw [Expr.withApp_eq] + rw [annotatedPiRawDomain_getAppFn] + rw [show annotatedPiRawDomainKernel.getAppArgs = + #[.sort .zero] by rfl] + simp only [normalizationRecMBind] + rw [annotatedPiInferTypeOutParamOnly] + simp [TypeChecker.Inner.inferApp.loop, + annotatedPiOutParamFnType, Expr.instantiateRevRange, + Bind.bind, ReaderT.bind, StateT.bind, Except.bind] + +private def annotatedPiDomainInferOnlyState + (m : EquivManager) : TypeChecker.State := + { inferTypeI := + (({} : InferCache).insert + (.const ``outParam [.succ .zero]) annotatedPiOutParamFnType).insert + annotatedPiRawDomainKernel (.sort (.succ .zero)), + eqvManager := m } + +private theorem annotatedPiInferTypeDomainOnlyAny (m : EquivManager) : + TypeChecker.Inner.inferType annotatedPiRawDomainKernel true + (TypeChecker.Methods.withFuel 9999) + annotatedPiCtorCandidateContext.toTypeChecker + ({ eqvManager := m } : TypeChecker.State) = + .ok (.sort (.succ .zero), annotatedPiDomainInferOnlyState m) := by + change + TypeChecker.Inner.inferType' annotatedPiRawDomainKernel true + (TypeChecker.Methods.withFuel 9998) + annotatedPiCtorCandidateContext.toTypeChecker + ({ eqvManager := m } : TypeChecker.State) = + .ok (.sort (.succ .zero), annotatedPiDomainInferOnlyState m) + rw [show annotatedPiRawDomainKernel = + .app (.const ``outParam [.succ .zero]) (.sort .zero) by rfl] unfold TypeChecker.Inner.inferType' - simp [aliasRecFieldArgState, Bind.bind, ReaderT.bind, + simp [Expr.hasLooseBVars, Expr.looseBVarRange', + annotatedPiDomainInferOnlyState, Bind.bind, ReaderT.bind, + StateT.bind, Except.bind] + rw [show + .app (.const ``outParam [.succ .zero]) (.sort .zero) = + annotatedPiRawDomainKernel by rfl] + rw [annotatedPiInferAppDomainOnly] + simp [annotatedPiDomainInferOnlyState, + annotatedPiOutParamInferOnlyState, Bind.bind, ReaderT.bind, StateT.bind, Except.bind] -/-- The exact full checker run for the raw `RecAlias AliasRec` constructor -field in the post-family environment. -/ -theorem aliasRecField_checkType : - ∃ state : TypeChecker.State, - TypeChecker.Inner.inferType aliasRecFieldKernelExpr false - (TypeChecker.Methods.withFuel 9999) - aliasRecNormalizationRawContext ({} : TypeChecker.State) = - .ok (.sort (.succ .zero), state) := by - change ∃ state : TypeChecker.State, - TypeChecker.Inner.inferType' aliasRecFieldKernelExpr false +private def annotatedPiSortOneInferOnlyState + (m : EquivManager) : TypeChecker.State := + { annotatedPiDomainInferOnlyState m with + inferTypeI := (annotatedPiDomainInferOnlyState m).inferTypeI.insert + (.sort (.succ .zero)) (.sort (.succ (.succ .zero))) } + +@[simp] private theorem annotatedPiDomainInferOnlyState_sortOneMiss + (m : EquivManager) : + (annotatedPiDomainInferOnlyState m).inferTypeI[ + (.sort (.succ .zero) : Expr)]? = none := by + simp [annotatedPiDomainInferOnlyState, annotatedPiRawDomainKernel, + annotatedPiOutParamFnType, Expr.eqv_eq] + +private theorem annotatedPiInferTypeSortOneOnly (m : EquivManager) : + TypeChecker.Inner.inferType (.sort (.succ .zero)) true + (TypeChecker.Methods.withFuel 9999) + annotatedPiCtorCandidateContext.toTypeChecker + (annotatedPiDomainInferOnlyState m) = + .ok (.sort (.succ (.succ .zero)), + annotatedPiSortOneInferOnlyState m) := by + change + TypeChecker.Inner.inferType' (.sort (.succ .zero)) true (TypeChecker.Methods.withFuel 9998) - aliasRecNormalizationRawContext ({} : TypeChecker.State) = - .ok (.sort (.succ .zero), state) - rw [aliasRecFieldKernelExpr_eq] + annotatedPiCtorCandidateContext.toTypeChecker + (annotatedPiDomainInferOnlyState m) = + .ok (.sort (.succ (.succ .zero)), + annotatedPiSortOneInferOnlyState m) unfold TypeChecker.Inner.inferType' - simp only [aliasRecField_noLooseBVars, Bool.false_eq_true, if_false, cond, - normalizationRecMPure, normalizationRecMGet, - Std.HashMap.getElem?_empty, normalizationRecMBind] - rw [inferTypeRecAliasInitial] - simp only - [TypeChecker.Inner.ensureForallCore, - aliasRecFieldFnType_isForall, if_true, normalizationRecMPure] - rw [inferTypeAliasRecAfterRecAlias] - obtain ⟨eqState, heq⟩ := - isDefEqSort aliasRecNormalizationRawContext - (aliasRecFieldArgState (aliasRecFieldFnState {})) - aliasRecFieldArgState_eqvManager - simp only [aliasRecFamily_notEagerReduce, Bool.false_eq_true, - if_false, aliasRecFieldFnType_bindingDomain, - normalizationRecMBind] - rw [heq] - rw [aliasRecFieldFnType_instantiatedBody] - refine ⟨aliasRecFieldResultState eqState, ?_⟩ - simp [aliasRecFieldResultState, aliasRecFieldKernelExpr_eq, - Bind.bind, ReaderT.bind, StateT.bind, Except.bind] + simp [annotatedPiDomainInferOnlyState_sortOneMiss, + annotatedPiSortOneInferOnlyState, Expr.hasLooseBVars, + Expr.looseBVarRange', Bind.bind, ReaderT.bind, StateT.bind, + Except.bind] + +@[simp] private theorem annotatedPiWhnfSortTwo + (state : TypeChecker.State) : + TypeChecker.Inner.whnf (.sort (.succ (.succ .zero))) + (TypeChecker.Methods.withFuel 9999) + annotatedPiCtorCandidateContext.toTypeChecker state = + .ok (.sort (.succ (.succ .zero)), state) := by + rfl -/-- The paired full-check/WHNF interpretation of the retained AliasFormer -family node. Both semantic runs are obtained from the candidate's exact -observations in one verified context. -/ -private def aliasFormerFamilyCandidateNodeRun : - TypeChecker.CandidateNodeRun typeFamilyAliasEnv [] [] - aliasFormerCandidateContext aliasFormerInfo.type - (.sort (.succ (.succ .zero))) (.sort (.succ .zero)) - aliasFormerRawType.type aliasFormerViewType.type - (.sort (.succ (.succ .zero))) := by - exact TypeChecker.CandidateNodeRun.ofCandidate - aliasFormerCandidateContext aliasFormerInfo.type - (.sort (.succ (.succ .zero))) (.sort (.succ .zero)) - aliasFormerFamilyCheckTypeStep_valid - aliasFormerFamilyCandidateStep_valid - aliasFormerNormalizationContext (by rfl) - rfl rfl rfl TypeChecker.VState.WF.empty - (.const rfl rfl rfl) (.sort rfl) - (by - have hs : TrExprS typeFamilyAliasEnv [] [] - (.sort (.succ .zero)) (.sort (.succ .zero)) := .sort rfl - exact ⟨_, hs, ⟨_, VEnv.HasType.sort (by decide)⟩⟩) - 10000 9999 (by rfl) (by rfl) +private theorem annotatedPiIsPropSortOneFalse (m : EquivManager) : + TypeChecker.Inner.isProp (.sort (.succ .zero)) + (TypeChecker.Methods.withFuel 9999) + annotatedPiCtorCandidateContext.toTypeChecker + (annotatedPiDomainInferOnlyState m) = + .ok (false, annotatedPiSortOneInferOnlyState m) := by + unfold TypeChecker.Inner.isProp TypeChecker.Inner.getSortLevel + simp only [normalizationRecMBind] + rw [annotatedPiInferTypeSortOneOnly] + rfl -/-- Verified family-result normalization leaf for AliasFormer. -/ -def aliasFormerFamilyWhnfRun : - TypeChecker.WhnfRun typeFamilyAliasEnv [] [] - aliasFormerInfo.type (.sort (.succ .zero)) - aliasFormerRawType.type aliasFormerViewType.type := - aliasFormerFamilyCandidateNodeRun.whnf +private theorem annotatedPiIsDefEqProofIrrelDomain + (m : EquivManager) : + TypeChecker.Inner.isDefEqProofIrrel + annotatedPiRawDomainKernel (.sort .zero) + (TypeChecker.Methods.withFuel 9999) + annotatedPiCtorCandidateContext.toTypeChecker + ({ eqvManager := m } : TypeChecker.State) = + .ok (.undef, annotatedPiSortOneInferOnlyState m) := by + unfold TypeChecker.Inner.isDefEqProofIrrel + simp only [normalizationRecMBind] + rw [annotatedPiInferTypeDomainOnlyAny] + simp only [normalizationRecMBind] + rw [annotatedPiIsPropSortOneFalse] + rfl -/-- Verified full-check certificate for the raw AliasFormer family type. -/ -def aliasFormerFamilyCheckTypeRun : - TypeChecker.CheckTypeRun typeFamilyAliasEnv [] [] - aliasFormerInfo.type (.sort (.succ (.succ .zero))) - aliasFormerRawType.type (.sort (.succ (.succ .zero))) := - aliasFormerFamilyCandidateNodeRun.check +private theorem annotatedPiUnfoldOutParamCoreOfMiss + (methods : TypeChecker.Methods) (state : TypeChecker.State) + (hcache : state.unfold[ + (.const ``outParam [.succ .zero] : Expr)]? = none) : + TypeChecker.Inner.unfoldDefinitionCore + (.const ``outParam [.succ .zero]) methods + annotatedPiCtorCandidateContext.toTypeChecker state = + .ok (some annotatedPiOutParamWhnfKernelExpr, + annotatedPiOutParamUnfoldState state) := by + simp [TypeChecker.Inner.unfoldDefinitionCore, + TypeChecker.Inner.isDelta, Expr.getAppFn, + annotatedPiCtorCandidateContext, + AddInductive.Context.toTypeChecker, annotatedPiType_lookup_outParam, + hcache, Bind.bind, ReaderT.bind, StateT.bind, Except.bind, + annotationOutParamInfo, ConstantInfo.deltaValue?, + TypeChecker.Inner.instantiateDeltaValue, + ConstantInfo.numLevelParams, + ConstantInfo.instantiateValueLevelParams!, ConstantInfo.levelParams, + ConstantInfo.value!, ConstantInfo.toConstantVal, + Expr.instantiateLevelParams, annotatedPiOutParamWhnfKernelExpr, + annotatedPiOutParamUnfoldState] + +private theorem annotatedPiUnfoldDomainOfMiss + (methods : TypeChecker.Methods) (state : TypeChecker.State) + (hcache : state.unfold[ + (.const ``outParam [.succ .zero] : Expr)]? = none) : + TypeChecker.Inner.unfoldDefinition annotatedPiRawDomainKernel + methods annotatedPiCtorCandidateContext.toTypeChecker state = + .ok (some annotatedPiDomainBetaKernel, + annotatedPiOutParamUnfoldState state) := by + change + TypeChecker.Inner.unfoldDefinition + (.app (.const ``outParam [.succ .zero]) (.sort .zero)) + methods annotatedPiCtorCandidateContext.toTypeChecker state = + .ok (some annotatedPiDomainBetaKernel, + annotatedPiOutParamUnfoldState state) + unfold TypeChecker.Inner.unfoldDefinition + simp only [Expr.isApp] + rw [if_pos True.intro] + rw [show + (Expr.app (.const ``outParam [.succ .zero]) + (.sort .zero)).getAppFn = + .const ``outParam [.succ .zero] by rfl] + simp only [normalizationRecMBind] + rw [annotatedPiUnfoldOutParamCoreOfMiss methods state hcache] + rw [show + (Expr.app (.const ``outParam [.succ .zero]) + (.sort .zero)).getAppRevArgs = #[.sort .zero] by rfl] + simp only [normalizationRecMPure] + rw [Expr.mkAppRevRange_eq + (l₁ := []) (l₂ := [.sort .zero]) (l₃ := []) + (by simp) (by rfl) (by rfl)] + rfl -/-- Recursive semantic interpretation of the exact source-indexed candidate -trace. This terminal fixture is the base case used by the generic Pi -interpreter for larger metadata. -/ -private def aliasFormerFamilyCandidateRun : - TypeChecker.CandidateExprRun typeFamilyAliasEnv [] - aliasFormerFamilyCandidate.trace [] - aliasFormerRawType.type aliasFormerViewType.type - (.sort (.succ (.succ .zero))) := - .terminal aliasFormerFamilyCandidateNodeRun +@[simp] private theorem annotatedPiWhnfCoreIdentityCheap (state) : + TypeChecker.Inner.whnfCore + (.lam `α (.sort (.succ .zero)) (.bvar 0) .default) + false true (TypeChecker.Methods.withFuel 9998) + annotatedPiCtorCandidateContext.toTypeChecker state = + .ok (.lam `α (.sort (.succ .zero)) (.bvar 0) .default, + state) := by + rfl -/-- The generic interpreter retains the strict translation of the raw -candidate endpoint. -/ -theorem aliasFormerFamily_candidateSource_tr : - TrExprS typeFamilyAliasEnv [] [] aliasFormerInfo.type - aliasFormerRawType.type := - aliasFormerFamilyCandidateRun.source_tr +@[simp] private theorem annotatedPiWhnfCoreSortZeroCheap998 (state) : + TypeChecker.Inner.whnfCore (.sort .zero) false true + (TypeChecker.Methods.withFuel 9998) + annotatedPiCtorCandidateContext.toTypeChecker state = + .ok (.sort .zero, state) := by + rfl -/-- The reconstructed candidate endpoint is also tied back to the concrete -kernel WHNF result, closing the source/view translation pair. -/ -theorem aliasFormerFamily_candidateView_tr : - TrExpr typeFamilyAliasEnv [] [] (.sort (.succ .zero)) - aliasFormerViewType.type := by - simpa [aliasFormerFamilyCandidate, - AddInductive.CandidateExprTrace.view] using - aliasFormerFamilyCandidateRun.view_tr +private theorem annotatedPiWhnfCoreDomainBetaCheap + (m : EquivManager) : + TypeChecker.Inner.whnfCore annotatedPiDomainBetaKernel false true + (TypeChecker.Methods.withFuel 9999) + annotatedPiCtorCandidateContext.toTypeChecker + (annotatedPiOutParamUnfoldState + (annotatedPiSortOneInferOnlyState m)) = + .ok (.sort .zero, + annotatedPiOutParamUnfoldState + (annotatedPiSortOneInferOnlyState m)) := by + change + TypeChecker.Inner.whnfCore' annotatedPiDomainBetaKernel false true + (TypeChecker.Methods.withFuel 9998) + annotatedPiCtorCandidateContext.toTypeChecker + (annotatedPiOutParamUnfoldState + (annotatedPiSortOneInferOnlyState m)) = + .ok (.sort .zero, + annotatedPiOutParamUnfoldState + (annotatedPiSortOneInferOnlyState m)) + rw [annotatedPiDomainBetaKernel, + annotatedPiOutParamWhnfKernelExpr_eq] + unfold TypeChecker.Inner.whnfCore' + simp only [normalizationRecMPure, normalizationRecMBind, + normalizationRecMGet, annotatedPiOutParamUnfoldState, + annotatedPiSortOneInferOnlyState, + annotatedPiDomainInferOnlyState, Std.HashMap.getElem?_empty] + rw [Expr.withRevApp_eq] + simp only [normalizationRecMBind] + rw [show + (Expr.app + (.lam `α (.sort (.succ .zero)) (.bvar 0) .default) + (.sort .zero)).getAppFn = + .lam `α (.sort (.succ .zero)) (.bvar 0) .default by rfl] + rw [annotatedPiWhnfCoreIdentityCheap] + rw [show + (Expr.app + (.lam `α (.sort (.succ .zero)) (.bvar 0) .default) + (.sort .zero)).getAppRevArgs = #[.sort .zero] by rfl] + simp [TypeChecker.Inner.whnfCore'.loop, + TypeChecker.Inner.whnfCore'.loop.cont, + TypeChecker.Inner.whnfCore'.save, + annotatedPiDomainBetaKernel, + annotatedPiOutParamWhnfKernelExpr_eq, + annotatedPiOutParamUnfoldState, + annotatedPiSortOneInferOnlyState, + annotatedPiDomainInferOnlyState, + Expr.instantiateRange, Expr.instantiateRevRange, + Expr.instantiate1_eq, Expr.instantiate1', Expr.eqv_eq, + Bind.bind, ReaderT.bind, StateT.bind, Except.bind] -/-- Verified full-check certificate for the actual AliasFormer constructor -type in the post-family environment. -/ -def aliasFormerCtorCheckTypeRun : - TypeChecker.CheckTypeRun aliasFormerTypeEnv [] [] - aliasFormerMkInfo.type (.const ``TypeFamilyAlias []) - aliasFormerRawType.ctors[0].type - (.const ``TypeFamilyAlias []) := by - exact TypeChecker.CheckTypeRun.ofCandidateStep - aliasFormerCtorCheckTypeStep aliasFormerCtorCheckTypeStep_valid - aliasFormerCtorNormalizationContext (by rfl) - rfl rfl rfl TypeChecker.VState.WF.empty - (.const rfl rfl rfl) (.const rfl rfl rfl) - 10000 (by rfl) +private theorem annotatedPiQuickIsDefEqSortZeroAny + (methods : TypeChecker.Methods) + (context : TypeChecker.Context) + (initial : TypeChecker.State) : + ∃ m : EquivManager, + TypeChecker.Inner.quickIsDefEq (.sort .zero) (.sort .zero) false + methods context initial = + .ok (.true, annotatedPiWithEqvManager initial m) := by + let r := EquivManager.isEquiv false + (.sort .zero) (.sort .zero) initial.eqvManager + rcases hr : r with ⟨b, m⟩ + have hr' : EquivManager.isEquiv false + (.sort .zero) (.sort .zero) initial.eqvManager = (b, m) := by + simpa [r] using hr + refine ⟨m, ?_⟩ + cases b <;> + simp [TypeChecker.Inner.quickIsDefEq, modifyGet, + MonadStateOf.modifyGet, monadLift, MonadLift.monadLift, + StateT.modifyGet, pure, ReaderT.pure, StateT.pure, + Except.pure, hr', annotatedPiWithEqvManager, + Level.isEquiv, Level.isEquiv', + Bind.bind, ReaderT.bind, StateT.bind, + Except.bind] + +private theorem annotatedPiIsDeltaDomain : + TypeChecker.Inner.isDelta annotatedPiTypeKernelEnv + annotatedPiRawDomainKernel = + some annotationOutParamInfo := by + unfold TypeChecker.Inner.isDelta + rw [annotatedPiRawDomain_getAppFn] + simp only + rw [annotatedPiType_lookup_outParam] + simp [annotationOutParamInfo, ConstantInfo.deltaValue?, + ConstantInfo.numLevelParams, ConstantInfo.levelParams, + ConstantInfo.toConstantVal] + +@[simp] private theorem annotatedPiIsDeltaSortZero : + TypeChecker.Inner.isDelta annotatedPiTypeKernelEnv (.sort .zero) = + none := by + rfl -/-- The actual AliasFormer constructor type is typed by the verified full -checker in the post-family environment. -/ -theorem aliasFormerCtor_hasType_checked : - aliasFormerTypeEnv.HasType 0 [] - aliasFormerRawType.ctors[0].type - (.const ``TypeFamilyAlias []) := - aliasFormerCtorCheckTypeRun.hasType +@[simp] private theorem annotatedPiTryUnfoldProjAppSortZero + (methods state) : + TypeChecker.Inner.tryUnfoldProjApp (.sort .zero) methods + annotatedPiCtorCandidateContext.toTypeChecker state = + .ok (none, state) := by + rfl -/-- The raw AliasFormer family is a Theory type because the verified checker -actually accepted it and inferred a sort. -/ -theorem aliasFormerFamily_isType_checked : - typeFamilyAliasEnv.IsType 0 [] aliasFormerRawType.type := - aliasFormerFamilyCheckTypeRun.isType +private theorem annotatedPiDeltaDomain + (m : EquivManager) : + (TypeChecker.Inner.unfoldDefinition annotatedPiRawDomainKernel >>= + fun e => TypeChecker.Inner.whnfCore e.get! false true) + (TypeChecker.Methods.withFuel 9999) + annotatedPiCtorCandidateContext.toTypeChecker + (annotatedPiSortOneInferOnlyState m) = + .ok (.sort .zero, + annotatedPiOutParamUnfoldState + (annotatedPiSortOneInferOnlyState m)) := by + simp only [normalizationRecMBind] + rw [annotatedPiUnfoldDomainOfMiss + (TypeChecker.Methods.withFuel 9999) + (annotatedPiSortOneInferOnlyState m) (by + simp [annotatedPiSortOneInferOnlyState, + annotatedPiDomainInferOnlyState])] + simp only + rw [show (some annotatedPiDomainBetaKernel).get! = + annotatedPiDomainBetaKernel by rfl] + rw [annotatedPiWhnfCoreDomainBetaCheap] + +private theorem annotatedPiLazyDeltaStepDomain + (m : EquivManager) : + ∃ m' : EquivManager, + TypeChecker.Inner.lazyDeltaReductionStep + annotatedPiRawDomainKernel (.sort .zero) + (TypeChecker.Methods.withFuel 9999) + annotatedPiCtorCandidateContext.toTypeChecker + (annotatedPiSortOneInferOnlyState m) = + .ok (.bool true, + annotatedPiWithEqvManager + (annotatedPiOutParamUnfoldState + (annotatedPiSortOneInferOnlyState m)) m') := by + obtain ⟨m', hquick⟩ := annotatedPiQuickIsDefEqSortZeroAny + (TypeChecker.Methods.withFuel 9999) + annotatedPiCtorCandidateContext.toTypeChecker + (annotatedPiOutParamUnfoldState + (annotatedPiSortOneInferOnlyState m)) + refine ⟨m', ?_⟩ + unfold TypeChecker.Inner.lazyDeltaReductionStep + rw [normalizationRecMBind] + rw [normalizationRecMGetEnv] + simp only + rw [show annotatedPiCtorCandidateContext.toTypeChecker.env = + annotatedPiTypeKernelEnv by rfl] + rw [annotatedPiIsDeltaDomain, annotatedPiIsDeltaSortZero] + simp only + rw [normalizationRecMBind] + rw [annotatedPiTryUnfoldProjAppSortZero] + simp only + rw [normalizationRecMBind] + rw [annotatedPiDeltaDomain] + simp only + rw [normalizationRecMBind] + rw [hquick] + rfl -/-- Verified delta-normalization leaf for `RecAlias.{1}`. -/ -def recAliasWhnfRun : - TypeChecker.WhnfRun aliasRecTypeEnv [] [] - (.const ``RecAlias [.succ .zero]) - recAliasWhnfKernelExpr - (.const ``RecAlias [.succ .zero]) - (.lam (.sort (.succ .zero)) (.bvar 0)) where - context := aliasRecNormalizationContext - venv_eq := rfl - lparams_eq := rfl - vlctx_eq := rfl - state_wf := TypeChecker.VState.WF.empty - lhs_tr := .const rfl rfl rfl - rhs_tr := by - have hs : TrExprS aliasRecTypeEnv [] [] - recAliasWhnfKernelExpr - (.lam (.sort (.succ .zero)) (.bvar 0)) := by - rw [recAliasWhnfKernelExpr_eq] - exact .lam - ⟨_, VEnv.HasType.sort (by decide)⟩ - (.sort rfl) (.bvar rfl) - exact ⟨_, hs, ⟨_, - VEnv.HasType.lam - (VEnv.HasType.sort (by decide)) - (VEnv.HasType.bvar .zero)⟩⟩ - recursionFuel := 9999 - run_eq := by - simpa [aliasRecNormalizationContext, TypeChecker.VContext.mk', - aliasRecNormalizationRawContext] using - recAlias_whnf +@[simp] private theorem annotatedPiIsDefEqOffsetDomain + (m : EquivManager) : + TypeChecker.Inner.isDefEqOffset + annotatedPiRawDomainKernel (.sort .zero) + (TypeChecker.Methods.withFuel 9999) + annotatedPiCtorCandidateContext.toTypeChecker + (annotatedPiSortOneInferOnlyState m) = + .ok (.undef, annotatedPiSortOneInferOnlyState m) := by + have hzero : + (annotatedPiRawDomainKernel == Expr.natZero) = false := by + rw [show annotatedPiRawDomainKernel = + .app (.const ``outParam [.succ .zero]) (.sort .zero) by rfl] + exact annotatedPiApp_beq_const _ _ _ _ + unfold TypeChecker.Inner.isDefEqOffset + simp [TypeChecker.Inner.isNatZero, + TypeChecker.Inner.isNatSuccOf?, annotatedPiRawDomainKernel, + Expr.natZero, hzero, Bind.bind] + rfl -private theorem recAliasConst_hasType : - aliasRecTypeEnv.HasType 0 [] - (.const ``RecAlias [.succ .zero]) - (.forallE (.sort (.succ .zero)) (.sort (.succ .zero))) := by - have hAlias : aliasRecTypeEnv.constants ``RecAlias = - some (vconst(type_of% @RecAlias)) := rfl - type_tac +private theorem annotatedPiLazyDeltaLoopDomain + (m : EquivManager) : + ∃ m' : EquivManager, + TypeChecker.Inner.lazyDeltaReduction.loop + annotatedPiRawDomainKernel (.sort .zero) 1000 + (TypeChecker.Methods.withFuel 9999) + annotatedPiCtorCandidateContext.toTypeChecker + (annotatedPiSortOneInferOnlyState m) = + .ok (.bool true, + annotatedPiWithEqvManager + (annotatedPiOutParamUnfoldState + (annotatedPiSortOneInferOnlyState m)) m') := by + obtain ⟨m', hstep⟩ := annotatedPiLazyDeltaStepDomain m + refine ⟨m', ?_⟩ + rw [show 1000 = 999 + 1 by rfl] + unfold TypeChecker.Inner.lazyDeltaReduction.loop + rw [normalizationRecMBind] + rw [annotatedPiIsDefEqOffsetDomain] + simp only + rw [show (LBool.undef != LBool.undef) = false by rfl] + simp only [Bool.false_eq_true, if_false] + rw [normalizationRecMBind] + rw [normalizationRecMPure] + simp only + rw [normalizationRecMBind] + rw [normalizationRecMReadContext] + simp only + rw [show + (!annotatedPiRawDomainKernel.hasFVar && + !(.sort .zero : Expr).hasFVar || + annotatedPiCtorCandidateContext.toTypeChecker.eagerReduce) = true + by + simp [Expr.hasFVar_eq, Expr.hasFVar', + annotatedPiRawDomainKernel]] + simp only [if_true] + rw [normalizationRecMBind] + rw [annotatedPiReduceNatDomain] + simp only + rw [normalizationRecMBind] + rw [normalizationReduceNatSort] + simp only + rw [normalizationRecMBind] + rw [normalizationRecMPure] + simp only + rw [normalizationRecMBind] + rw [normalizationRecMGetEnv] + simp only + rw [normalizationRecMBind] + rw [annotatedPiReduceNativeDomain] + simp only + rw [normalizationRecMBind] + rw [normalizationReduceNativeSort] + simp only + rw [normalizationRecMBind] + rw [normalizationRecMPure] + simp only + rw [normalizationRecMBind] + rw [hstep] + rfl -private theorem aliasRecConst_hasType : - aliasRecTypeEnv.HasType 0 [] - (.const ``AliasRec []) (.sort (.succ .zero)) := by - exact .constDF - (VEnv.addConst_self (show - recAliasEnv.addConst aliasRecRawType.name - aliasRecRawType.toVConstant = some aliasRecTypeEnv from rfl)) - (fun _ h => nomatch h) (fun _ h => nomatch h) rfl .nil +private theorem annotatedPiLazyDeltaDomain + (m : EquivManager) : + ∃ m' : EquivManager, + TypeChecker.Inner.lazyDeltaReduction + annotatedPiRawDomainKernel (.sort .zero) + (TypeChecker.Methods.withFuel 9999) + annotatedPiCtorCandidateContext.toTypeChecker + (annotatedPiSortOneInferOnlyState m) = + .ok (.bool true, + annotatedPiWithEqvManager + (annotatedPiOutParamUnfoldState + (annotatedPiSortOneInferOnlyState m)) m') := by + obtain ⟨m', hloop⟩ := annotatedPiLazyDeltaLoopDomain m + refine ⟨m', ?_⟩ + unfold TypeChecker.Inner.lazyDeltaReduction + rw [normalizationRecMBind] + rw [normalizationRecMReadContext] + simp only + change + TypeChecker.Inner.lazyDeltaReduction.loop + annotatedPiRawDomainKernel (.sort .zero) 1000 + (TypeChecker.Methods.withFuel 9999) + annotatedPiCtorCandidateContext.toTypeChecker + (annotatedPiSortOneInferOnlyState m) = _ + exact hloop -/-- Verified full-check certificate for the actual raw recursive field in the -exact environment produced by inserting `AliasRec`. -/ -def aliasRecFieldCheckTypeRun : - TypeChecker.CheckTypeRun aliasRecTypeEnv [] [] - aliasRecFieldKernelExpr (.sort (.succ .zero)) - aliasRecRawField (.sort (.succ .zero)) where - context := aliasRecNormalizationContext - venv_eq := rfl - lparams_eq := rfl - vlctx_eq := rfl - state_wf := TypeChecker.VState.WF.empty - expr_tr := .app recAliasConst_hasType aliasRecConst_hasType - (.const rfl rfl rfl) (.const rfl rfl rfl) - inferred_tr := .sort rfl - recursionFuel := 9999 - run_eq := by - simpa [aliasRecNormalizationContext, TypeChecker.VContext.mk', - aliasRecNormalizationRawContext] using - aliasRecField_checkType +private theorem annotatedPiQuickIsDefEqDomainAny + (m : EquivManager) : + ∃ (r : LBool) (m' : EquivManager), + TypeChecker.Inner.quickIsDefEq + annotatedPiRawDomainKernel (.sort .zero) false + (TypeChecker.Methods.withFuel 9999) + annotatedPiCtorCandidateContext.toTypeChecker + ({ eqvManager := m } : TypeChecker.State) = + .ok (r, ({ eqvManager := m' } : TypeChecker.State)) ∧ + (r = .true ∨ r = .undef) := by + let q := EquivManager.isEquiv false + annotatedPiRawDomainKernel (.sort .zero) m + rcases hq : q with ⟨b, m'⟩ + have hq' : EquivManager.isEquiv false + annotatedPiRawDomainKernel (.sort .zero) m = (b, m') := by + simpa [q] using hq + cases b + · refine ⟨.undef, m', ?_, Or.inr rfl⟩ + simp [TypeChecker.Inner.quickIsDefEq, modifyGet, + MonadStateOf.modifyGet, monadLift, MonadLift.monadLift, + StateT.modifyGet, pure, ReaderT.pure, StateT.pure, + Except.pure, hq', + Bind.bind, ReaderT.bind, StateT.bind, Except.bind] + rfl + · refine ⟨.true, m', ?_, Or.inl rfl⟩ + simp [TypeChecker.Inner.quickIsDefEq, modifyGet, + MonadStateOf.modifyGet, monadLift, MonadLift.monadLift, + StateT.modifyGet, pure, ReaderT.pure, StateT.pure, + Except.pure, hq', Bind.bind, ReaderT.bind, StateT.bind, + Except.bind] + +@[simp] private theorem annotatedPiWhnfCoreSortCheap + (state : TypeChecker.State) : + TypeChecker.Inner.whnfCore (.sort .zero) false true + (TypeChecker.Methods.withFuel 9999) + annotatedPiCtorCandidateContext.toTypeChecker state = + .ok (.sort .zero, state) := by + rfl -/-- The raw recursive field is typed by an exact full checker execution in -the post-family environment. -/ -theorem aliasRecField_hasType_checked : - aliasRecTypeEnv.HasType 0 [] - aliasRecRawField (.sort (.succ .zero)) := - aliasRecFieldCheckTypeRun.hasType +private theorem annotatedPiIsDefEqCoreDomain : + ∃ state : TypeChecker.State, + TypeChecker.Inner.isDefEqCore' + annotatedPiRawDomainKernel (.sort .zero) + (TypeChecker.Methods.withFuel 9999) + annotatedPiCtorCandidateContext.toTypeChecker + ({} : TypeChecker.State) = + .ok (true, state) := by + obtain ⟨m, hquick⟩ := annotatedPiQuickIsDefEqDomainInitial + (TypeChecker.Methods.withFuel 9999) + annotatedPiCtorCandidateContext.toTypeChecker + unfold TypeChecker.Inner.isDefEqCore' + rw [normalizationRecMBind] + rw [hquick] + simp only + rw [show (LBool.undef != LBool.undef) = false by rfl] + simp only [Bool.false_eq_true, if_false] + rw [normalizationRecMBind] + rw [normalizationRecMPure] + simp only + rw [normalizationRecMBind] + rw [normalizationRecMReadContext] + simp only + rw [show ((.sort .zero : Expr).isConstOf ``true) = false by rfl] + simp only [Bool.and_false, Bool.false_eq_true, if_false] + rw [normalizationRecMBind] + rw [normalizationRecMPure] + simp only + rw [normalizationRecMBind] + rw [annotatedPiWhnfCoreDomainCheap] + simp only + rw [normalizationRecMBind] + rw [annotatedPiWhnfCoreSortCheap] + simp only + cases hptr : + (!(ptrEqExpr annotatedPiRawDomainKernel annotatedPiRawDomainKernel && + ptrEqExpr (.sort .zero) (.sort .zero))) + · simp only [Bool.false_eq_true, if_false] + rw [normalizationRecMBind] + rw [normalizationRecMPure] + simp only + rw [normalizationRecMBind] + rw [show annotatedPiWithEqvManager ({} : TypeChecker.State) m = + ({ eqvManager := m } : TypeChecker.State) by rfl] + rw [annotatedPiIsDefEqProofIrrelDomain] + simp only + rw [show (LBool.undef != LBool.undef) = false by rfl] + simp only [Bool.false_eq_true, if_false] + rw [normalizationRecMBind] + rw [normalizationRecMPure] + simp only + rw [normalizationRecMBind] + obtain ⟨m'', hlazy⟩ := annotatedPiLazyDeltaDomain m + rw [hlazy] + refine ⟨annotatedPiWithEqvManager + (annotatedPiOutParamUnfoldState + (annotatedPiSortOneInferOnlyState m)) m'', ?_⟩ + rfl + · simp only [if_true] + obtain ⟨r, m', hquick', hr⟩ := + annotatedPiQuickIsDefEqDomainAny m + rw [normalizationRecMBind] + rw [show annotatedPiWithEqvManager ({} : TypeChecker.State) m = + ({ eqvManager := m } : TypeChecker.State) by rfl] + rw [hquick'] + simp only + rcases hr with htrue | hundef + · subst r + rw [show (LBool.true != LBool.undef) = true by rfl] + simp only [if_true] + refine ⟨({ eqvManager := m' } : TypeChecker.State), ?_⟩ + rfl + · subst r + rw [show (LBool.undef != LBool.undef) = false by rfl] + simp only [Bool.false_eq_true, if_false] + rw [normalizationRecMBind] + rw [normalizationRecMPure] + simp only + rw [normalizationRecMBind] + rw [annotatedPiIsDefEqProofIrrelDomain] + simp only + rw [show (LBool.undef != LBool.undef) = false by rfl] + simp only [Bool.false_eq_true, if_false] + rw [normalizationRecMBind] + rw [normalizationRecMPure] + simp only + rw [normalizationRecMBind] + obtain ⟨m'', hlazy⟩ := annotatedPiLazyDeltaDomain m' + rw [hlazy] + refine ⟨annotatedPiWithEqvManager + (annotatedPiOutParamUnfoldState + (annotatedPiSortOneInferOnlyState m')) m'', ?_⟩ + rfl -private def aliasRecFieldEvidenceBase : - TypeChecker.DefEqEvidence aliasRecTypeEnv 0 [] - aliasRecRawField (.const ``AliasRec []) (.sort (.succ .zero)) := by - exact .trans - (.app - (.whnf recAliasWhnfRun recAliasConst_hasType) - (.refl aliasRecConst_hasType)) - (.beta (VEnv.HasType.bvar .zero) aliasRecConst_hasType) +private theorem annotatedPiDomain_isDefEqM : + TypeChecker.M.run annotatedPiCtorCandidateContext.env + annotatedPiCtorCandidateContext.safety + annotatedPiCtorCandidateContext.lctx + annotatedPiCtorCandidateContext.lparams + annotatedPiCtorCandidateContext.fuel + (TypeChecker.isDefEq annotatedPiRawDomainKernel (.sort .zero)) = + .ok true := by + obtain ⟨state, hcore⟩ := annotatedPiIsDefEqCoreDomain + have hcore' : + TypeChecker.Inner.isDefEqCore + annotatedPiRawDomainKernel (.sort .zero) + (TypeChecker.Methods.withFuel 10000) + annotatedPiCtorCandidateContext.toTypeChecker + ({} : TypeChecker.State) = + .ok (true, state) := by + change + TypeChecker.Inner.isDefEqCore' + annotatedPiRawDomainKernel (.sort .zero) + (TypeChecker.Methods.withFuel 9999) + annotatedPiCtorCandidateContext.toTypeChecker + ({} : TypeChecker.State) = + .ok (true, state) + exact hcore + change + Except.map (fun x : Bool × TypeChecker.State => x.1) + (TypeChecker.Inner.isDefEq + annotatedPiRawDomainKernel (.sort .zero) + (TypeChecker.Methods.withFuel 10000) + annotatedPiCtorCandidateContext.toTypeChecker + ({} : TypeChecker.State)) = + .ok true + unfold TypeChecker.Inner.isDefEq + rw [show + (annotatedPiRawDomainKernel == (.sort .zero : Expr)) = false by + exact annotatedPiApp_beq_sort _ _ _] + simp only [Bool.false_eq_true, if_false, pure_bind, + normalizationRecMBind] + rw [hcore'] + rfl -private def aliasRecFieldEvidence : - TypeChecker.DefEqEvidence aliasRecTypeEnv 0 [] - aliasRecRawField (.const ``AliasRec []) (.sort (.succ .zero)) := - .trans (.refl aliasRecField_hasType_checked) - aliasRecFieldEvidenceBase +private theorem annotatedPiInner_checkTypeM : + TypeChecker.M.run annotatedPiCtorCandidateContext.env + annotatedPiCtorCandidateContext.safety + annotatedPiCtorCandidateContext.lctx + annotatedPiCtorCandidateContext.lparams + annotatedPiCtorCandidateContext.fuel + (TypeChecker.checkType annotatedPiInnerKernel) = + .ok (.sort (.succ .zero)) := by + change + Except.map (fun x : Expr × TypeChecker.State => x.1) + (TypeChecker.Inner.inferType annotatedPiInnerKernel false + (TypeChecker.Methods.withFuel 10000) + annotatedPiCtorCandidateContext.toTypeChecker + ({} : TypeChecker.State)) = + .ok (.sort (.succ .zero)) + change + Except.map (fun x : Expr × TypeChecker.State => x.1) + (TypeChecker.Inner.inferType' annotatedPiInnerKernel false + (TypeChecker.Methods.withFuel 9999) + annotatedPiCtorCandidateContext.toTypeChecker + ({} : TypeChecker.State)) = + .ok (.sort (.succ .zero)) + unfold annotatedPiInnerKernel TypeChecker.Inner.inferType' + simp [annotatedPiRawDomainKernel, + Expr.hasLooseBVars, Expr.looseBVarRange', + TypeChecker.Inner.inferType', + TypeChecker.Inner.inferForall, TypeChecker.Inner.inferForall.loop, + TypeChecker.Inner.inferApp, + Bind.bind, ReaderT.bind, StateT.bind, Except.bind] + rw [annotatedPiIsDefEqSort 9998] + simp [annotatedPiOutParamFnType, annotatedPiOutParamArgState, + annotatedPiOutParamFnState, Expr.bindingBody!, + Expr.instantiate1_eq, Expr.instantiate1', + annotatedPiWithLocalDecl, annotatedPiCtorCandidateContext, + AddInductive.Context.toTypeChecker, + Std.HashMap.getElem?_insert, + Bind.bind, ReaderT.bind, StateT.bind, Except.bind] + simp [Expr.sortLevel!, annotatedPi_mkLevelIMaxSuccZero] + rfl -private def aliasRecCtorEvidence : - ∃ A, TypeChecker.DefEqEvidence aliasRecTypeEnv 0 [] - aliasRecRawType.ctors[0].type aliasRecViewCtor.type A := by - exact ⟨.sort (.imax (.succ .zero) (.succ .zero)), - .forallE aliasRecFieldEvidence - (.refl (aliasRecResult_hasType rfl))⟩ +private theorem annotatedPiInner_whnfM : + TypeChecker.M.run annotatedPiCtorCandidateContext.env + annotatedPiCtorCandidateContext.safety + annotatedPiCtorCandidateContext.lctx + annotatedPiCtorCandidateContext.lparams + annotatedPiCtorCandidateContext.fuel + (TypeChecker.whnf annotatedPiInnerKernel) = + .ok annotatedPiInnerKernel := by + rfl -/-- Complete checker-produced semantic normalization certificate for -AliasFormer. -/ -def aliasFormerNormalizationRun : - VInductDecl.NormalizationRun aliasFormerNormalization - typeFamilyAliasEnv := by - refine { - raw := aliasFormerRawType - view := aliasFormerViewType - source_types_eq := rfl - view_types_eq := rfl - family := ?_ - typeEnv := aliasFormerTypeEnv - addType := rfl - constructors := ?_ } - · exact ⟨.sort (.succ (.succ .zero)), - aliasFormerFamilyCandidateRun.evidence⟩ - · refine .cons ?_ .nil - have htype : aliasFormerTypeEnv.HasType 0 [] - (.const aliasFormerRawType.name []) - (aliasFormerRawType.type.instL []) := - .const rfl (fun _ h => nomatch h) rfl - change aliasFormerTypeEnv.HasType 0 [] - aliasFormerRawType.ctors[0].type - (.const ``TypeFamilyAlias []) at htype - exact ⟨.const ``TypeFamilyAlias [], .refl htype⟩ +private theorem annotatedPiInner_isDefEqM : + TypeChecker.M.run annotatedPiCtorCandidateContext.env + annotatedPiCtorCandidateContext.safety + annotatedPiCtorCandidateContext.lctx + annotatedPiCtorCandidateContext.lparams + annotatedPiCtorCandidateContext.fuel + (TypeChecker.isDefEq annotatedPiInnerKernel + annotatedPiInnerKernel) = .ok true := by + change + Except.map (fun x : Bool × TypeChecker.State => x.1) + (TypeChecker.Inner.isDefEq annotatedPiInnerKernel + annotatedPiInnerKernel (TypeChecker.Methods.withFuel 10000) + annotatedPiCtorCandidateContext.toTypeChecker + ({} : TypeChecker.State)) = .ok true + unfold TypeChecker.Inner.isDefEq + rw [if_pos (Expr.eqv_refl _)] + rfl -theorem aliasFormerNormalization_wf_checked : - aliasFormerNormalization.WF typeFamilyAliasEnv := - aliasFormerNormalizationRun.wf +private theorem annotatedPiConst_checkTypeM (lctx : LocalContext) : + TypeChecker.M.run annotatedPiTypeKernelEnv .safe lctx [] + ({} : FuelConfig) + (TypeChecker.checkType (.const ``AnnotatedPi [])) = + .ok (.sort (.succ .zero)) := by + change + Except.map (fun x : Expr × TypeChecker.State => x.1) + (TypeChecker.Inner.inferType (.const ``AnnotatedPi []) false + (TypeChecker.Methods.withFuel 10000) + ({ env := annotatedPiTypeKernelEnv, lctx := lctx } : + TypeChecker.Context) + ({} : TypeChecker.State)) = + .ok (.sort (.succ .zero)) + rw [annotatedPiInferTypeFamily 9999 lctx + ({} : TypeChecker.State) Std.HashMap.getElem?_empty] + rfl -/-- Complete checker-produced semantic normalization certificate for -AliasRec. The field comparison is assembled from verified WHNF, application, -beta, and outer-forall congruence. -/ -def aliasRecNormalizationRun : - VInductDecl.NormalizationRun aliasRecNormalization recAliasEnv := by - refine { - raw := aliasRecRawType - view := aliasRecViewType - source_types_eq := rfl - view_types_eq := rfl - family := ?_ - typeEnv := aliasRecTypeEnv - addType := rfl - constructors := ?_ } - · exact ⟨.sort (.succ (.succ .zero)), - .refl (VEnv.HasType.sort (by decide))⟩ - · exact .cons aliasRecCtorEvidence .nil +private def annotatedPiNormalizationRawContext + (lctx : LocalContext) : TypeChecker.Context := + { env := annotatedPiTypeKernelEnv, lctx := lctx } -theorem aliasRecNormalization_wf_checked : - aliasRecNormalization.WF recAliasEnv := - aliasRecNormalizationRun.wf +private theorem unfoldAnnotatedPi (lctx methods state) : + TypeChecker.Inner.unfoldDefinition (.const ``AnnotatedPi []) + methods (annotatedPiNormalizationRawContext lctx) state = + .ok (none, state) := by + change + TypeChecker.Inner.unfoldDefinitionCore (.const ``AnnotatedPi []) + methods (annotatedPiNormalizationRawContext lctx) state = + .ok (none, state) + simp [TypeChecker.Inner.unfoldDefinitionCore, TypeChecker.Inner.isDelta, + Expr.getAppFn, annotatedPiNormalizationRawContext, + annotatedPiType_lookup_family, Bind.bind, ReaderT.bind, + StateT.bind, Except.bind, annotatedPiInfo, ConstantInfo.deltaValue?] + +private theorem whnfLoopAnnotatedPi (lctx methods state n) : + TypeChecker.Inner.whnf'.loop (.const ``AnnotatedPi []) (n + 1) + methods (annotatedPiNormalizationRawContext lctx) state = + .ok (.const ``AnnotatedPi [], state) := by + unfold TypeChecker.Inner.whnf'.loop + simp [unfoldAnnotatedPi] -/-- The paired AliasFormer block with its normalization component supplied by -the checked WHNF path. The view's structural semantics remain the ordinary -Theory `Checked.WF` proof. -/ -theorem aliasFormerBlock_wf_checked : - aliasFormerBlock.WF typeFamilyAliasEnv := by - refine ⟨aliasFormerNormalization_wf_checked, ?_⟩ - change aliasFormerViewChecked.WF typeFamilyAliasEnv - exact aliasFormerViewChecked.wf_of_decl aliasFormerViewDecl_wf +private theorem annotatedPiConst_whnfM (lctx : LocalContext) : + TypeChecker.M.run annotatedPiTypeKernelEnv .safe lctx [] + ({} : FuelConfig) + (TypeChecker.whnf (.const ``AnnotatedPi [])) = + .ok (.const ``AnnotatedPi []) := by + change + Except.map (fun x : Expr × TypeChecker.State => x.1) + (TypeChecker.Inner.whnf' (.const ``AnnotatedPi []) + (TypeChecker.Methods.withFuel 9999) + (annotatedPiNormalizationRawContext lctx) + ({} : TypeChecker.State)) = + .ok (.const ``AnnotatedPi []) + unfold TypeChecker.Inner.whnf' + simp + rw [show + (if (annotatedPiNormalizationRawContext lctx).eagerReduce then + (annotatedPiNormalizationRawContext lctx).fuel.whnfEager + else (annotatedPiNormalizationRawContext lctx).fuel.whnf) = + 100000 by rfl] + rw [show 100000 = 99999 + 1 by rfl] + rw [whnfLoopAnnotatedPi] + simp [Functor.map, StateT.map, Except.map] -private theorem aliasFormerFamily_defeq_checked : - typeFamilyAliasEnv.IsDefEq 0 [] - (.const ``TypeFamilyAlias []) (.sort (.succ .zero)) - (.sort (.succ (.succ .zero))) := - aliasFormerFamilyWhnfRun.isDefEq - aliasFormerFamilyCheckTypeRun.hasType +private def annotatedPiFamilyCandidateStep : + AddInductive.CandidateWhnfStep where + context := annotatedPiFamilyCandidateContext + source := annotatedPiInfo.type + result := annotatedPiInfo.type -/-- Combining the constructor's exact full-check result with the verified -family-alias WHNF fixes its Theory sort. -/ -theorem aliasFormerCtor_hasSort_checked : - aliasFormerTypeEnv.HasType 0 [] - aliasFormerRawType.ctors[0].type (.sort (.succ .zero)) := by - have halias := - aliasFormerFamily_defeq_checked.mono (VEnv.addConst_le (show - typeFamilyAliasEnv.addConst aliasFormerRawType.name - aliasFormerRawType.toVConstant = some aliasFormerTypeEnv from rfl)) - exact halias.defeq aliasFormerCtor_hasType_checked +private theorem annotatedPiFamilyCandidateStep_valid : + annotatedPiFamilyCandidateStep.Valid := by + exact annotatedPiFamily_whnfM -theorem aliasFormerCtor_isType_checked : - aliasFormerTypeEnv.IsType 0 [] - aliasFormerRawType.ctors[0].type := - ⟨.succ .zero, aliasFormerCtor_hasSort_checked⟩ +private def annotatedPiFamilyCheckTypeStep : + AddInductive.CandidateCheckTypeStep where + context := annotatedPiFamilyCandidateContext + source := annotatedPiInfo.type + inferred := .sort (.succ (.succ .zero)) -/-- Complete checker-side AliasFormer generation run. The family result is the -verified WHNF step, while the unchanged constructor result is staged in the -exact environment produced by inserting the raw family. -/ -def aliasFormerGenerationRun : - VInductDecl.GenerationRun aliasFormerGenerationChecked - typeFamilyAliasEnv := by - refine { - normalization := aliasFormerNormalizationRun - checked := - aliasFormerViewChecked.wf_of_decl aliasFormerViewDecl_wf - familyTel := .nil - familyResult := aliasFormerFamilyCandidateRun.evidence - typeEnv := aliasFormerTypeEnv - addType := rfl - constructors := ?_ } - intro ctor hctor - change ctor ∈ - [⟨aliasFormerRawType.ctors[0], - aliasFormerViewChecked.constructors[0]⟩] at hctor - obtain rfl := List.mem_singleton.1 hctor - exact { - declaredTel := .nil - declaredResult := .refl aliasFormerCtor_hasSort_checked - emittedTel := .nil - emittedResult := .refl aliasFormerCtor_hasSort_checked } +private theorem annotatedPiFamilyCheckTypeStep_valid : + annotatedPiFamilyCheckTypeStep.Valid := by + exact annotatedPiFamily_checkTypeM -/-- Generation-ready AliasFormer certificate whose raw/view family equality -comes from the verified checker execution rather than the fixture's explicit -delta rule. -/ -theorem aliasFormerGenerationChecked_wf_checked : - aliasFormerGenerationChecked.WF typeFamilyAliasEnv := - aliasFormerGenerationRun.wf +private def annotatedPiCtorCandidateStep : + AddInductive.CandidateWhnfStep where + context := annotatedPiCtorCandidateContext + source := annotatedPiMkInfo.type + result := annotatedPiMkInfo.type -/-- The paired AliasRec block with its field normalization supplied by the -checked WHNF/application/beta certificate. -/ -theorem aliasRecBlock_wf_checked : - aliasRecBlock.WF recAliasEnv := by - refine ⟨aliasRecNormalization_wf_checked, ?_⟩ - change aliasRecViewChecked.WF recAliasEnv - exact aliasRecViewChecked.wf_of_decl aliasRecViewDecl_wf +private theorem annotatedPiCtorCandidateStep_valid : + annotatedPiCtorCandidateStep.Valid := by + exact annotatedPiCtor_whnfM -/-- Complete checker-side AliasRec generation run. Its constructor telescope -retains the checked compositional alias equality as pointwise evidence. -/ -def aliasRecGenerationRun : - VInductDecl.GenerationRun aliasRecGenerationChecked recAliasEnv := by - refine { - normalization := aliasRecNormalizationRun - checked := aliasRecViewChecked.wf_of_decl aliasRecViewDecl_wf - familyTel := .nil +private def annotatedPiCtorCheckTypeStep : + AddInductive.CandidateCheckTypeStep where + context := annotatedPiCtorCandidateContext + source := annotatedPiMkInfo.type + inferred := .sort (.succ .zero) + +private theorem annotatedPiCtorCheckTypeStep_valid : + annotatedPiCtorCheckTypeStep.Valid := by + exact annotatedPiCtor_checkTypeM + +private def annotatedPiInnerCandidateStep : + AddInductive.CandidateWhnfStep where + context := annotatedPiCtorCandidateContext + source := annotatedPiInnerKernel + result := annotatedPiInnerKernel + +private theorem annotatedPiInnerCandidateStep_valid : + annotatedPiInnerCandidateStep.Valid := by + exact annotatedPiInner_whnfM + +private def annotatedPiInnerCheckTypeStep : + AddInductive.CandidateCheckTypeStep where + context := annotatedPiCtorCandidateContext + source := annotatedPiInnerKernel + inferred := .sort (.succ .zero) + +private theorem annotatedPiInnerCheckTypeStep_valid : + annotatedPiInnerCheckTypeStep.Valid := by + exact annotatedPiInner_checkTypeM + +private def annotatedPiDomainCandidateStep : + AddInductive.CandidateWhnfStep where + context := annotatedPiCtorCandidateContext + source := annotatedPiRawDomainKernel + result := .sort .zero + +private theorem annotatedPiDomainCandidateStep_valid : + annotatedPiDomainCandidateStep.Valid := by + exact annotatedPiDomain_whnfM + +private def annotatedPiDomainCheckTypeStep : + AddInductive.CandidateCheckTypeStep where + context := annotatedPiCtorCandidateContext + source := annotatedPiRawDomainKernel + inferred := .sort (.succ .zero) + +private theorem annotatedPiDomainCheckTypeStep_valid : + annotatedPiDomainCheckTypeStep.Valid := by + exact annotatedPiDomain_checkTypeM + +private def annotatedPiDomainAnnotations : + AddInductive.CandidateTypeAnnotations + annotatedPiRawDomainKernel where + consumed := .sort .zero + trace := .outParam [.succ .zero] (.sort .zero) (.identity _) + +private theorem annotatedPiDomainAnnotationsEq : + AddInductive.CandidateIsDefEqStep.Valid + ⟨annotatedPiCtorCandidateContext, + annotatedPiRawDomainKernel, + annotatedPiDomainAnnotations.consumed⟩ := by + exact annotatedPiDomain_isDefEqM + +private def annotatedPiInnerAnnotations : + AddInductive.CandidateTypeAnnotations annotatedPiInnerKernel where + consumed := annotatedPiInnerKernel + trace := .identity _ + +private theorem annotatedPiInnerAnnotationsEq : + AddInductive.CandidateIsDefEqStep.Valid + ⟨annotatedPiCtorCandidateContext, annotatedPiInnerKernel, + annotatedPiInnerAnnotations.consumed⟩ := by + exact annotatedPiInner_isDefEqM + +private def annotatedPiInnerBodyCandidateContext : + AddInductive.Context := + annotatedPiCtorCandidateContext.pushLocalDecl + `p .default annotatedPiDomainAnnotations.consumed + +private def annotatedPiOuterBodyCandidateContext : + AddInductive.Context := + annotatedPiCtorCandidateContext.pushLocalDecl + annotatedPiOuterName .default annotatedPiInnerAnnotations.consumed + +@[simp] private theorem addInductiveWithReader_apply + {alpha : Type} (f : AddInductive.Context → AddInductive.Context) + (x : AddInductive.M alpha) (context : AddInductive.Context) : + (withReader f x) context = x (f context) := rfl + +@[simp] private theorem addInductiveWithLocalReader_apply + {alpha : Type} (f : LocalContext → LocalContext) + (x : AddInductive.M alpha) (context : AddInductive.Context) : + (MonadWithReaderOf.withReader (m := AddInductive.M) f x) context = + x { context with lctx := f context.lctx } := rfl + +private theorem annotatedPiCtorCandidateFresh : + annotatedPiCtorCandidateContext.lctx.find? + annotatedPiCtorCandidateContext.freshFVarId = none := by + have h := LocalContext.WF.find?_eq_find?_toList + (fv := annotatedPiCtorCandidateContext.freshFVarId) + LocalContext.WF.nil + change + ({ fvarIdToDecl := PersistentHashMap.empty, + decls := PersistentArray.empty, + auxDeclToFullName := Std.TreeMap.empty } : LocalContext).find? + annotatedPiCtorCandidateContext.freshFVarId = none + rw [h] + simp [LocalContext.toList] + +@[simp] private theorem annotatedPiConst_instantiate1 (arg : Expr) : + (Expr.const ``AnnotatedPi []).instantiate1 arg = + .const ``AnnotatedPi [] := by + simp [Expr.instantiate1_eq, Expr.instantiate1'] + +@[simp] private theorem annotatedPiConst_instantiate1' (arg : Expr) : + (Expr.const ``AnnotatedPi []).instantiate1' arg = + .const ``AnnotatedPi [] := by + rfl + +private def annotatedPiInnerBodyCandidateStep : + AddInductive.CandidateWhnfStep where + context := annotatedPiInnerBodyCandidateContext + source := .const ``AnnotatedPi [] + result := .const ``AnnotatedPi [] + +private theorem annotatedPiInnerBodyCandidateStep_valid : + annotatedPiInnerBodyCandidateStep.Valid := by + exact annotatedPiConst_whnfM _ + +private def annotatedPiInnerBodyCheckTypeStep : + AddInductive.CandidateCheckTypeStep where + context := annotatedPiInnerBodyCandidateContext + source := .const ``AnnotatedPi [] + inferred := .sort (.succ .zero) + +private theorem annotatedPiInnerBodyCheckTypeStep_valid : + annotatedPiInnerBodyCheckTypeStep.Valid := by + exact annotatedPiConst_checkTypeM _ + +private def annotatedPiOuterBodyCandidateStep : + AddInductive.CandidateWhnfStep where + context := annotatedPiOuterBodyCandidateContext + source := .const ``AnnotatedPi [] + result := .const ``AnnotatedPi [] + +private theorem annotatedPiOuterBodyCandidateStep_valid : + annotatedPiOuterBodyCandidateStep.Valid := by + exact annotatedPiConst_whnfM _ + +private def annotatedPiOuterBodyCheckTypeStep : + AddInductive.CandidateCheckTypeStep where + context := annotatedPiOuterBodyCandidateContext + source := .const ``AnnotatedPi [] + inferred := .sort (.succ .zero) + +private theorem annotatedPiOuterBodyCheckTypeStep_valid : + annotatedPiOuterBodyCheckTypeStep.Valid := by + exact annotatedPiConst_checkTypeM _ + +private def annotatedPiDomainCandidateTrace : + AddInductive.CandidateExprTrace annotatedPiCtorCandidateContext + annotatedPiRawDomainKernel := + .terminal annotatedPiCtorCandidateContext + annotatedPiRawDomainKernel (.sort (.succ .zero)) (.sort .zero) + annotatedPiDomainCheckTypeStep_valid + annotatedPiDomainCandidateStep_valid + +private def annotatedPiInnerBodyCandidateTrace : + AddInductive.CandidateExprTrace annotatedPiInnerBodyCandidateContext + ((Expr.const ``AnnotatedPi []).instantiate1 + annotatedPiCtorCandidateContext.freshExpr) := + .terminal annotatedPiInnerBodyCandidateContext + ((Expr.const ``AnnotatedPi []).instantiate1 + annotatedPiCtorCandidateContext.freshExpr) + (.sort (.succ .zero)) + (.const ``AnnotatedPi []) + (by simpa only [annotatedPiInnerBodyCheckTypeStep, + annotatedPiConst_instantiate1] using + annotatedPiInnerBodyCheckTypeStep_valid) + (by simpa only [annotatedPiInnerBodyCandidateStep, + annotatedPiConst_instantiate1] using + annotatedPiInnerBodyCandidateStep_valid) + +private def annotatedPiOuterBodyCandidateTrace : + AddInductive.CandidateExprTrace annotatedPiOuterBodyCandidateContext + ((Expr.const ``AnnotatedPi []).instantiate1 + annotatedPiCtorCandidateContext.freshExpr) := + .terminal annotatedPiOuterBodyCandidateContext + ((Expr.const ``AnnotatedPi []).instantiate1 + annotatedPiCtorCandidateContext.freshExpr) + (.sort (.succ .zero)) + (.const ``AnnotatedPi []) + (by simpa only [annotatedPiOuterBodyCheckTypeStep, + annotatedPiConst_instantiate1] using + annotatedPiOuterBodyCheckTypeStep_valid) + (by simpa only [annotatedPiOuterBodyCandidateStep, + annotatedPiConst_instantiate1] using + annotatedPiOuterBodyCandidateStep_valid) + +private def annotatedPiInnerCandidateTrace : + AddInductive.CandidateExprTrace annotatedPiCtorCandidateContext + annotatedPiInnerKernel := + .forallE annotatedPiCtorCandidateContext annotatedPiInnerKernel + (.sort (.succ .zero)) `p annotatedPiRawDomainKernel + (.const ``AnnotatedPi []) .default annotatedPiCtorCandidateFresh + annotatedPiDomainAnnotations annotatedPiDomainAnnotationsEq + annotatedPiInnerCheckTypeStep_valid + annotatedPiInnerCandidateStep_valid + annotatedPiDomainCandidateTrace annotatedPiInnerBodyCandidateTrace + +private def annotatedPiCtorCandidateTrace : + AddInductive.CandidateExprTrace annotatedPiCtorCandidateContext + annotatedPiMkInfo.type := + .forallE annotatedPiCtorCandidateContext annotatedPiMkInfo.type + (.sort (.succ .zero)) annotatedPiOuterName annotatedPiInnerKernel + (.const ``AnnotatedPi []) .default annotatedPiCtorCandidateFresh + annotatedPiInnerAnnotations annotatedPiInnerAnnotationsEq + annotatedPiCtorCheckTypeStep_valid annotatedPiCtorCandidateStep_valid + annotatedPiInnerCandidateTrace annotatedPiOuterBodyCandidateTrace + +private def annotatedPiFamilyCandidate : + AddInductive.CandidateExpr annotatedPiInfo.type := + ⟨annotatedPiFamilyCandidateContext, + .terminal annotatedPiFamilyCandidateContext annotatedPiInfo.type + (.sort (.succ (.succ .zero))) annotatedPiInfo.type + annotatedPiFamilyCheckTypeStep_valid + annotatedPiFamilyCandidateStep_valid⟩ + +private def annotatedPiCtorCandidate : + AddInductive.CandidateExpr annotatedPiMkInfo.type := + ⟨annotatedPiCtorCandidateContext, annotatedPiCtorCandidateTrace⟩ + +private def annotatedPiConstructorCandidate : + AddInductive.CandidateConstructor annotatedPiKernelCtor := + ⟨annotatedPiCtorCandidate⟩ + +private def annotatedPiFamilyListCandidate : + AddInductive.CandidateFamily annotatedPiKernelType where + familyType := ⟨annotatedPiFamilyCandidate⟩ + constructors := .cons annotatedPiConstructorCandidate .nil + +private def annotatedPiNormalizationCandidate : + AddInductive.NormalizationCandidate [annotatedPiKernelType] where + families := .cons annotatedPiFamilyListCandidate .nil + +private def annotatedPiInductiveStats : AddInductive.InductiveStats where + levels := [] + resultLevel := .succ .zero + nindices := #[0] + indConsts := #[.const ``AnnotatedPi []] + params := #[] + isNotZero := true + +private theorem annotatedPiSortOne_data_hasExprMVar_false : + (Expr.sort (.succ .zero)).data.hasExprMVar = false := by + change (Expr.sort (.succ .zero)).hasExprMVar = false + rw [Expr.hasExprMVar_eq] + rfl + +private theorem annotatedPiSortOne_data_hasLevelMVar_false : + (Expr.sort (.succ .zero)).data.hasLevelMVar = false := by + change (Expr.sort (.succ .zero)).hasLevelMVar = false + rw [Expr.hasLevelMVar_eq] + simp [Expr.hasLevelMVar', Level.hasMVar_eq, Level.hasMVar'] + +private theorem annotatedPiSortOne_data_hasFVar_false : + (Expr.sort (.succ .zero)).data.hasFVar = false := by + change (Expr.sort (.succ .zero)).hasFVar = false + rw [Expr.hasFVar_eq] + rfl + +private theorem annotatedPi_checkInductiveTypes + (k : AddInductive.InductiveStats → AddInductive.M α) : + AddInductive.checkInductiveTypes 0 #[annotatedPiKernelType] k + annotatedPiFamilyCandidateContext = + k annotatedPiInductiveStats annotatedPiFamilyCandidateContext := by + apply AddInductive.checkInductiveTypes_singleton_zero_of_whnf_sort + · decide + · simp [Kernel.Environment.checkNoMVarNoFVar, + Kernel.Environment.checkNoMVar, Kernel.Environment.checkNoFVar, + annotatedPiKernelType, annotatedPiInfo, ConstantInfo.type, + ConstantInfo.toConstantVal, Expr.hasMVar, Expr.hasFVar, + annotatedPiSortOne_data_hasExprMVar_false, + annotatedPiSortOne_data_hasLevelMVar_false, + annotatedPiSortOne_data_hasFVar_false, + Bind.bind, Except.bind, Pure.pure, Except.pure] + · simpa [annotatedPiFamilyCandidateContext, + annotatedPiKernelType] using annotatedPiFamily_checkTypeM + · simpa [annotatedPiFamilyCandidateContext, + annotatedPiKernelType, annotatedPiInfo, ConstantInfo.type, + ConstantInfo.toConstantVal] using annotatedPiFamily_whnfM + · rfl + +private theorem annotatedPiFamilyEnv_not_contains : + outParamKernelEnv.contains ``AnnotatedPi = false := by + unfold Kernel.Environment.contains + change outParamMap.contains ``AnnotatedPi = false + rw [SMap.find?_isSome, annotatedPiType_fresh] + rfl + +private theorem annotatedPiFamilyEnv_checkName : + outParamKernelEnv.checkName ``AnnotatedPi false = .ok () := by + simp [Kernel.Environment.checkName, annotatedPiFamilyEnv_not_contains, + Kernel.Environment.primitives, NameSet.ofList, NameSet.contains, + Bind.bind, Except.bind, Pure.pure, Except.pure] + +private theorem annotatedPiInner_hasIndOcc : + AddInductive.hasIndOcc #[.const ``AnnotatedPi []] + annotatedPiInnerKernel = true := by + simp [AddInductive.hasIndOcc, annotatedPiInnerKernel, + annotatedPiRawDomainKernel, Expr.constName!] + +private theorem annotatedPi_declareInductiveTypes : + AddInductive.declareInductiveTypes annotatedPiInductiveStats 0 + #[annotatedPiKernelType] 0 false annotatedPiFamilyCandidateContext = + .ok annotatedPiTypeKernelEnv := by + simp [AddInductive.declareInductiveTypes, annotatedPiInductiveStats, + annotatedPiKernelType, annotatedPiKernelCtor, + annotatedPiInfo, annotatedPiMkInfo, ConstantInfo.name, + ConstantInfo.type, ConstantInfo.toConstantVal, + annotatedPiFamilyCandidateContext, annotatedPiTypeKernelEnv, + outParamKernelEnv, annotatedPiTypeMap, + AddInductive.isRec, AddInductive.isRec.loop, + AddInductive.isReflexive, AddInductive.isReflexive.loop, + AddInductive.hasIndOcc, Expr.constName!, + Bind.bind, Pure.pure, Except.bind, Except.pure] + rw [show (Kernel.Environment.ofConstants `_annotatedPiCandidate + outParamMap).checkName ``AnnotatedPi = .ok () by + simpa [outParamKernelEnv] using annotatedPiFamilyEnv_checkName] + rfl + +private theorem annotatedPiCtor_data_hasExprMVar_false : + annotatedPiMkInfo.type.data.hasExprMVar = false := by + change annotatedPiMkInfo.type.hasExprMVar = false + rw [Expr.hasExprMVar_eq] + rfl + +private theorem annotatedPiCtor_data_hasLevelMVar_false : + annotatedPiMkInfo.type.data.hasLevelMVar = false := by + change annotatedPiMkInfo.type.hasLevelMVar = false + rw [Expr.hasLevelMVar_eq] + simp [annotatedPiMkInfo, ConstantInfo.type, + ConstantInfo.toConstantVal, Expr.hasLevelMVar', + Level.hasMVar_eq, Level.hasMVar'] + +private theorem annotatedPiCtor_data_hasFVar_false : + annotatedPiMkInfo.type.data.hasFVar = false := by + change annotatedPiMkInfo.type.hasFVar = false + rw [Expr.hasFVar_eq] + rfl + +private theorem annotatedPiCtor_noMVarNoFVar : + annotatedPiTypeKernelEnv.checkNoMVarNoFVar + annotatedPiMkInfo.name annotatedPiMkInfo.type = .ok () := by + simp [Kernel.Environment.checkNoMVarNoFVar, + Kernel.Environment.checkNoMVar, Kernel.Environment.checkNoFVar, + Expr.hasMVar, Expr.hasFVar, + annotatedPiCtor_data_hasExprMVar_false, + annotatedPiCtor_data_hasLevelMVar_false, + annotatedPiCtor_data_hasFVar_false, + Bind.bind, Except.bind, Pure.pure, Except.pure] + +@[simp] private theorem annotatedPiInferConstantFamilyOnly + (lctx : LocalContext) : + TypeChecker.Inner.inferConstant + ({ env := annotatedPiTypeKernelEnv, lctx := lctx } : + TypeChecker.Context) + ``AnnotatedPi [] true = + .ok (.sort (.succ .zero)) := by + unfold TypeChecker.Inner.inferConstant + rw [show annotatedPiTypeKernelEnv.get ``AnnotatedPi = + .ok annotatedPiInfo by exact annotatedPiType_get_family] + simp [annotatedPiInfo, Bind.bind, Except.bind, + annotatedPiExceptPure, ConstantInfo.levelParams, + ConstantInfo.instantiateTypeLevelParams, + ConstantInfo.toConstantVal, + ConstantVal.instantiateTypeLevelParams, + Expr.instantiateLevelParams_eq, + Expr.instantiateLevelParamsCore_id] + +private theorem annotatedPiInferTypeFamilyOnly + (n : Nat) (lctx : LocalContext) (state : TypeChecker.State) + (hcache : + state.inferTypeI[(.const ``AnnotatedPi [] : Expr)]? = none) : + TypeChecker.Inner.inferType (.const ``AnnotatedPi []) true + (TypeChecker.Methods.withFuel (n + 1)) + ({ env := annotatedPiTypeKernelEnv, lctx := lctx } : + TypeChecker.Context) + state = + .ok (.sort (.succ .zero), + { state with + inferTypeI := state.inferTypeI.insert + (.const ``AnnotatedPi []) (.sort (.succ .zero)) }) := by + change + TypeChecker.Inner.inferType' (.const ``AnnotatedPi []) true + (TypeChecker.Methods.withFuel n) + ({ env := annotatedPiTypeKernelEnv, lctx := lctx } : + TypeChecker.Context) + state = _ + unfold TypeChecker.Inner.inferType' + simp [Expr.hasLooseBVars, Expr.looseBVarRange', hcache, + annotatedPiInferConstantFamilyOnly, + Bind.bind, ReaderT.bind, StateT.bind, Except.bind] + +private def annotatedPiInnerInferOnlyLCtx : LocalContext := + ({} : LocalContext).mkLocalDecl + ⟨({} : TypeChecker.State).ngen.curr⟩ `p + annotatedPiRawDomainKernel .default + +private def annotatedPiInnerInferOnlyState : TypeChecker.State := + { annotatedPiDomainInferOnlyState {} with + ngen := ({} : TypeChecker.State).ngen.next } + +private def annotatedPiFamilyInferOnlyState : TypeChecker.State := + { annotatedPiInnerInferOnlyState with + inferTypeI := annotatedPiInnerInferOnlyState.inferTypeI.insert + (.const ``AnnotatedPi []) (.sort (.succ .zero)) } + +@[simp] private theorem annotatedPiInnerInferOnlyState_family_miss : + annotatedPiInnerInferOnlyState.inferTypeI[ + (.const ``AnnotatedPi [] : Expr)]? = none := by + simp [annotatedPiInnerInferOnlyState, + annotatedPiDomainInferOnlyState, annotatedPiRawDomainKernel, + annotatedPiOutParamFnType] + +@[simp] private theorem annotatedPiInferTypeFamilyAfterDomainOnly : + TypeChecker.Inner.inferType' (.const ``AnnotatedPi []) true + (TypeChecker.Methods.withFuel 9998) + ({ env := annotatedPiTypeKernelEnv, lctx := + annotatedPiInnerInferOnlyLCtx } : + TypeChecker.Context) + annotatedPiInnerInferOnlyState = + .ok (.sort (.succ .zero), annotatedPiFamilyInferOnlyState) := by + change + TypeChecker.Inner.inferType (.const ``AnnotatedPi []) true + (TypeChecker.Methods.withFuel 9999) + ({ env := annotatedPiTypeKernelEnv, lctx := + annotatedPiInnerInferOnlyLCtx } : + TypeChecker.Context) + annotatedPiInnerInferOnlyState = _ + simpa [annotatedPiFamilyInferOnlyState] using + annotatedPiInferTypeFamilyOnly 9998 annotatedPiInnerInferOnlyLCtx + annotatedPiInnerInferOnlyState + annotatedPiInnerInferOnlyState_family_miss + +private theorem annotatedPiInferTypeFamilyAfterDomainOnly_exact : + TypeChecker.Inner.inferType (.const ``AnnotatedPi []) true + (TypeChecker.Methods.withFuel 9999) + { annotatedPiCtorCandidateContext.toTypeChecker with + lctx := annotatedPiCtorCandidateContext.toTypeChecker.lctx.mkLocalDecl + ⟨(annotatedPiDomainInferOnlyState {}).ngen.curr⟩ `p + annotatedPiRawDomainKernel .default } + { annotatedPiDomainInferOnlyState {} with + ngen := (annotatedPiDomainInferOnlyState {}).ngen.next } = + .ok (.sort (.succ .zero), annotatedPiFamilyInferOnlyState) := by + simpa [annotatedPiInnerInferOnlyLCtx, + annotatedPiInnerInferOnlyState, annotatedPiCtorCandidateContext, + annotatedPiDomainInferOnlyState, + AddInductive.Context.toTypeChecker] using + annotatedPiInferTypeFamilyAfterDomainOnly + +private theorem annotatedPiInferTypeFamilyAfterDomainOnly_literal : + TypeChecker.Inner.inferType (.const ``AnnotatedPi []) true + (TypeChecker.Methods.withFuel 9999) + { env := annotatedPiCtorCandidateContext.toTypeChecker.env + lctx := annotatedPiCtorCandidateContext.toTypeChecker.lctx.mkLocalDecl + { name := (annotatedPiDomainInferOnlyState {}).ngen.curr } `p + (.app (.const ``outParam [.succ .zero]) (.sort .zero)) + .default + safety := annotatedPiCtorCandidateContext.toTypeChecker.safety + eagerReduce := + annotatedPiCtorCandidateContext.toTypeChecker.eagerReduce + lparams := annotatedPiCtorCandidateContext.toTypeChecker.lparams + fuel := annotatedPiCtorCandidateContext.toTypeChecker.fuel } + { ngen := (annotatedPiDomainInferOnlyState {}).ngen.next + inferTypeI := (annotatedPiDomainInferOnlyState {}).inferTypeI + inferTypeC := (annotatedPiDomainInferOnlyState {}).inferTypeC + whnfCoreCache := + (annotatedPiDomainInferOnlyState {}).whnfCoreCache + whnfCache := (annotatedPiDomainInferOnlyState {}).whnfCache + eqvManager := (annotatedPiDomainInferOnlyState {}).eqvManager + failure := (annotatedPiDomainInferOnlyState {}).failure + unfold := (annotatedPiDomainInferOnlyState {}).unfold } = + .ok (.sort (.succ .zero), annotatedPiFamilyInferOnlyState) := by + simpa [annotatedPiRawDomainKernel] using + annotatedPiInferTypeFamilyAfterDomainOnly_exact + +private def annotatedPiInnerInferOnlyFinalState : TypeChecker.State := + { annotatedPiFamilyInferOnlyState with + inferTypeI := annotatedPiFamilyInferOnlyState.inferTypeI.insert + annotatedPiInnerKernel (.sort (.succ .zero)) } + +private theorem annotatedPiInner_inferTypeInner : + TypeChecker.Inner.inferType annotatedPiInnerKernel true + (TypeChecker.Methods.withFuel 10000) + annotatedPiCtorCandidateContext.toTypeChecker + ({} : TypeChecker.State) = + .ok (.sort (.succ .zero), + annotatedPiInnerInferOnlyFinalState) := by + change + TypeChecker.Inner.inferType' annotatedPiInnerKernel true + (TypeChecker.Methods.withFuel 9999) + annotatedPiCtorCandidateContext.toTypeChecker + ({} : TypeChecker.State) = _ + unfold annotatedPiInnerKernel TypeChecker.Inner.inferType' + simp [annotatedPiRawDomainKernel, + Expr.hasLooseBVars, Expr.looseBVarRange', + TypeChecker.Inner.inferForall, TypeChecker.Inner.inferForall.loop, + Bind.bind, ReaderT.bind, StateT.bind, Except.bind] + rw [show TypeChecker.Inner.inferType' + (.app (.const ``outParam [.succ .zero]) (.sort .zero)) true + (TypeChecker.Methods.withFuel 9998) + annotatedPiCtorCandidateContext.toTypeChecker + ({} : TypeChecker.State) = + .ok (.sort (.succ .zero), + annotatedPiDomainInferOnlyState {}) by + exact annotatedPiInferTypeDomainOnlyAny {}] + simp only [TypeChecker.Inner.ensureSortCore, Expr.isSort, + if_true, annotatedPiWithLocalDecl, Expr.instantiate1', + annotatedPiRecMPure, Bind.bind, ReaderT.bind, + StateT.bind, Except.bind] + rw [annotatedPiInferTypeFamilyAfterDomainOnly_literal] + simp [Expr.sortLevel!, annotatedPiInnerInferOnlyFinalState, + annotatedPiInnerKernel, annotatedPiRawDomainKernel] + +private theorem annotatedPiInner_inferTypeM : + TypeChecker.M.run annotatedPiCtorCandidateContext.env + annotatedPiCtorCandidateContext.safety + annotatedPiCtorCandidateContext.lctx + annotatedPiCtorCandidateContext.lparams + annotatedPiCtorCandidateContext.fuel + (TypeChecker.inferType annotatedPiInnerKernel) = + .ok (.sort (.succ .zero)) := by + change + Except.map (fun x : Expr × TypeChecker.State => x.1) + (TypeChecker.Inner.inferType annotatedPiInnerKernel true + (TypeChecker.Methods.withFuel 10000) + annotatedPiCtorCandidateContext.toTypeChecker + ({} : TypeChecker.State)) = + .ok (.sort (.succ .zero)) + rw [annotatedPiInner_inferTypeInner] + rfl + +private theorem annotatedPiInner_ensureTypeM : + TypeChecker.M.run annotatedPiCtorCandidateContext.env + annotatedPiCtorCandidateContext.safety + annotatedPiCtorCandidateContext.lctx + annotatedPiCtorCandidateContext.lparams + annotatedPiCtorCandidateContext.fuel + (TypeChecker.ensureType annotatedPiInnerKernel) = + .ok (.sort (.succ .zero)) := by + unfold TypeChecker.ensureType TypeChecker.inferType + TypeChecker.ensureSort TypeChecker.RecM.run TypeChecker.M.run + simp only [readThe, MonadReaderOf.read, ReaderT.read, + Bind.bind, ReaderT.bind, StateT.bind, Except.bind, + Pure.pure, StateT.pure, Except.pure, StateT.run', + Functor.map, Except.map] + rw [show TypeChecker.Inner.inferType annotatedPiInnerKernel true + (TypeChecker.Methods.withFuel + annotatedPiCtorCandidateContext.fuel.recDepth) + { env := annotatedPiCtorCandidateContext.env + lctx := annotatedPiCtorCandidateContext.lctx + safety := annotatedPiCtorCandidateContext.safety + lparams := annotatedPiCtorCandidateContext.lparams + fuel := annotatedPiCtorCandidateContext.fuel } + ({} : TypeChecker.State) = + .ok (.sort (.succ .zero), + annotatedPiInnerInferOnlyFinalState) by + simpa [annotatedPiCtorCandidateContext, + AddInductive.Context.toTypeChecker] using + annotatedPiInner_inferTypeInner] + rfl + +private theorem annotatedPiCtor_getEnvM : + TypeChecker.M.run annotatedPiCtorCandidateContext.env + annotatedPiCtorCandidateContext.safety + annotatedPiCtorCandidateContext.lctx + annotatedPiCtorCandidateContext.lparams + annotatedPiCtorCandidateContext.fuel TypeChecker.getEnv = + .ok annotatedPiTypeKernelEnv := by + rfl + +private theorem annotatedPiRawDomain_hasIndOcc_false : + AddInductive.hasIndOcc annotatedPiInductiveStats.indConsts + annotatedPiRawDomainKernel = false := by + simp [AddInductive.hasIndOcc, annotatedPiInductiveStats, + annotatedPiRawDomainKernel, Expr.constName!] + +private theorem annotatedPiConst_isValidIndAppIdx : + AddInductive.isValidIndAppIdx annotatedPiInductiveStats + (.const ``AnnotatedPi []) 0 = true := by + simp +decide [AddInductive.isValidIndAppIdx, + annotatedPiInductiveStats, Expr.getAppFn, Expr.getAppArgs, + Expr.getAppNumArgs] + +private theorem annotatedPiInner_stats_hasIndOcc : + AddInductive.hasIndOcc annotatedPiInductiveStats.indConsts + annotatedPiInnerKernel = true := by + simpa [annotatedPiInductiveStats] using annotatedPiInner_hasIndOcc + +private theorem annotatedPiConst_hasIndOcc : + AddInductive.hasIndOcc annotatedPiInductiveStats.indConsts + (.const ``AnnotatedPi []) = true := by + simp [AddInductive.hasIndOcc, annotatedPiInductiveStats, + Expr.constName!] + +private theorem annotatedPiConst_isValidIndApp : + AddInductive.isValidIndApp? annotatedPiInductiveStats + (.const ``AnnotatedPi []) = some 0 := by + exact AddInductive.isValidIndApp?_singleton_zero + annotatedPiInductiveStats (.const ``AnnotatedPi []) rfl + annotatedPiConst_isValidIndAppIdx + +private theorem annotatedPi_checkPositivity_terminal : + AddInductive.checkPositivity.loop annotatedPiInductiveStats + annotatedPiMkInfo.name 0 (.const ``AnnotatedPi []) 999 + annotatedPiInnerBodyCandidateContext = .ok () := by + rw [show 999 = 998 + 1 by rfl] + unfold AddInductive.checkPositivity.loop + simp only [ReaderT.bind, Bind.bind] + rw [AddInductive.liftTypeChecker_apply] + rw [show TypeChecker.M.run + annotatedPiInnerBodyCandidateContext.env + annotatedPiInnerBodyCandidateContext.safety + annotatedPiInnerBodyCandidateContext.lctx + annotatedPiInnerBodyCandidateContext.lparams + annotatedPiInnerBodyCandidateContext.fuel + (TypeChecker.whnf (.const ``AnnotatedPi [])) = + .ok (.const ``AnnotatedPi []) by + exact annotatedPiConst_whnfM _] + simp [annotatedPiConst_hasIndOcc, annotatedPiConst_isValidIndApp, + Bind.bind, ReaderT.bind, ReaderT.pure, Pure.pure, + Except.bind, Except.pure] + +private theorem annotatedPi_checkPositivity : + AddInductive.checkPositivity annotatedPiInductiveStats + annotatedPiInnerKernel annotatedPiMkInfo.name 0 + annotatedPiCtorCandidateContext = .ok () := by + unfold AddInductive.checkPositivity + simp only [readThe, MonadReaderOf.read, ReaderT.read, + ReaderT.bind, Bind.bind, ReaderT.pure, Pure.pure, + Except.bind, Except.pure] + rw [show annotatedPiCtorCandidateContext.fuel.inductiveFuel = + 999 + 1 by rfl] + unfold AddInductive.checkPositivity.loop + simp only [ReaderT.bind, Bind.bind] + rw [AddInductive.liftTypeChecker_apply] + rw [annotatedPiInner_whnfM] + simp only [Except.bind] + rw [show AddInductive.hasIndOcc annotatedPiInductiveStats.indConsts + annotatedPiInnerKernel = true by + exact annotatedPiInner_stats_hasIndOcc] + simp only [Bool.not_true, Bool.false_eq_true, if_false, + ReaderT.pure, Pure.pure, ReaderT.bind, Bind.bind, + Except.bind, Except.pure] + unfold annotatedPiInnerKernel + simp only + rw [show AddInductive.hasIndOcc annotatedPiInductiveStats.indConsts + annotatedPiRawDomainKernel = false by + exact annotatedPiRawDomain_hasIndOcc_false] + simp only [Bool.false_eq_true, if_false, Expr.instantiate1', + ReaderT.bind, Bind.bind, ReaderT.pure, Pure.pure, + Except.bind, Except.pure] + simpa [withLocalDecl, annotatedPiInnerBodyCandidateContext, + withFreshId, MonadLocalNameGenerator.withFreshId, + MonadWithReader.withReader, withTheReader, + AddInductive.Context.pushLocalDecl, + AddInductive.Context.freshExpr, AddInductive.Context.freshFVarId, + AddInductive.consumeTypeAnnotations, annotatedPiDomainAnnotations, + annotatedPiRawDomainKernel, annotatedPiCtorCandidateContext] using + annotatedPi_checkPositivity_terminal + +private theorem annotatedPiInner_ensureTypeM_expanded : + TypeChecker.M.run annotatedPiCtorCandidateContext.env + annotatedPiCtorCandidateContext.safety + annotatedPiCtorCandidateContext.lctx + annotatedPiCtorCandidateContext.lparams + annotatedPiCtorCandidateContext.fuel + (TypeChecker.ensureType + (.forallE `p + (.app (.const ``outParam [.succ .zero]) (.sort .zero)) + (.const ``AnnotatedPi []) .default)) = + .ok (.sort (.succ .zero)) := by + simpa [annotatedPiInnerKernel, annotatedPiRawDomainKernel] using + annotatedPiInner_ensureTypeM + +private theorem annotatedPi_checkPositivity_expanded : + AddInductive.checkPositivity annotatedPiInductiveStats + (.forallE `p + (.app (.const ``outParam [.succ .zero]) (.sort .zero)) + (.const ``AnnotatedPi []) .default) + ``AnnotatedPi.mk 0 annotatedPiCtorCandidateContext = .ok () := by + simpa [annotatedPiMkInfo, ConstantInfo.name, + ConstantInfo.toConstantVal, annotatedPiInnerKernel, + annotatedPiRawDomainKernel] using annotatedPi_checkPositivity + +private theorem annotatedPi_checkConstructors_terminal : + AddInductive.checkConstructors.loop annotatedPiInductiveStats false 0 + ``AnnotatedPi.mk (.const ``AnnotatedPi []) 1 999 + annotatedPiOuterBodyCandidateContext = .ok () := by + rw [show 999 = 998 + 1 by rfl] + unfold AddInductive.checkConstructors.loop + simp [annotatedPiConst_isValidIndAppIdx, + ReaderT.pure, Pure.pure, Except.pure] + +private theorem annotatedPi_checkConstructors_terminal_expanded : + AddInductive.checkConstructors.loop annotatedPiInductiveStats false 0 + ``AnnotatedPi.mk (.const ``AnnotatedPi []) 1 999 + ({ env := annotatedPiTypeKernelEnv + lctx := ({} : LocalContext).mkLocalDecl + ⟨({ namePrefix := `_ind_fresh } : NameGenerator).curr⟩ + (.mkNum + (.mkStr + (.mkStr (.mkStr (.mkStr .anonymous "a") "_@") + "_internal") "_hyg") 0) + (.forallE `p + (.app (.const ``outParam [.succ .zero]) (.sort .zero)) + (.const ``AnnotatedPi []) .default) + .default + lparams := [] + ngen := ({ namePrefix := `_ind_fresh } : NameGenerator).next + safety := .safe + allowPrimitive := false } : AddInductive.Context) = .ok () := by + simpa [annotatedPiOuterBodyCandidateContext, + AddInductive.Context.pushLocalDecl, + AddInductive.Context.freshFVarId, + annotatedPiInnerAnnotations, annotatedPiOuterName, + annotatedPiInnerKernel, annotatedPiRawDomainKernel, + annotatedPiCtorCandidateContext] using + annotatedPi_checkConstructors_terminal + +private theorem annotatedPiCtor_noMVarNoFVar_literal : + annotatedPiTypeKernelEnv.checkNoMVarNoFVar + ``AnnotatedPi.mk + (.forallE annotatedPiOuterName annotatedPiInnerKernel + (.const ``AnnotatedPi []) .default) = .ok () := by + simpa [annotatedPiMkInfo, ConstantInfo.name, ConstantInfo.type, + ConstantInfo.toConstantVal, annotatedPiInnerKernel, + annotatedPiRawDomainKernel, annotatedPiOuterName] using + annotatedPiCtor_noMVarNoFVar + +private theorem annotatedPiCtor_noMVarNoFVar_projected : + annotatedPiTypeKernelEnv.checkNoMVarNoFVar + annotatedPiMkInfo.toConstantVal.name annotatedPiMkInfo.type = + .ok () := by + simpa [ConstantInfo.name] using annotatedPiCtor_noMVarNoFVar + +private theorem annotatedPiCtor_checkTypeM_literal : + TypeChecker.M.run annotatedPiCtorCandidateContext.env + annotatedPiCtorCandidateContext.safety + annotatedPiCtorCandidateContext.lctx + annotatedPiCtorCandidateContext.lparams + annotatedPiCtorCandidateContext.fuel + (TypeChecker.checkType + (.forallE annotatedPiOuterName annotatedPiInnerKernel + (.const ``AnnotatedPi []) .default)) = + .ok (.sort (.succ .zero)) := by + simpa [annotatedPiMkInfo, ConstantInfo.type, + ConstantInfo.toConstantVal, annotatedPiInnerKernel, + annotatedPiRawDomainKernel, annotatedPiOuterName] using + annotatedPiCtor_checkTypeM + +private theorem annotatedPiCtor_noMVarNoFVar_expanded : + annotatedPiTypeKernelEnv.checkNoMVarNoFVar ``AnnotatedPi.mk + (.forallE + (.mkNum + (.mkStr + (.mkStr (.mkStr (.mkStr .anonymous "a") "_@") + "_internal") "_hyg") 0) + (.forallE `p + (.app (.const ``outParam [.succ .zero]) (.sort .zero)) + (.const ``AnnotatedPi []) .default) + (.const ``AnnotatedPi []) .default) = .ok () := by + simpa [annotatedPiMkInfo, ConstantInfo.name, ConstantInfo.type, + ConstantInfo.toConstantVal, annotatedPiOuterName, + annotatedPiInnerKernel, annotatedPiRawDomainKernel] using + annotatedPiCtor_noMVarNoFVar + +private theorem annotatedPiCtor_checkTypeM_expanded : + TypeChecker.M.run annotatedPiCtorCandidateContext.env + annotatedPiCtorCandidateContext.safety + annotatedPiCtorCandidateContext.lctx + annotatedPiCtorCandidateContext.lparams + annotatedPiCtorCandidateContext.fuel + (TypeChecker.checkType + (.forallE + (.mkNum + (.mkStr + (.mkStr (.mkStr (.mkStr .anonymous "a") "_@") + "_internal") "_hyg") 0) + (.forallE `p + (.app (.const ``outParam [.succ .zero]) (.sort .zero)) + (.const ``AnnotatedPi []) .default) + (.const ``AnnotatedPi []) .default)) = + .ok (.sort (.succ .zero)) := by + simpa [annotatedPiMkInfo, ConstantInfo.type, + ConstantInfo.toConstantVal, annotatedPiOuterName, + annotatedPiInnerKernel, annotatedPiRawDomainKernel] using + annotatedPiCtor_checkTypeM + +private theorem annotatedPiCtor_checkTypeM_empty : + TypeChecker.M.run annotatedPiCtorCandidateContext.env + annotatedPiCtorCandidateContext.safety {} + annotatedPiCtorCandidateContext.lparams + annotatedPiCtorCandidateContext.fuel + (TypeChecker.checkType + (.forallE + (.mkNum + (.mkStr + (.mkStr (.mkStr (.mkStr .anonymous "a") "_@") + "_internal") "_hyg") 0) + (.forallE `p + (.app (.const ``outParam [.succ .zero]) (.sort .zero)) + (.const ``AnnotatedPi []) .default) + (.const ``AnnotatedPi []) .default)) = + .ok (.sort (.succ .zero)) := by + simpa [annotatedPiCtorCandidateContext] using + annotatedPiCtor_checkTypeM_expanded + +private theorem annotatedPi_checkConstructors : + AddInductive.checkConstructors #[annotatedPiKernelType] + annotatedPiInductiveStats false + annotatedPiCtorCandidateContext = .ok () := by + unfold AddInductive.checkConstructors + simp only [ReaderT.bind, Bind.bind] + rw [AddInductive.liftTypeChecker_apply] + rw [annotatedPiCtor_getEnvM] + simp only [Except.bind] + simp +decide [annotatedPiKernelType, annotatedPiKernelCtor, + annotatedPiMkInfo, ConstantInfo.name, ConstantInfo.type, + ConstantInfo.toConstantVal, NameSet.contains] + rw [annotatedPiCtor_noMVarNoFVar_expanded] + simp only [ReaderT.bind, Bind.bind, ReaderT.pure, Pure.pure, + Except.bind, Except.pure] + rw [AddInductive.withEmptyLocalContext_apply] + rw [AddInductive.liftTypeChecker_apply] + simp only + rw [annotatedPiCtor_checkTypeM_empty] + simp only [Except.bind] + simp +decide [ConstantInfo.type, ConstantInfo.toConstantVal, + AddInductive.liftTypeChecker_apply, + readThe, MonadReaderOf.read, ReaderT.read, + ReaderT.bind, Bind.bind, ReaderT.pure, Pure.pure, + Except.bind, Except.pure] + rw [show annotatedPiCtorCandidateContext.fuel.inductiveFuel = + 999 + 1 by rfl] + unfold AddInductive.checkConstructors.loop + simp only + rw [show annotatedPiInductiveStats.params[0]? = none by rfl] + simp only + simp only [ReaderT.bind, Bind.bind] + rw [AddInductive.liftTypeChecker_apply] + rw [annotatedPiInner_ensureTypeM_expanded] + simp only [Except.bind, Expr.sortLevel!] + rw [show AddInductive.levelStructGe + annotatedPiInductiveStats.resultLevel (.succ .zero) = true by rfl] + simp only [if_true] + simp only [Bool.not_false, if_true, + ReaderT.bind, Bind.bind, ReaderT.pure, Pure.pure, + Except.bind, Except.pure] + rw [annotatedPi_checkPositivity_expanded] + simp only [Except.bind] + simp only [AddInductive.withLocalDecl_apply, + annotatedPiConst_instantiate1, annotatedPiConst_instantiate1', + annotatedPiOuterBodyCandidateContext, + AddInductive.Context.pushLocalDecl, + AddInductive.Context.freshExpr, AddInductive.Context.freshFVarId, + AddInductive.consumeTypeAnnotations, annotatedPiInnerAnnotations, + annotatedPiInnerKernel, annotatedPiRawDomainKernel, + annotatedPiCtorCandidateContext, + ReaderT.pure, Pure.pure, Except.pure] + rw [annotatedPi_checkConstructors_terminal_expanded] + simp [ReaderT.pure, Pure.pure, Except.pure] + +private theorem annotatedPiSortAnnotationTrace_build : + AddInductive.CandidateTypeAnnotationTrace.build (.sort .zero) = + ⟨.sort .zero, .identity _⟩ := by + simp [AddInductive.CandidateTypeAnnotationTrace.build] + +private theorem annotatedPiDomainAnnotationTrace_build : + AddInductive.CandidateTypeAnnotationTrace.build + annotatedPiRawDomainKernel = + ⟨.sort .zero, + .outParam [.succ .zero] (.sort .zero) (.identity _)⟩ := by + simp [AddInductive.CandidateTypeAnnotationTrace.build, + annotatedPiRawDomainKernel, annotatedPiSortAnnotationTrace_build] + rw [annotatedPiSortAnnotationTrace_build] + +private theorem annotatedPiInnerAnnotationTrace_build : + AddInductive.CandidateTypeAnnotationTrace.build + annotatedPiInnerKernel = + ⟨annotatedPiInnerKernel, .identity _⟩ := by + simp [AddInductive.CandidateTypeAnnotationTrace.build, + annotatedPiInnerKernel] + +private theorem annotatedPiDomainAnnotations_produced : + AddInductive.buildCandidateTypeAnnotations + annotatedPiRawDomainKernel = + .ok annotatedPiDomainAnnotations := by + unfold AddInductive.buildCandidateTypeAnnotations + rw [annotatedPiDomainAnnotationTrace_build] + rfl + +private theorem annotatedPiInnerAnnotations_produced : + AddInductive.buildCandidateTypeAnnotations annotatedPiInnerKernel = + .ok annotatedPiInnerAnnotations := by + unfold AddInductive.buildCandidateTypeAnnotations + rw [annotatedPiInnerAnnotationTrace_build] + rfl + +private theorem annotatedPiDomainCandidateTrace_loop (fuel : Nat) : + AddInductive.buildCandidateExpr.loop + annotatedPiCtorCandidateContext annotatedPiRawDomainKernel + (fuel + 1) = + .ok annotatedPiDomainCandidateTrace := by + simpa only [annotatedPiDomainCandidateTrace] using + AddInductive.buildCandidateExpr_loop_of_whnf_nonForall + annotatedPiCtorCandidateContext annotatedPiRawDomainKernel + (.sort (.succ .zero)) (.sort .zero) fuel + annotatedPiDomainCheckTypeStep_valid + annotatedPiDomainCandidateStep_valid rfl + +private theorem annotatedPiInnerBodyCandidateTrace_loop (fuel : Nat) : + AddInductive.buildCandidateExpr.loop + annotatedPiInnerBodyCandidateContext + ((Expr.const ``AnnotatedPi []).instantiate1 + annotatedPiCtorCandidateContext.freshExpr) + (fuel + 1) = + .ok annotatedPiInnerBodyCandidateTrace := by + simpa only [annotatedPiInnerBodyCandidateTrace] using + AddInductive.buildCandidateExpr_loop_of_whnf_nonForall + annotatedPiInnerBodyCandidateContext + ((Expr.const ``AnnotatedPi []).instantiate1 + annotatedPiCtorCandidateContext.freshExpr) + (.sort (.succ .zero)) (.const ``AnnotatedPi []) fuel + (by simpa only [annotatedPiInnerBodyCheckTypeStep, + annotatedPiConst_instantiate1] using + annotatedPiInnerBodyCheckTypeStep_valid) + (by simpa only [annotatedPiInnerBodyCandidateStep, + annotatedPiConst_instantiate1] using + annotatedPiInnerBodyCandidateStep_valid) rfl + +private theorem annotatedPiOuterBodyCandidateTrace_loop (fuel : Nat) : + AddInductive.buildCandidateExpr.loop + annotatedPiOuterBodyCandidateContext + ((Expr.const ``AnnotatedPi []).instantiate1 + annotatedPiCtorCandidateContext.freshExpr) + (fuel + 1) = + .ok annotatedPiOuterBodyCandidateTrace := by + simpa only [annotatedPiOuterBodyCandidateTrace] using + AddInductive.buildCandidateExpr_loop_of_whnf_nonForall + annotatedPiOuterBodyCandidateContext + ((Expr.const ``AnnotatedPi []).instantiate1 + annotatedPiCtorCandidateContext.freshExpr) + (.sort (.succ .zero)) (.const ``AnnotatedPi []) fuel + (by simpa only [annotatedPiOuterBodyCheckTypeStep, + annotatedPiConst_instantiate1] using + annotatedPiOuterBodyCheckTypeStep_valid) + (by simpa only [annotatedPiOuterBodyCandidateStep, + annotatedPiConst_instantiate1] using + annotatedPiOuterBodyCandidateStep_valid) rfl + +private theorem annotatedPiInnerCandidateTrace_loop : + AddInductive.buildCandidateExpr.loop + annotatedPiCtorCandidateContext annotatedPiInnerKernel 999 = + .ok annotatedPiInnerCandidateTrace := by + rw [show 999 = 998 + 1 by rfl] + simpa only [annotatedPiInnerCandidateTrace, + annotatedPiInnerBodyCandidateContext] using + (AddInductive.buildCandidateExpr_loop_of_whnf_forall + (context := annotatedPiCtorCandidateContext) + (e := annotatedPiInnerKernel) + (inferred := .sort (.succ .zero)) + (fuel := 998) + (name := `p) + (domain := annotatedPiRawDomainKernel) + (body := .const ``AnnotatedPi []) + (binderInfo := .default) + (hfresh := annotatedPiCtorCandidateFresh) + (annotations := annotatedPiDomainAnnotations) + (hannotations := annotatedPiDomainAnnotations_produced) + (hannotationsEq := annotatedPiDomainAnnotationsEq) + (hcheck := annotatedPiInnerCheckTypeStep_valid) + (hrun := annotatedPiInnerCandidateStep_valid) + (domainCandidate := annotatedPiDomainCandidateTrace) + (bodyCandidate := annotatedPiInnerBodyCandidateTrace) + (hdomain := by + simpa using annotatedPiDomainCandidateTrace_loop 997) + (hbody := by + simpa [annotatedPiInnerBodyCandidateContext] using + annotatedPiInnerBodyCandidateTrace_loop 997)) + +private theorem annotatedPiCtorCandidateTrace_loop : + AddInductive.buildCandidateExpr.loop + annotatedPiCtorCandidateContext annotatedPiMkInfo.type + annotatedPiCtorCandidateContext.fuel.inductiveFuel = + .ok annotatedPiCtorCandidateTrace := by + change AddInductive.buildCandidateExpr.loop + annotatedPiCtorCandidateContext annotatedPiMkInfo.type + (999 + 1) = _ + simpa only [annotatedPiCtorCandidateTrace, + annotatedPiOuterBodyCandidateContext] using + (AddInductive.buildCandidateExpr_loop_of_whnf_forall + (context := annotatedPiCtorCandidateContext) + (e := annotatedPiMkInfo.type) + (inferred := .sort (.succ .zero)) + (fuel := 999) + (name := annotatedPiOuterName) + (domain := annotatedPiInnerKernel) + (body := .const ``AnnotatedPi []) + (binderInfo := .default) + (hfresh := annotatedPiCtorCandidateFresh) + (annotations := annotatedPiInnerAnnotations) + (hannotations := annotatedPiInnerAnnotations_produced) + (hannotationsEq := annotatedPiInnerAnnotationsEq) + (hcheck := annotatedPiCtorCheckTypeStep_valid) + (hrun := annotatedPiCtorCandidateStep_valid) + (domainCandidate := annotatedPiInnerCandidateTrace) + (bodyCandidate := annotatedPiOuterBodyCandidateTrace) + (hdomain := annotatedPiInnerCandidateTrace_loop) + (hbody := by + simpa [annotatedPiOuterBodyCandidateContext] using + annotatedPiOuterBodyCandidateTrace_loop 998)) + +/-- The executable candidate traversal returns the exact nested-forall +AnnotatedPi constructor trace, including both annotation boundaries and the +two recursively extended body contexts. -/ +theorem annotatedPiCtor_candidateTrace : + AddInductive.buildCandidateExpr annotatedPiMkInfo.type + annotatedPiCtorCandidateContext = + .ok annotatedPiCtorCandidate := by + unfold AddInductive.buildCandidateExpr + simp only [readThe, MonadReaderOf.read, ReaderT.read, + ReaderT.bind, Bind.bind, ReaderT.pure, Pure.pure, + Except.bind, Except.pure] + rw [annotatedPiCtorCandidateTrace_loop] + rfl + +/-- The family position is the exact terminal candidate returned in the +pre-family environment. -/ +theorem annotatedPiFamily_candidateTrace : + AddInductive.buildCandidateExpr annotatedPiInfo.type + annotatedPiFamilyCandidateContext = + .ok annotatedPiFamilyCandidate := by + apply AddInductive.buildCandidateExpr_of_whnf_nonForall + · decide + · rfl + +private def annotatedPiFamilyTypeListProduced : + AddInductive.CandidateFamilyTypeListProduced + annotatedPiFamilyCandidateContext + (.cons annotatedPiFamilyListCandidate.familyType .nil) := by + exact .cons (by + unfold AddInductive.normalizeCandidateFamilyType + simp only [ReaderT.bind, Bind.bind] + simp only [annotatedPiKernelType] + rw [annotatedPiFamily_candidateTrace] + rfl) .nil + +private theorem annotatedPiFamilyTypeList_candidateTrace : + AddInductive.normalizeCandidateFamilyTypeList + [annotatedPiKernelType] annotatedPiFamilyCandidateContext = + .ok (.cons annotatedPiFamilyListCandidate.familyType .nil) := by + exact annotatedPiFamilyTypeListProduced.normalize + +private def annotatedPiConstructorListProduced : + AddInductive.CandidateConstructorListProduced + annotatedPiCtorCandidateContext + annotatedPiFamilyListCandidate.constructors := by + exact .cons (by + unfold AddInductive.normalizeCandidateConstructor + simp only [ReaderT.bind, Bind.bind] + simp only [annotatedPiKernelCtor] + rw [annotatedPiCtor_candidateTrace] + rfl) .nil + +private theorem annotatedPiConstructorList_candidateTrace : + AddInductive.normalizeCandidateConstructorList + annotatedPiKernelType.ctors annotatedPiCtorCandidateContext = + .ok annotatedPiFamilyListCandidate.constructors := by + exact annotatedPiConstructorListProduced.normalize + +private def annotatedPiFamilyListProduced : + AddInductive.CandidateFamilyListProduced + annotatedPiCtorCandidateContext + (.cons annotatedPiFamilyListCandidate.familyType .nil) + annotatedPiNormalizationCandidate.families := by + exact .cons annotatedPiConstructorListProduced .nil + +private theorem annotatedPiFamilyList_candidateTrace : + AddInductive.normalizeCandidateFamilyList + (.cons annotatedPiFamilyListCandidate.familyType .nil) + annotatedPiCtorCandidateContext = + .ok annotatedPiNormalizationCandidate.families := by + exact annotatedPiFamilyListProduced.normalize + +/-- The complete positive AnnotatedPi metadata request selects the exact +nested-forall normalization candidate in the real pre-family and post-family +checker environments. -/ +theorem annotatedPiNormalizationCandidate_produced : + AddInductive.buildNormalizationCandidate 0 + [annotatedPiKernelType] 0 false + annotatedPiFamilyCandidateContext = + .ok annotatedPiNormalizationCandidate := by + unfold AddInductive.buildNormalizationCandidate + rw [annotatedPi_checkInductiveTypes] + simp only [ReaderT.bind, Bind.bind] + rw [show + (withReader (fun _ : AddInductive.Context => + { annotatedPiFamilyCandidateContext with lctx := {} }) + (AddInductive.normalizeCandidateFamilyTypeList + [annotatedPiKernelType])) annotatedPiFamilyCandidateContext = + .ok (.cons annotatedPiFamilyListCandidate.familyType .nil) by + change AddInductive.normalizeCandidateFamilyTypeList + [annotatedPiKernelType] + { annotatedPiFamilyCandidateContext with lctx := {} } = _ + rw [show { annotatedPiFamilyCandidateContext with lctx := {} } = + annotatedPiFamilyCandidateContext by rfl] + exact annotatedPiFamilyTypeList_candidateTrace] + simp only [Except.bind] + rw [annotatedPi_declareInductiveTypes] + unfold AddInductive.withEnv + change (ReaderT.bind + (AddInductive.checkConstructors #[annotatedPiKernelType] + annotatedPiInductiveStats false) + (fun _ => ReaderT.bind + (AddInductive.normalizeCandidateFamilyList + (.cons annotatedPiFamilyListCandidate.familyType .nil)) + (fun families => pure + (⟨families⟩ : AddInductive.NormalizationCandidate + [annotatedPiKernelType])))) + ({ annotatedPiFamilyCandidateContext with + env := annotatedPiTypeKernelEnv } : + AddInductive.Context) = _ + rw [show ({ annotatedPiFamilyCandidateContext with + env := annotatedPiTypeKernelEnv } : AddInductive.Context) = + annotatedPiCtorCandidateContext by rfl] + simp only [ReaderT.bind, Bind.bind] + rw [annotatedPi_checkConstructors] + simp only [Except.bind] + rw [annotatedPiFamilyList_candidateTrace] + rfl + +private def aliasFormerFamilyCandidateStep : + AddInductive.CandidateWhnfStep where + context := aliasFormerCandidateContext + source := aliasFormerInfo.type + result := .sort (.succ .zero) + +private theorem aliasFormerFamilyCandidateStep_valid : + aliasFormerFamilyCandidateStep.Valid := by + change + TypeChecker.M.run aliasFormerNormalizationKernelEnv .safe {} [] + { whnf := 2 } (TypeChecker.whnf aliasFormerInfo.type) = + .ok (.sort (.succ .zero)) + exact aliasFormerFamily_whnfM + +private def aliasFormerFamilyCheckTypeStep : + AddInductive.CandidateCheckTypeStep where + context := aliasFormerCandidateContext + source := aliasFormerInfo.type + inferred := .sort (.succ (.succ .zero)) + +private theorem aliasFormerFamilyCheckTypeStep_valid : + aliasFormerFamilyCheckTypeStep.Valid := by + change + TypeChecker.M.run aliasFormerNormalizationKernelEnv .safe {} [] + { whnf := 2 } (TypeChecker.checkType aliasFormerInfo.type) = + .ok (.sort (.succ (.succ .zero))) + exact aliasFormerFamily_checkTypeM + +private def aliasFormerCtorCheckTypeStep : + AddInductive.CandidateCheckTypeStep where + context := aliasFormerCtorCandidateContext + source := aliasFormerMkInfo.type + inferred := .const ``TypeFamilyAlias [] + +private theorem aliasFormerCtorCheckTypeStep_valid : + aliasFormerCtorCheckTypeStep.Valid := by + change + TypeChecker.M.run aliasFormerCtorNormalizationKernelEnv .safe {} [] + { whnf := 2 } (TypeChecker.checkType aliasFormerMkInfo.type) = + .ok (.const ``TypeFamilyAlias []) + exact aliasFormerCtor_checkTypeM + +private def aliasFormerCtorCandidateStep : + AddInductive.CandidateWhnfStep where + context := aliasFormerCtorCandidateContext + source := aliasFormerMkInfo.type + result := .const ``AliasFormer [] + +private theorem aliasFormerCtorCandidateStep_valid : + aliasFormerCtorCandidateStep.Valid := by + change + TypeChecker.M.run aliasFormerCtorNormalizationKernelEnv .safe {} [] + { whnf := 2 } (TypeChecker.whnf aliasFormerMkInfo.type) = + .ok (.const ``AliasFormer []) + exact aliasFormerCtor_whnfM + +private def aliasFormerFamilyCandidate : + AddInductive.CandidateExpr aliasFormerInfo.type := + ⟨aliasFormerCandidateContext, + .terminal aliasFormerCandidateContext aliasFormerInfo.type + (.sort (.succ (.succ .zero))) (.sort (.succ .zero)) + aliasFormerFamilyCheckTypeStep_valid + aliasFormerFamilyCandidateStep_valid⟩ + +private def aliasFormerCtorCandidate : + AddInductive.CandidateExpr aliasFormerMkInfo.type := + ⟨aliasFormerCtorCandidateContext, + .terminal aliasFormerCtorCandidateContext aliasFormerMkInfo.type + (.const ``TypeFamilyAlias []) (.const ``AliasFormer []) + aliasFormerCtorCheckTypeStep_valid + aliasFormerCtorCandidateStep_valid⟩ + +private def aliasFormerConstructorCandidate : + AddInductive.CandidateConstructor aliasFormerKernelCtor := + ⟨aliasFormerCtorCandidate⟩ + +private def aliasFormerFamilyListCandidate : + AddInductive.CandidateFamily aliasFormerKernelType where + familyType := ⟨aliasFormerFamilyCandidate⟩ + constructors := .cons aliasFormerConstructorCandidate .nil + +/-- Exact singleton family/constructor candidate list used to exercise the +generic positional Theory boundary. -/ +private def aliasFormerNormalizationCandidate : + AddInductive.NormalizationCandidate [aliasFormerKernelType] where + families := .cons aliasFormerFamilyListCandidate .nil + +private def aliasFormerInductiveStats : AddInductive.InductiveStats where + levels := [] + resultLevel := .succ .zero + nindices := #[0] + indConsts := #[.const ``AliasFormer []] + params := #[] + isNotZero := true + +private theorem constNil_data_hasExprMVar_false (n : Name) : + (Expr.const n []).data.hasExprMVar = false := by + change (Expr.const n []).hasExprMVar = false + rw [Expr.hasExprMVar_eq] + rfl + +private theorem constNil_data_hasLevelMVar_false (n : Name) : + (Expr.const n []).data.hasLevelMVar = false := by + change (Expr.const n []).hasLevelMVar = false + rw [Expr.hasLevelMVar_eq] + rfl + +private theorem constNil_data_hasFVar_false (n : Name) : + (Expr.const n []).data.hasFVar = false := by + change (Expr.const n []).hasFVar = false + rw [Expr.hasFVar_eq] + rfl + +private theorem aliasFormer_checkInductiveTypes + (k : AddInductive.InductiveStats → AddInductive.M α) : + AddInductive.checkInductiveTypes 0 #[aliasFormerKernelType] k + aliasFormerCandidateContext = + k aliasFormerInductiveStats aliasFormerCandidateContext := by + apply AddInductive.checkInductiveTypes_singleton_zero_of_whnf_sort + · decide + · simp [Kernel.Environment.checkNoMVarNoFVar, + Kernel.Environment.checkNoMVar, Kernel.Environment.checkNoFVar, + aliasFormerKernelType, aliasFormerInfo, ConstantInfo.type, + ConstantInfo.toConstantVal, Expr.hasMVar, Expr.hasFVar, + constNil_data_hasExprMVar_false, + constNil_data_hasLevelMVar_false, constNil_data_hasFVar_false, + Bind.bind, Except.bind, + Pure.pure, Except.pure] + · simpa [aliasFormerCandidateContext, aliasFormerKernelType] using + aliasFormerFamily_checkTypeM + · simpa [aliasFormerCandidateContext, aliasFormerKernelType] using + aliasFormerFamily_whnfM + · rfl + +private theorem aliasFormerNormalization_not_contains : + aliasFormerNormalizationKernelEnv.contains ``AliasFormer = false := by + unfold Kernel.Environment.contains + change typeFamilyAliasMap.contains ``AliasFormer = false + rw [SMap.find?_isSome, aliasFormerType_fresh] + rfl + +private theorem aliasFormerNormalization_checkName : + aliasFormerNormalizationKernelEnv.checkName ``AliasFormer false = + .ok () := by + simp [Kernel.Environment.checkName, + aliasFormerNormalization_not_contains, + Kernel.Environment.primitives, NameSet.ofList, NameSet.contains, + Bind.bind, Except.bind, Pure.pure, Except.pure] + +private theorem aliasFormer_declareInductiveTypes : + AddInductive.declareInductiveTypes aliasFormerInductiveStats 0 + #[aliasFormerKernelType] 0 false aliasFormerCandidateContext = + .ok aliasFormerCtorNormalizationKernelEnv := by + simp [AddInductive.declareInductiveTypes, aliasFormerInductiveStats, + aliasFormerKernelType, aliasFormerKernelCtor, + aliasFormerInfo, aliasFormerMkInfo, ConstantInfo.name, + ConstantInfo.type, ConstantInfo.toConstantVal, + aliasFormerCandidateContext, aliasFormerCtorNormalizationKernelEnv, + aliasFormerNormalizationKernelEnv, aliasFormerTypeMap, + AddInductive.isRec, + AddInductive.isRec.loop, AddInductive.isReflexive, + AddInductive.isReflexive.loop, + Bind.bind, Pure.pure, + Except.bind, Except.pure] + rw [show (Kernel.Environment.ofConstants `_aliasFormerNormalization + typeFamilyAliasMap).checkName ``AliasFormer = .ok () by + simpa [aliasFormerNormalizationKernelEnv] using + aliasFormerNormalization_checkName] + rfl + +private theorem aliasFormerCtor_getEnvM : + TypeChecker.M.run aliasFormerCtorCandidateContext.env + aliasFormerCtorCandidateContext.safety + aliasFormerCtorCandidateContext.lctx + aliasFormerCtorCandidateContext.lparams + aliasFormerCtorCandidateContext.fuel TypeChecker.getEnv = + .ok aliasFormerCtorNormalizationKernelEnv := by + rfl + +private theorem aliasFormerCtor_isValidIndAppIdx : + AddInductive.isValidIndAppIdx aliasFormerInductiveStats + (.const ``AliasFormer []) 0 = true := by + simp +decide [AddInductive.isValidIndAppIdx, + aliasFormerInductiveStats, + Expr.getAppFn, Expr.getAppArgs, Expr.getAppNumArgs] + +private theorem aliasFormerCtor_noMVarNoFVar : + aliasFormerCtorNormalizationKernelEnv.checkNoMVarNoFVar + ``AliasFormer.mk (.const ``AliasFormer []) = .ok () := by + simp [Kernel.Environment.checkNoMVarNoFVar, + Kernel.Environment.checkNoMVar, Kernel.Environment.checkNoFVar, + Expr.hasMVar, Expr.hasFVar, + constNil_data_hasExprMVar_false, + constNil_data_hasLevelMVar_false, constNil_data_hasFVar_false, + Bind.bind, Except.bind, Pure.pure, Except.pure] + +private theorem aliasFormerCtor_checkTypeM_const : + TypeChecker.M.run aliasFormerCtorCandidateContext.env + aliasFormerCtorCandidateContext.safety + aliasFormerCtorCandidateContext.lctx + aliasFormerCtorCandidateContext.lparams + aliasFormerCtorCandidateContext.fuel + (TypeChecker.checkType (.const ``AliasFormer [])) = + .ok (.const ``TypeFamilyAlias []) := by + simpa [aliasFormerMkInfo, ConstantInfo.type, + ConstantInfo.toConstantVal, aliasFormerCtorCandidateContext] using + aliasFormerCtor_checkTypeM + +private theorem aliasFormerCtor_checkTypeM_empty : + TypeChecker.M.run aliasFormerCtorCandidateContext.env + aliasFormerCtorCandidateContext.safety {} + aliasFormerCtorCandidateContext.lparams + aliasFormerCtorCandidateContext.fuel + (TypeChecker.checkType (.const ``AliasFormer [])) = + .ok (.const ``TypeFamilyAlias []) := by + simpa [aliasFormerCtorCandidateContext] using + aliasFormerCtor_checkTypeM_const + +private theorem aliasFormerCtor_checkTypeM_of_empty + (lctx : LocalContext) (hlctx : lctx = {}) : + TypeChecker.M.run aliasFormerCtorCandidateContext.env + aliasFormerCtorCandidateContext.safety lctx + aliasFormerCtorCandidateContext.lparams + aliasFormerCtorCandidateContext.fuel + (TypeChecker.checkType (.const ``AliasFormer [])) = + .ok (.const ``TypeFamilyAlias []) := by + subst lctx + exact aliasFormerCtor_checkTypeM_empty + +private theorem aliasFormer_checkConstructors : + AddInductive.checkConstructors #[aliasFormerKernelType] + aliasFormerInductiveStats false aliasFormerCtorCandidateContext = + .ok () := by + unfold AddInductive.checkConstructors + simp only [ReaderT.bind, Bind.bind] + rw [AddInductive.liftTypeChecker_apply] + rw [aliasFormerCtor_getEnvM] + simp only [Except.bind] + simp +decide [aliasFormerKernelType, aliasFormerKernelCtor, + aliasFormerMkInfo, ConstantInfo.name, NameSet.contains] + simp +decide [ConstantInfo.type, + ConstantInfo.toConstantVal, + AddInductive.liftTypeChecker_apply, + aliasFormerCtor_noMVarNoFVar, + readThe, MonadReaderOf.read, ReaderT.read, + ReaderT.bind, Bind.bind, ReaderT.pure, Pure.pure, + Except.bind, Except.pure] + rw [aliasFormerCtor_checkTypeM_of_empty + ({ decls := + { root := PersistentArrayNode.node #[], tail := #[] } } : + LocalContext) rfl] + simp only [Except.bind] + rw [show aliasFormerCtorCandidateContext.fuel.inductiveFuel = 999 + 1 by + rfl] + unfold AddInductive.checkConstructors.loop + simp [aliasFormerCtor_isValidIndAppIdx, ReaderT.pure, Pure.pure, + Except.pure] + +/-- The generic candidate traversal retains the exact context, input, and +result of the actual AliasFormer family WHNF observation. -/ +theorem aliasFormerFamily_candidateTrace : + AddInductive.buildCandidateExpr aliasFormerInfo.type + aliasFormerCandidateContext = + .ok aliasFormerFamilyCandidate := by + apply AddInductive.buildCandidateExpr_of_whnf_nonForall + · decide + · rfl + +private def aliasFormerFamilyTypeListProduced : + AddInductive.CandidateFamilyTypeListProduced aliasFormerCandidateContext + (.cons aliasFormerFamilyListCandidate.familyType .nil) := by + exact .cons (by + unfold AddInductive.normalizeCandidateFamilyType + simp only [ReaderT.bind, Bind.bind] + simp only [aliasFormerKernelType] + rw [aliasFormerFamily_candidateTrace] + rfl) .nil + +private theorem aliasFormerFamilyTypeList_candidateTrace : + AddInductive.normalizeCandidateFamilyTypeList + [aliasFormerKernelType] aliasFormerCandidateContext = + .ok (.cons aliasFormerFamilyListCandidate.familyType .nil) := by + exact aliasFormerFamilyTypeListProduced.normalize + +/-- The post-family constructor position is produced by the same executable +candidate traversal and retains its exact opaque result. -/ +theorem aliasFormerCtor_candidateTrace : + AddInductive.buildCandidateExpr aliasFormerMkInfo.type + aliasFormerCtorCandidateContext = + .ok aliasFormerCtorCandidate := by + apply AddInductive.buildCandidateExpr_of_whnf_nonForall + · decide + · rfl + +private def aliasFormerConstructorListProduced : + AddInductive.CandidateConstructorListProduced + aliasFormerCtorCandidateContext + aliasFormerFamilyListCandidate.constructors := by + exact .cons (by + unfold AddInductive.normalizeCandidateConstructor + simp only [ReaderT.bind, Bind.bind] + simp only [aliasFormerKernelCtor] + rw [aliasFormerCtor_candidateTrace] + rfl) .nil + +private theorem aliasFormerConstructorList_candidateTrace : + AddInductive.normalizeCandidateConstructorList + aliasFormerKernelType.ctors aliasFormerCtorCandidateContext = + .ok aliasFormerFamilyListCandidate.constructors := by + exact aliasFormerConstructorListProduced.normalize + +private def aliasFormerFamilyListProduced : + AddInductive.CandidateFamilyListProduced aliasFormerCtorCandidateContext + (.cons aliasFormerFamilyListCandidate.familyType .nil) + aliasFormerNormalizationCandidate.families := by + exact .cons aliasFormerConstructorListProduced .nil + +private theorem aliasFormerFamilyList_candidateTrace : + AddInductive.normalizeCandidateFamilyList + (.cons aliasFormerFamilyListCandidate.familyType .nil) + aliasFormerCtorCandidateContext = + .ok aliasFormerNormalizationCandidate.families := by + exact aliasFormerFamilyListProduced.normalize + +theorem aliasFormerNormalizationCandidate_produced : + AddInductive.buildNormalizationCandidate 0 + [aliasFormerKernelType] 0 false aliasFormerCandidateContext = + .ok aliasFormerNormalizationCandidate := by + unfold AddInductive.buildNormalizationCandidate + rw [aliasFormer_checkInductiveTypes] + simp only [ReaderT.bind, Bind.bind] + rw [show + (withReader (fun _ : AddInductive.Context => + { aliasFormerCandidateContext with lctx := {} }) + (AddInductive.normalizeCandidateFamilyTypeList + [aliasFormerKernelType])) aliasFormerCandidateContext = + .ok (.cons aliasFormerFamilyListCandidate.familyType .nil) by + change AddInductive.normalizeCandidateFamilyTypeList + [aliasFormerKernelType] + { aliasFormerCandidateContext with lctx := {} } = _ + rw [show { aliasFormerCandidateContext with lctx := {} } = + aliasFormerCandidateContext by rfl] + exact aliasFormerFamilyTypeList_candidateTrace] + simp only [Except.bind] + rw [aliasFormer_declareInductiveTypes] + unfold AddInductive.withEnv + change (ReaderT.bind + (AddInductive.checkConstructors #[aliasFormerKernelType] + aliasFormerInductiveStats false) + (fun _ => ReaderT.bind + (AddInductive.normalizeCandidateFamilyList + (.cons aliasFormerFamilyListCandidate.familyType .nil)) + (fun families => pure + (⟨families⟩ : AddInductive.NormalizationCandidate + [aliasFormerKernelType])))) + ({ aliasFormerCandidateContext with + env := aliasFormerCtorNormalizationKernelEnv } : + AddInductive.Context) = _ + rw [show ({ aliasFormerCandidateContext with + env := aliasFormerCtorNormalizationKernelEnv } : + AddInductive.Context) = aliasFormerCtorCandidateContext by rfl] + simp only [ReaderT.bind, Bind.bind] + rw [aliasFormer_checkConstructors] + simp only [Except.bind] + rw [aliasFormerFamilyList_candidateTrace] + rfl + +/-- Erasing the retained trace produces the expected AliasFormer analysis +view at the same checker boundary. -/ +theorem aliasFormerFamily_candidate : + AddInductive.normalizeCandidateExpr aliasFormerInfo.type + aliasFormerCandidateContext = + .ok (.sort (.succ .zero)) := by + apply AddInductive.normalizeCandidateExpr_of_whnf_nonForall + · decide + · simpa [aliasFormerCandidateContext] using + aliasFormerFamily_checkTypeM + · simpa [aliasFormerCandidateContext] using + aliasFormerFamily_whnfM + · rfl + +private def aliasRecFieldFnType : Expr := + .forallE `α (.sort (.succ .zero)) + (.sort (.succ .zero)) .default + +@[simp] private theorem aliasRecFieldFnType_isForall : + aliasRecFieldFnType.isForall = true := rfl + +@[simp] private theorem aliasRecFieldFnType_bindingDomain : + aliasRecFieldFnType.bindingDomain! = + .sort (.succ .zero) := rfl + +@[simp] private theorem aliasRecFieldFnType_instantiatedBody : + aliasRecFieldFnType.bindingBody!.instantiate1 + (.const ``AliasRec []) = + .sort (.succ .zero) := by + simp [aliasRecFieldFnType, Expr.bindingBody!, + Expr.instantiate1_eq, + Expr.instantiate1'] + +@[simp] private theorem aliasRecFamily_notEagerReduce : + (Expr.const ``AliasRec []).isAppOfArity ``eagerReduce 2 = + false := rfl + +private def aliasRecFieldFnState (state : TypeChecker.State) : + TypeChecker.State := + { state with + inferTypeC := state.inferTypeC.insert + (.const ``RecAlias [.succ .zero]) aliasRecFieldFnType } + +private def aliasRecFieldArgState (state : TypeChecker.State) : + TypeChecker.State := + { state with + inferTypeC := state.inferTypeC.insert + (.const ``AliasRec []) (.sort (.succ .zero)) } + +private def aliasRecFieldResultState (state : TypeChecker.State) : + TypeChecker.State := + { state with + inferTypeC := state.inferTypeC.insert + aliasRecFieldKernelExpr (.sort (.succ .zero)) } + +@[simp] private theorem aliasRecFieldFnCache_miss : + (({} : Lean4Lean.InferCache).insert + (Expr.const ``RecAlias [.succ .zero]) aliasRecFieldFnType)[ + Expr.const ``AliasRec []]? = none := by + rw [Std.HashMap.getElem?_insert] + have h : + (Expr.const ``RecAlias [.succ .zero] == + Expr.const ``AliasRec []) = false := by + change Expr.eqv + (Expr.const ``RecAlias [.succ .zero]) + (Expr.const ``AliasRec []) = false + rw [Expr.eqv_eq] + rfl + rw [h] + exact Std.HashMap.getElem?_empty + +@[simp] private theorem aliasRecFieldFnState_cache_miss : + (aliasRecFieldFnState {}).inferTypeC[ + Expr.const ``AliasRec []]? = none := by + change + (({} : Lean4Lean.InferCache).insert + (Expr.const ``RecAlias [.succ .zero]) aliasRecFieldFnType)[ + Expr.const ``AliasRec []]? = none + exact aliasRecFieldFnCache_miss + +private theorem isDefEqSort + (context : TypeChecker.Context) + (initial : TypeChecker.State) : + ∃ state : TypeChecker.State, + TypeChecker.Inner.isDefEq + (.sort (.succ .zero)) (.sort (.succ .zero)) + (TypeChecker.Methods.withFuel 9998) context initial = + .ok (true, state) := by + refine ⟨initial, ?_⟩ + unfold TypeChecker.Inner.isDefEq + rw [if_pos (Expr.eqv_refl _)] + rfl + +private theorem inferTypeRecAliasInitial : + TypeChecker.Inner.inferType' + (.const ``RecAlias [.succ .zero]) false + (TypeChecker.Methods.withFuel 9998) + aliasRecNormalizationRawContext ({} : TypeChecker.State) = + .ok (aliasRecFieldFnType, aliasRecFieldFnState {}) := by + unfold TypeChecker.Inner.inferType' + simp [aliasRecFieldFnType, aliasRecFieldFnState, + Bind.bind, ReaderT.bind, StateT.bind, Except.bind] + +private theorem inferTypeAliasRecAfterRecAlias : + TypeChecker.Inner.inferType' + (.const ``AliasRec []) false + (TypeChecker.Methods.withFuel 9998) + aliasRecNormalizationRawContext (aliasRecFieldFnState {}) = + .ok (.sort (.succ .zero), + aliasRecFieldArgState (aliasRecFieldFnState {})) := by + unfold TypeChecker.Inner.inferType' + simp [aliasRecFieldArgState, Bind.bind, ReaderT.bind, + StateT.bind, Except.bind] + +/-- The exact full checker run for the raw `RecAlias AliasRec` constructor +field in the post-family environment. -/ +theorem aliasRecField_checkType : + ∃ state : TypeChecker.State, + TypeChecker.Inner.inferType aliasRecFieldKernelExpr false + (TypeChecker.Methods.withFuel 9999) + aliasRecNormalizationRawContext ({} : TypeChecker.State) = + .ok (.sort (.succ .zero), state) := by + change ∃ state : TypeChecker.State, + TypeChecker.Inner.inferType' aliasRecFieldKernelExpr false + (TypeChecker.Methods.withFuel 9998) + aliasRecNormalizationRawContext ({} : TypeChecker.State) = + .ok (.sort (.succ .zero), state) + rw [aliasRecFieldKernelExpr_eq] + unfold TypeChecker.Inner.inferType' + simp only [aliasRecField_noLooseBVars, Bool.false_eq_true, if_false, cond, + normalizationRecMPure, normalizationRecMGet, + Std.HashMap.getElem?_empty, normalizationRecMBind] + rw [inferTypeRecAliasInitial] + simp only + [TypeChecker.Inner.ensureForallCore, + aliasRecFieldFnType_isForall, if_true, normalizationRecMPure] + rw [inferTypeAliasRecAfterRecAlias] + obtain ⟨eqState, heq⟩ := + isDefEqSort aliasRecNormalizationRawContext + (aliasRecFieldArgState (aliasRecFieldFnState {})) + simp only [aliasRecFamily_notEagerReduce, Bool.false_eq_true, + if_false, aliasRecFieldFnType_bindingDomain, + normalizationRecMBind] + rw [heq] + rw [aliasRecFieldFnType_instantiatedBody] + refine ⟨aliasRecFieldResultState eqState, ?_⟩ + simp [aliasRecFieldResultState, aliasRecFieldKernelExpr_eq, + Bind.bind, ReaderT.bind, StateT.bind, Except.bind] + +/-- The paired full-check/WHNF interpretation of the retained AliasFormer +family node. Both semantic runs are obtained from the candidate's exact +observations in one verified context. -/ +private def aliasFormerFamilyCandidateNodeRun : + TypeChecker.CandidateNodeRun typeFamilyAliasEnv [] [] + aliasFormerCandidateContext aliasFormerInfo.type + (.sort (.succ (.succ .zero))) (.sort (.succ .zero)) + aliasFormerRawType.type aliasFormerViewType.type + (.sort (.succ (.succ .zero))) := by + exact TypeChecker.CandidateNodeRun.ofCandidate + aliasFormerCandidateContext aliasFormerInfo.type + (.sort (.succ (.succ .zero))) (.sort (.succ .zero)) + aliasFormerFamilyCheckTypeStep_valid + aliasFormerFamilyCandidateStep_valid + aliasFormerNormalizationContext (by rfl) + rfl rfl rfl TypeChecker.VState.WF.empty + (.const rfl rfl rfl) (.sort rfl) + (by + have hs : TrExprS typeFamilyAliasEnv [] [] + (.sort (.succ .zero)) (.sort (.succ .zero)) := .sort rfl + exact ⟨_, hs, ⟨_, VEnv.HasType.sort (by decide)⟩⟩) + 10000 9999 (by rfl) (by rfl) + +/-- Verified family-result normalization leaf for AliasFormer. -/ +def aliasFormerFamilyWhnfRun : + TypeChecker.WhnfRun typeFamilyAliasEnv [] [] + aliasFormerInfo.type (.sort (.succ .zero)) + aliasFormerRawType.type aliasFormerViewType.type := + aliasFormerFamilyCandidateNodeRun.whnf + +/-- Verified full-check certificate for the raw AliasFormer family type. -/ +def aliasFormerFamilyCheckTypeRun : + TypeChecker.CheckTypeRun typeFamilyAliasEnv [] [] + aliasFormerInfo.type (.sort (.succ (.succ .zero))) + aliasFormerRawType.type (.sort (.succ (.succ .zero))) := + aliasFormerFamilyCandidateNodeRun.check + +/-- Recursive semantic interpretation of the exact source-indexed candidate +trace. This terminal fixture is the base case used by the generic Pi +interpreter for larger metadata. -/ +private def aliasFormerFamilyCandidateRun : + TypeChecker.CandidateExprRun typeFamilyAliasEnv [] + aliasFormerFamilyCandidate.trace [] + aliasFormerRawType.type aliasFormerViewType.type + (.sort (.succ (.succ .zero))) := + .terminal aliasFormerFamilyCandidateNodeRun + +private theorem aliasFormerCandidatePrefix_ne : + aliasFormerCandidateContext.ngen.namePrefix ≠ + (({} : TypeChecker.VState).ngen).namePrefix := by + decide + +/-- The generic root constructor aligns the actual candidate context with the +verified AliasFormer environment and supplies the empty-state certificate. -/ +private def aliasFormerCandidateContextRun : + TypeChecker.CandidateContextRun aliasFormerCandidateContext := + TypeChecker.CandidateContextRun.root aliasFormerNormalizationVEnvs_wf + rfl aliasFormerCandidatePrefix_ne + +/-- The retained AliasFormer full check now selects its own Theory source and +output translations; no expression translation is supplied by the fixture. -/ +theorem aliasFormerFamily_candidateRun_exists : + ∃ source' view' inferred', + aliasFormerCandidateContextRun.context.TrExprS + aliasFormerInfo.type source' ∧ + Nonempty (TypeChecker.CandidateExprRun + aliasFormerCandidateContextRun.context.venv + aliasFormerCandidateContextRun.context.lparams + aliasFormerFamilyCandidate.trace + aliasFormerCandidateContextRun.context.vlctx + source' view' inferred') := by + apply TypeChecker.CandidateExprRun.exists_ofCandidateFVars + aliasFormerFamilyCandidate.trace aliasFormerCandidateContextRun + (whnfFuel := 9999) + · change ∀ u ∈ ([] : List Level), u.hasMVar' = false + simp + · rfl + +/-- The generic interpreter retains the strict translation of the raw +candidate endpoint. -/ +theorem aliasFormerFamily_candidateSource_tr : + TrExprS typeFamilyAliasEnv [] [] aliasFormerInfo.type + aliasFormerRawType.type := + aliasFormerFamilyCandidateRun.source_tr + +/-- The reconstructed candidate endpoint is also tied back to the concrete +kernel WHNF result, closing the source/view translation pair. -/ +theorem aliasFormerFamily_candidateView_tr : + TrExpr typeFamilyAliasEnv [] [] (.sort (.succ .zero)) + aliasFormerViewType.type := by + simpa [aliasFormerFamilyCandidate, + AddInductive.CandidateExprTrace.view] using + aliasFormerFamilyCandidateRun.view_tr + +private def aliasFormerPreFamilyStage : + TypeChecker.CandidateSemanticStage aliasFormerCandidateContext + typeFamilyAliasEnv [] where + contextRun := aliasFormerCandidateContextRun + venv_eq := rfl + lparams_eq := rfl + vlctx_eq := rfl + +private def aliasFormerFamilyValidationRun : + AddInductive.CandidateExprTrace.FamilyValidationRun + aliasFormerKernelType aliasFormerFamilyCandidate.trace where + nparams := 0 + resultLevel := .succ .zero + stats := aliasFormerInductiveStats + stats_eq := rfl + terminal_eq := rfl + run := aliasFormer_checkInductiveTypes + +private def aliasFormerFamilyStage : + VInductDecl.CandidateFamilyStagedInput aliasFormerCandidateContext + aliasFormerCtorCandidateContext typeFamilyAliasEnv [] + aliasFormerFamilyListCandidate.familyType aliasFormerRawType + aliasFormerPreFamilyStage where + name_eq := rfl + uvars_eq := rfl + type := { + context_eq := rfl + source_tr := aliasFormerFamily_candidateSource_tr + whnfFuel := 9999 + whnfDepth := rfl } + validation := aliasFormerFamilyValidationRun + typeEnv := aliasFormerTypeEnv + addInduct := aliasFormerCtorNormalizationAddType + family_lctx_eq := rfl + constructorContext_eq := rfl + quotInit_eq := rfl + name_not_reflected := by decide + name_not_primitive := by + simp [aliasFormerRawType, Kernel.Environment.primitives, + NameSet.ofList] + simp +decide [NameSet.contains] + +private def aliasFormerCtorCandidateContextRun : + TypeChecker.CandidateContextRun aliasFormerCtorCandidateContext := + aliasFormerFamilyStage.postContextRun + +/-- Family endpoint certificate used by the singleton list assembler. -/ +private def aliasFormerFamilySemanticRootRun : + TypeChecker.CandidateExprSemanticRootRun typeFamilyAliasEnv [] + aliasFormerFamilyCandidate aliasFormerRawType.type + where + contextRun := aliasFormerCandidateContextRun + venv_eq := rfl + lparams_eq := rfl + vlctx_eq := rfl + source_tr := aliasFormerFamily_candidateSource_tr + whnfFuel := 9999 + whnfDepth := rfl + view := aliasFormerViewType.type + recursive := ⟨.sort (.succ (.succ .zero)), + aliasFormerFamilyCandidateRun⟩ + +private def aliasFormerFamilyRootRun : + TypeChecker.CandidateExprRootRun typeFamilyAliasEnv [] + aliasFormerFamilyCandidate aliasFormerRawType.type + aliasFormerViewType.type := + aliasFormerFamilySemanticRootRun.root + +/-- Verified full-check certificate for the actual AliasFormer constructor +type in the post-family environment. -/ +def aliasFormerCtorCheckTypeRun : + TypeChecker.CheckTypeRun aliasFormerTypeEnv [] [] + aliasFormerMkInfo.type (.const ``TypeFamilyAlias []) + aliasFormerRawType.ctors[0].type + (.const ``TypeFamilyAlias []) := by + exact TypeChecker.CheckTypeRun.ofCandidateStep + aliasFormerCtorCheckTypeStep aliasFormerCtorCheckTypeStep_valid + aliasFormerCtorCandidateContextRun.context + aliasFormerCtorCandidateContextRun.context_eq + rfl rfl rfl aliasFormerCtorCandidateContextRun.state_wf + (.const rfl rfl rfl) (.const rfl rfl rfl) + 10000 (by rfl) + +/-- Paired full-check/WHNF interpretation of the retained constructor leaf. +This is the post-family terminal used by the generic constructor-spine +assembler. -/ +private def aliasFormerCtorCandidateNodeRun : + TypeChecker.CandidateNodeRun aliasFormerTypeEnv [] [] + aliasFormerCtorCandidateContext aliasFormerMkInfo.type + (.const ``TypeFamilyAlias []) (.const ``AliasFormer []) + aliasFormerRawType.ctors[0].type + aliasFormerRawType.ctors[0].type + (.const ``TypeFamilyAlias []) := by + exact TypeChecker.CandidateNodeRun.ofCandidate + aliasFormerCtorCandidateContext aliasFormerMkInfo.type + (.const ``TypeFamilyAlias []) (.const ``AliasFormer []) + aliasFormerCtorCheckTypeStep_valid + aliasFormerCtorCandidateStep_valid + aliasFormerCtorCandidateContextRun.context + aliasFormerCtorCandidateContextRun.context_eq + rfl rfl rfl aliasFormerCtorCandidateContextRun.state_wf + aliasFormerCtorCheckTypeRun.expr_tr (.const rfl rfl rfl) + ⟨_, aliasFormerCtorCheckTypeRun.expr_tr, + ⟨_, aliasFormerCtorCheckTypeRun.hasType⟩⟩ + 10000 9999 (by rfl) (by rfl) + +private def aliasFormerCtorCandidateRun : + TypeChecker.CandidateExprRun aliasFormerTypeEnv [] + aliasFormerCtorCandidate.trace [] + aliasFormerRawType.ctors[0].type + aliasFormerRawType.ctors[0].type + (.const ``TypeFamilyAlias []) := + .terminal aliasFormerCtorCandidateNodeRun + +/-- Constructor endpoint certificate in the exact post-family context. -/ +private def aliasFormerCtorSemanticRootRun : + TypeChecker.CandidateExprSemanticRootRun aliasFormerTypeEnv [] + aliasFormerCtorCandidate aliasFormerRawType.ctors[0].type + where + contextRun := aliasFormerCtorCandidateContextRun + venv_eq := rfl + lparams_eq := rfl + vlctx_eq := rfl + source_tr := aliasFormerCtorCheckTypeRun.expr_tr + whnfFuel := 9999 + whnfDepth := rfl + view := aliasFormerRawType.ctors[0].type + recursive := ⟨.const ``TypeFamilyAlias [], aliasFormerCtorCandidateRun⟩ + +private def aliasFormerCtorRootRun : + TypeChecker.CandidateExprRootRun aliasFormerTypeEnv [] + aliasFormerCtorCandidate aliasFormerRawType.ctors[0].type + aliasFormerRawType.ctors[0].type := + aliasFormerCtorSemanticRootRun.root + +/-- The actual AliasFormer constructor type is typed by the verified full +checker in the post-family environment. -/ +theorem aliasFormerCtor_hasType_checked : + aliasFormerTypeEnv.HasType 0 [] + aliasFormerRawType.ctors[0].type + (.const ``TypeFamilyAlias []) := + aliasFormerCtorCheckTypeRun.hasType + +/-- The raw AliasFormer family is a Theory type because the verified checker +actually accepted it and inferred a sort. -/ +theorem aliasFormerFamily_isType_checked : + typeFamilyAliasEnv.IsType 0 [] aliasFormerRawType.type := + aliasFormerFamilyCheckTypeRun.isType + +private def aliasFormerFamilySpineRun : + TypeChecker.CandidateExprSpineRun typeFamilyAliasEnv [] + aliasFormerFamilyCandidate aliasFormerRawType.type + aliasFormerViewType.type := + aliasFormerFamilySemanticRootRun.spine rfl + +private def aliasFormerCtorSpineRun : + TypeChecker.CandidateExprSpineRun aliasFormerTypeEnv [] + aliasFormerCtorCandidate aliasFormerRawType.ctors[0].type + aliasFormerRawType.ctors[0].type := + aliasFormerCtorSemanticRootRun.spine rfl + +/-- Verified delta-normalization leaf for `RecAlias.{1}`. -/ +def recAliasWhnfRun : + TypeChecker.WhnfRun aliasRecTypeEnv [] [] + (.const ``RecAlias [.succ .zero]) + recAliasWhnfKernelExpr + (.const ``RecAlias [.succ .zero]) + (.lam (.sort (.succ .zero)) (.bvar 0)) where + context := aliasRecNormalizationContext + venv_eq := rfl + lparams_eq := rfl + vlctx_eq := rfl + state_wf := TypeChecker.VState.WF.empty + lhs_tr := .const rfl rfl rfl + rhs_tr := by + have hs : TrExprS aliasRecTypeEnv [] [] + recAliasWhnfKernelExpr + (.lam (.sort (.succ .zero)) (.bvar 0)) := by + rw [recAliasWhnfKernelExpr_eq] + exact .lam + ⟨_, VEnv.HasType.sort (by decide)⟩ + (.sort rfl) (.bvar rfl) + exact ⟨_, hs, ⟨_, + VEnv.HasType.lam + (VEnv.HasType.sort (by decide)) + (VEnv.HasType.bvar .zero)⟩⟩ + recursionFuel := 9999 + run_eq := by + simpa [aliasRecNormalizationContext, TypeChecker.VContext.mk', + TypeChecker.MLCtx.lctx, aliasRecNormalizationRawContext] using + recAlias_whnf + +private theorem recAliasConst_hasType : + aliasRecTypeEnv.HasType 0 [] + (.const ``RecAlias [.succ .zero]) + (.forallE (.sort (.succ .zero)) (.sort (.succ .zero))) := by + have hAlias : aliasRecTypeEnv.constants ``RecAlias = + some (vconst(type_of% @RecAlias)) := rfl + type_tac + +private theorem aliasRecConst_hasType : + aliasRecTypeEnv.HasType 0 [] + (.const ``AliasRec []) (.sort (.succ .zero)) := by + exact .constDF + (VEnv.addConst_self (show + recAliasEnv.addConst aliasRecRawType.name + aliasRecRawType.toVConstant = some aliasRecTypeEnv from rfl)) + (fun _ h => nomatch h) (fun _ h => nomatch h) rfl .nil + +/-- Verified full-check certificate for the actual raw recursive field in the +exact environment produced by inserting `AliasRec`. -/ +def aliasRecFieldCheckTypeRun : + TypeChecker.CheckTypeRun aliasRecTypeEnv [] [] + aliasRecFieldKernelExpr (.sort (.succ .zero)) + aliasRecRawField (.sort (.succ .zero)) where + context := aliasRecNormalizationContext + venv_eq := rfl + lparams_eq := rfl + vlctx_eq := rfl + state_wf := TypeChecker.VState.WF.empty + expr_tr := .app recAliasConst_hasType aliasRecConst_hasType + (.const rfl rfl rfl) (.const rfl rfl rfl) + inferred_tr := .sort rfl + recursionFuel := 9999 + run_eq := by + simpa [aliasRecNormalizationContext, TypeChecker.VContext.mk', + TypeChecker.MLCtx.lctx, aliasRecNormalizationRawContext] using + aliasRecField_checkType + +/-- The raw recursive field is typed by an exact full checker execution in +the post-family environment. -/ +theorem aliasRecField_hasType_checked : + aliasRecTypeEnv.HasType 0 [] + aliasRecRawField (.sort (.succ .zero)) := + aliasRecFieldCheckTypeRun.hasType + +private def aliasRecFieldEvidenceBase : + TypeChecker.DefEqEvidence aliasRecTypeEnv 0 [] + aliasRecRawField (.const ``AliasRec []) (.sort (.succ .zero)) := by + exact .trans + (.app + (.whnf recAliasWhnfRun recAliasConst_hasType) + (.refl aliasRecConst_hasType)) + (.beta (VEnv.HasType.bvar .zero) aliasRecConst_hasType) + +private def aliasRecFieldEvidence : + TypeChecker.DefEqEvidence aliasRecTypeEnv 0 [] + aliasRecRawField (.const ``AliasRec []) (.sort (.succ .zero)) := + .trans (.refl aliasRecField_hasType_checked) + aliasRecFieldEvidenceBase + +private def aliasRecCtorEvidence : + ∃ A, TypeChecker.DefEqEvidence aliasRecTypeEnv 0 [] + aliasRecRawType.ctors[0].type aliasRecViewCtor.type A := by + exact ⟨.sort (.imax (.succ .zero) (.succ .zero)), + .forallE aliasRecFieldEvidence + (.refl (aliasRecResult_hasType rfl))⟩ + +private def aliasFormerCandidateConstructorSemanticRun : + VInductDecl.CandidateConstructorSemanticRun aliasFormerTypeEnv [] + aliasFormerConstructorCandidate aliasFormerRawType.ctors[0] where + name_eq := rfl + uvars_eq := rfl + type := aliasFormerCtorSemanticRootRun + +private def aliasFormerCandidateConstructorRun : + VInductDecl.CandidateConstructorRun aliasFormerTypeEnv [] + aliasFormerConstructorCandidate aliasFormerRawType.ctors[0] := + aliasFormerCandidateConstructorSemanticRun.root + +private def aliasFormerCandidateConstructorSemanticListRun : + VInductDecl.CandidateConstructorSemanticListRun aliasFormerTypeEnv [] + aliasFormerFamilyListCandidate.constructors + aliasFormerRawType.ctors := by + exact .cons aliasFormerCandidateConstructorSemanticRun .nil + +private def aliasFormerCandidateConstructorListRun : + VInductDecl.CandidateConstructorListRun aliasFormerTypeEnv [] + aliasFormerFamilyListCandidate.constructors + aliasFormerRawType.ctors := + aliasFormerCandidateConstructorSemanticListRun.roots + +private def aliasFormerCandidateFamilySemanticRun : + VInductDecl.CandidateFamilySemanticRun typeFamilyAliasEnv [] + aliasFormerFamilyListCandidate aliasFormerRawType where + name_eq := rfl + uvars_eq := rfl + type := aliasFormerFamilySemanticRootRun + typeEnv := aliasFormerTypeEnv + addType := rfl + constructors := aliasFormerCandidateConstructorSemanticListRun + +private def aliasFormerCandidateFamilyRun : + VInductDecl.CandidateFamilyRun typeFamilyAliasEnv [] + aliasFormerFamilyListCandidate aliasFormerRawType := + aliasFormerCandidateFamilySemanticRun.root + +/-- Temporary L4L-01A compatibility witness used by downstream generation. +The staged owner above independently proves existence without choosing this +value; L4L-01E removes the explicit witness. -/ +private def aliasFormerNormalizationCandidateSemanticRun : + VInductDecl.NormalizationCandidateSemanticRun typeFamilyAliasEnv [] + aliasFormerNormalizationCandidate aliasFormerRawDecl where + raw := aliasFormerRawType + raw_types_eq := rfl + uvars_eq := rfl + family := aliasFormerCandidateFamilySemanticRun + +private def aliasFormerStagedSemanticInput : + VInductDecl.StagedNormalizationCandidateSemanticInput + aliasFormerCandidateContext aliasFormerCtorCandidateContext + typeFamilyAliasEnv [] aliasFormerNormalizationCandidate + aliasFormerRawDecl where + raw := aliasFormerRawType + raw_types_eq := rfl + declaration_uvars_eq := rfl + preFamily := aliasFormerPreFamilyStage + family := aliasFormerFamilyStage + constructors := .cons { + name_eq := rfl + uvars_eq := rfl + type := { + context_eq := rfl + source_tr := aliasFormerCtorCheckTypeRun.expr_tr + whnfFuel := 9999 + whnfDepth := rfl } } .nil + familyTypesProduced := aliasFormerFamilyTypeListProduced + familiesProduced := aliasFormerFamilyListProduced + +/-- The exact family/constructor producer traversals and verified translations +automatically determine a complete retained AliasFormer hierarchy. -/ +theorem aliasFormerProducedSemanticHierarchy_exists : + Nonempty (VInductDecl.ProducedNormalizationCandidateSemanticRun + aliasFormerCandidateContext aliasFormerCtorCandidateContext + typeFamilyAliasEnv [] aliasFormerNormalizationCandidate + aliasFormerRawDecl) := + aliasFormerStagedSemanticInput.exists + +def aliasFormerNormalizationCandidateRun : + VInductDecl.NormalizationCandidateRun typeFamilyAliasEnv [] + aliasFormerNormalizationCandidate aliasFormerRawDecl := + aliasFormerNormalizationCandidateSemanticRun.root + +example : aliasFormerNormalizationCandidateRun.viewDecl = + aliasFormerViewDecl := rfl + +example : aliasFormerNormalizationCandidateRun.normalization.accepted = + true := rfl + +theorem aliasFormerCandidateNormalization_eq : + aliasFormerNormalizationCandidateRun.normalization = + aliasFormerNormalization := rfl + +private def aliasFormerTruncatedViewType : VInductiveType := + { aliasFormerViewType with ctors := [] } + +private def aliasFormerTruncatedViewDecl : VInductDecl := + { aliasFormerViewDecl with types := [aliasFormerTruncatedViewType] } + +/-- A shorter view cannot cross even the computational normalization-shape +gate, so it cannot reach dependent analysis or transaction construction. -/ +theorem aliasFormerTruncatedView_rejected : + VInductDecl.normalization? aliasFormerRawDecl + aliasFormerTruncatedViewDecl = none := rfl + +/-- Complete checker-produced semantic normalization certificate for +AliasFormer. -/ +def aliasFormerNormalizationRun : + VInductDecl.NormalizationRun aliasFormerNormalization + typeFamilyAliasEnv := by + simpa only [aliasFormerCandidateNormalization_eq] using + aliasFormerNormalizationCandidateRun.normalizationRun + +theorem aliasFormerNormalization_wf_checked : + aliasFormerNormalization.WF typeFamilyAliasEnv := + aliasFormerNormalizationRun.wf + +/-- Complete checker-produced semantic normalization certificate for +AliasRec. The field comparison is assembled from verified WHNF, application, +beta, and outer-forall congruence. -/ +def aliasRecNormalizationRun : + VInductDecl.NormalizationRun aliasRecNormalization recAliasEnv := by + refine { + raw := aliasRecRawType + view := aliasRecViewType + source_types_eq := rfl + view_types_eq := rfl + family := ?_ + typeEnv := aliasRecTypeEnv + addType := rfl + constructors := ?_ } + · exact ⟨.sort (.succ (.succ .zero)), + .refl (VEnv.HasType.sort (by decide))⟩ + · exact .cons aliasRecCtorEvidence .nil + +theorem aliasRecNormalization_wf_checked : + aliasRecNormalization.WF recAliasEnv := + aliasRecNormalizationRun.wf + +/-- The paired AliasFormer block with its normalization component supplied by +the checked WHNF path. The view's structural semantics remain the ordinary +Theory `Checked.WF` proof. -/ +theorem aliasFormerBlock_wf_checked : + aliasFormerBlock.WF typeFamilyAliasEnv := by + refine ⟨aliasFormerNormalization_wf_checked, ?_⟩ + change aliasFormerViewChecked.WF typeFamilyAliasEnv + exact aliasFormerViewChecked.wf_of_decl aliasFormerViewDecl_wf + +private theorem aliasFormerFamily_defeq_checked : + typeFamilyAliasEnv.IsDefEq 0 [] + (.const ``TypeFamilyAlias []) (.sort (.succ .zero)) + (.sort (.succ (.succ .zero))) := + aliasFormerFamilyWhnfRun.isDefEq + aliasFormerFamilyCheckTypeRun.hasType + +/-- Combining the constructor's exact full-check result with the verified +family-alias WHNF fixes its Theory sort. -/ +theorem aliasFormerCtor_hasSort_checked : + aliasFormerTypeEnv.HasType 0 [] + aliasFormerRawType.ctors[0].type (.sort (.succ .zero)) := by + have halias := + aliasFormerFamily_defeq_checked.mono (VEnv.addConst_le (show + typeFamilyAliasEnv.addConst aliasFormerRawType.name + aliasFormerRawType.toVConstant = some aliasFormerTypeEnv from rfl)) + exact halias.defeq aliasFormerCtor_hasType_checked + +theorem aliasFormerCtor_isType_checked : + aliasFormerTypeEnv.IsType 0 [] + aliasFormerRawType.ctors[0].type := + ⟨.succ .zero, aliasFormerCtor_hasSort_checked⟩ + +private theorem aliasFormerCandidate_generationShape : + aliasFormerNormalizationCandidateSemanticRun.generationShape = true := + rfl + +/-- Temporary L4L-01A view-WF compatibility premise. L4L-01D derives this +from retained validation and L4L-01E removes it from package construction. -/ +private theorem aliasFormerCandidate_viewDecl_wf : + aliasFormerNormalizationCandidateRun.viewDecl.WF + typeFamilyAliasEnv := by + change aliasFormerViewDecl.WF typeFamilyAliasEnv + exact aliasFormerViewDecl_wf + +private def aliasFormerProducedGenerationShapeCandidate : + VInductDecl.ProducedGenerationShapeCandidate aliasFormerRawDecl + aliasFormerRawType aliasFormerKernelType 0 false + aliasFormerCandidateContext where + candidate := aliasFormerNormalizationCandidate + produced := aliasFormerNormalizationCandidate_produced + shape := aliasFormerCandidate_generationShape + +/-- The strengthened outer gate returns the exact AliasFormer candidate with +its complete executable generation layout attached. -/ +theorem aliasFormerGenerationShapeCandidate_produced : + VInductDecl.produceGenerationShapeCandidate aliasFormerRawDecl + aliasFormerRawType aliasFormerKernelType 0 false + aliasFormerCandidateContext = + .ok aliasFormerProducedGenerationShapeCandidate := by + have produced : + AddInductive.buildNormalizationCandidate aliasFormerRawDecl.nparams + [aliasFormerKernelType] 0 false aliasFormerCandidateContext = + .ok aliasFormerNormalizationCandidate := + aliasFormerNormalizationCandidate_produced + simpa only [aliasFormerProducedGenerationShapeCandidate] using + VInductDecl.produceGenerationShapeCandidate_eq_ok + (source := aliasFormerRawDecl) (raw := aliasFormerRawType) + produced aliasFormerCandidate_generationShape + +/-- Complete source-indexed candidate certificate for the non-identity +AliasFormer generation transaction. -/ +def aliasFormerGenerationCandidateSemanticRun : + VInductDecl.GenerationCandidateSemanticRun + aliasFormerNormalizationCandidateSemanticRun + aliasFormerGenerationChecked := + VInductDecl.GenerationCandidateSemanticRun.ofGenerationShape + aliasFormerNormalizationCandidateSemanticRun + aliasFormerGenerationChecked rfl aliasFormerCandidate_viewDecl_wf + aliasFormerCandidate_generationShape + +def aliasFormerGenerationCandidateRun : + VInductDecl.GenerationCandidateRun + aliasFormerNormalizationCandidateRun + aliasFormerGenerationChecked := + aliasFormerGenerationCandidateSemanticRun.run + +/-- The generic dependent package retains the exact AliasFormer kernel +source, candidate trace, reconstructed normalization, successful dependent +analysis, and semantic generation run in one value. -/ +def aliasFormerGenerationCandidatePackage : + VInductDecl.GenerationCandidatePackage typeFamilyAliasEnv [] := + aliasFormerGenerationCandidateSemanticRun.package + +/-- The complete AliasFormer semantic package is selected by the exact +successful whole-call metadata producer, including its pre-family and +post-family checker environments. -/ +def aliasFormerProducedGenerationCandidatePackage : + VInductDecl.ProducedGenerationCandidatePackage typeFamilyAliasEnv [] := + aliasFormerProducedGenerationShapeCandidate.producedPackage + aliasFormerNormalizationCandidateSemanticRun rfl + aliasFormerGenerationChecked rfl aliasFormerCandidate_viewDecl_wf + +/-- Theory-only erasure of the AliasFormer producer package. This is the +consumer-facing value accepted by the public non-identity transaction. -/ +def aliasFormerGenerationCertificate : + aliasFormerRawDecl.GenerationCertificate typeFamilyAliasEnv := + aliasFormerProducedGenerationCandidatePackage.package.certificate + +/-- The public proof-carrying path exposes AliasFormer's candidate-derived +non-identity generation without exposing its checker package. -/ +theorem aliasFormer_addInductCertified_checked : + typeFamilyAliasEnv.addInductCertified + aliasFormerGenerationCertificate = + some aliasFormerFinalEnv := + aliasFormer_addInductGeneration + +theorem aliasFormerCertified_trace : + Nonempty (VEnv.AddInductGenerationTrace typeFamilyAliasEnv + aliasFormerFinalEnv aliasFormerGenerationChecked) := + VEnv.addInductCertified_trace aliasFormer_addInductCertified_checked + +theorem aliasFormerCertified_ordered : aliasFormerFinalEnv.Ordered := + VEnv.addInductCertified_WF typeFamilyAliasEnv_ordered + aliasFormer_addInductCertified_checked + +/-- Complete checker-side AliasFormer generation run, now derived by the +generic family/constructor spine assembler from the executable singleton +candidate rather than assembled field-by-field by the fixture. -/ +def aliasFormerGenerationRun : + VInductDecl.GenerationRun aliasFormerGenerationChecked + typeFamilyAliasEnv := + aliasFormerProducedGenerationCandidatePackage.package.run.generationRun + +/-- Generation-ready AliasFormer certificate whose raw/view family equality +comes from the verified checker execution rather than the fixture's explicit +delta rule. -/ +theorem aliasFormerGenerationChecked_wf_checked : + aliasFormerGenerationChecked.WF typeFamilyAliasEnv := + aliasFormerGenerationCertificate.wf + +/-- The paired AliasRec block with its field normalization supplied by the +checked WHNF/application/beta certificate. -/ +theorem aliasRecBlock_wf_checked : + aliasRecBlock.WF recAliasEnv := by + refine ⟨aliasRecNormalization_wf_checked, ?_⟩ + change aliasRecViewChecked.WF recAliasEnv + exact aliasRecViewChecked.wf_of_decl aliasRecViewDecl_wf + +/-- Complete checker-side AliasRec generation run. Its constructor telescope +retains the checked compositional alias equality as pointwise evidence. -/ +def aliasRecGenerationRun : + VInductDecl.GenerationRun aliasRecGenerationChecked recAliasEnv := by + refine { + normalization := aliasRecNormalizationRun + checked := aliasRecViewChecked.wf_of_decl aliasRecViewDecl_wf + familyTel := .nil familyResult := .refl (VEnv.HasType.sort (by decide)) typeEnv := aliasRecTypeEnv addType := rfl @@ -3800,115 +7667,1902 @@ def aliasRecGenerationRun : emittedTel := .cons aliasRecFieldEvidence .nil emittedResult := .refl hresult } -/-- Generation-ready AliasRec certificate whose raw field typing comes from -the exact post-family full-check run and whose normalization equality composes -the verified WHNF, application, and beta steps. -/ -theorem aliasRecGenerationChecked_wf_checked : - aliasRecGenerationChecked.WF recAliasEnv := - aliasRecGenerationRun.wf +/-- Generation-ready AliasRec certificate whose raw field typing comes from +the exact post-family full-check run and whose normalization equality composes +the verified WHNF, application, and beta steps. -/ +theorem aliasRecGenerationChecked_wf_checked : + aliasRecGenerationChecked.WF recAliasEnv := + aliasRecGenerationRun.wf + +/-! ## Annotated recursive-Pi candidate interpretation -/ + +private def annotatedPiRawDomain : VExpr := + .app (.const ``outParam [.succ .zero]) (.sort .zero) + +private def annotatedPiRawInner : VExpr := + .forallE annotatedPiRawDomain (.const ``AnnotatedPi []) + +private def annotatedPiViewInner : VExpr := + .forallE (.sort .zero) (.const ``AnnotatedPi []) + +private theorem annotatedPiFamilyConst_hasType (Γ : List VExpr) : + annotatedPiTypeEnv.HasType 0 Γ + (.const ``AnnotatedPi []) (.sort (.succ .zero)) := by + have hfamily : annotatedPiTypeEnv.constants ``AnnotatedPi = + some annotatedPiRawType.toVConstant := rfl + type_tac + +private theorem annotatedPiRawDomain_hasType (Γ : List VExpr) : + annotatedPiTypeEnv.HasType 0 Γ annotatedPiRawDomain + (.sort (.succ .zero)) := by + have hout : annotatedPiTypeEnv.constants ``outParam = + some (vconst(type_of% @outParam)) := rfl + type_tac + +private theorem annotatedPiForall_hasType + {Γ : List VExpr} {domain body : VExpr} + (domainType : annotatedPiTypeEnv.HasType 0 Γ domain + (.sort (.succ .zero))) + (bodyType : annotatedPiTypeEnv.HasType 0 (domain :: Γ) body + (.sort (.succ .zero))) : + annotatedPiTypeEnv.HasType 0 Γ (.forallE domain body) + (.sort (.succ .zero)) := + .defeqDF + (.sortDF (by decide) (by decide) VLevel.imax_self) + (VEnv.HasType.forallE domainType bodyType) + +private theorem annotatedPiRawInner_hasType (Γ : List VExpr) : + annotatedPiTypeEnv.HasType 0 Γ annotatedPiRawInner + (.sort (.succ .zero)) := by + simpa [annotatedPiRawInner] using annotatedPiForall_hasType + (annotatedPiRawDomain_hasType Γ) + (annotatedPiFamilyConst_hasType (annotatedPiRawDomain :: Γ)) + +private theorem annotatedPiViewInner_hasType (Γ : List VExpr) : + annotatedPiTypeEnv.HasType 0 Γ annotatedPiViewInner + (.sort (.succ .zero)) := by + simpa [annotatedPiViewInner] using annotatedPiForall_hasType + (VEnv.HasType.sort (by decide)) + (annotatedPiFamilyConst_hasType ((.sort .zero) :: Γ)) + +private theorem annotatedPiRawCtor_hasType : + annotatedPiTypeEnv.HasType 0 [] + annotatedPiRawType.ctors[0].type (.sort (.succ .zero)) := by + rw [show annotatedPiRawType.ctors[0].type = + .forallE annotatedPiRawInner (.const ``AnnotatedPi []) by rfl] + simpa using annotatedPiForall_hasType + (annotatedPiRawInner_hasType []) + (annotatedPiFamilyConst_hasType [annotatedPiRawInner]) + +private theorem annotatedPiViewCtor_hasType : + annotatedPiTypeEnv.HasType 0 [] + annotatedPiViewCtor.type (.sort (.succ .zero)) := by + simpa [annotatedPiViewCtor, annotatedPiViewInner] using + annotatedPiForall_hasType (annotatedPiViewInner_hasType []) + (annotatedPiFamilyConst_hasType [annotatedPiViewInner]) + +private theorem annotatedPiCtorSource_tr : + TrExprS annotatedPiTypeEnv [] [] annotatedPiMkInfo.type + annotatedPiRawType.ctors[0].type := by + have hshape : TrTypeExpr annotatedPiTypeEnv [] [] + annotatedPiMkInfo.type annotatedPiRawType.ctors[0].type := by + tr_type_expr_tac + exact hshape.to_trExprS annotatedPiTypeEnv_ordered trivial + ⟨_, annotatedPiRawCtor_hasType⟩ + +private theorem annotatedPiInnerSource_tr : + TrExprS annotatedPiTypeEnv [] [] annotatedPiInnerKernel + annotatedPiRawInner := by + have hshape : TrTypeExpr annotatedPiTypeEnv [] [] + annotatedPiInnerKernel annotatedPiRawInner := by + tr_type_expr_tac + exact hshape.to_trExprS annotatedPiTypeEnv_ordered trivial + ⟨_, annotatedPiRawInner_hasType []⟩ + +private theorem annotatedPiDomainSource_tr : + TrExprS annotatedPiTypeEnv [] [] annotatedPiRawDomainKernel + annotatedPiRawDomain := by + have hshape : TrTypeExpr annotatedPiTypeEnv [] [] + annotatedPiRawDomainKernel annotatedPiRawDomain := by + tr_type_expr_tac + exact hshape.to_trExprS annotatedPiTypeEnv_ordered trivial + ⟨_, annotatedPiRawDomain_hasType []⟩ + +private theorem annotatedPiConstSource_tr (Δ : VLCtx) : + TrExprS annotatedPiTypeEnv [] Δ (Expr.const ``AnnotatedPi []) + (VExpr.const ``AnnotatedPi []) := + .const rfl rfl rfl + +private theorem annotatedPiInstConstSource_tr (Δ : VLCtx) : + TrExprS annotatedPiTypeEnv [] Δ + ((Expr.const ``AnnotatedPi []).instantiate1 + annotatedPiCtorCandidateContext.freshExpr) + (VExpr.const ``AnnotatedPi []) := by + simpa using annotatedPiConstSource_tr Δ + +private theorem annotatedPiFamilyCandidatePrefix_ne : + annotatedPiFamilyCandidateContext.ngen.namePrefix ≠ + (({} : TypeChecker.VState).ngen).namePrefix := by + decide + +private def annotatedPiFamilyCandidateContextRun : + TypeChecker.CandidateContextRun annotatedPiFamilyCandidateContext := + TypeChecker.CandidateContextRun.root outParamVEnvs_wf rfl + annotatedPiFamilyCandidatePrefix_ne + +private theorem annotatedPiFamilySource_tr : + TrExprS outParamEnv [] [] annotatedPiInfo.type + annotatedPiRawType.type := + annotatedPiInfo_tr.1.2.2 + +private def annotatedPiPreFamilyStage : + TypeChecker.CandidateSemanticStage annotatedPiFamilyCandidateContext + outParamEnv [] where + contextRun := annotatedPiFamilyCandidateContextRun + venv_eq := rfl + lparams_eq := rfl + vlctx_eq := rfl + +private def annotatedPiFamilyValidationRun : + AddInductive.CandidateExprTrace.FamilyValidationRun + annotatedPiKernelType annotatedPiFamilyCandidate.trace where + nparams := 0 + resultLevel := .succ .zero + stats := annotatedPiInductiveStats + stats_eq := rfl + terminal_eq := rfl + run := annotatedPi_checkInductiveTypes + +private def annotatedPiFamilyStage : + VInductDecl.CandidateFamilyStagedInput + annotatedPiFamilyCandidateContext annotatedPiCtorCandidateContext + outParamEnv [] annotatedPiFamilyListCandidate.familyType + annotatedPiRawType annotatedPiPreFamilyStage where + name_eq := rfl + uvars_eq := rfl + type := { + context_eq := rfl + source_tr := annotatedPiFamilySource_tr + whnfFuel := 9999 + whnfDepth := rfl } + validation := annotatedPiFamilyValidationRun + typeEnv := annotatedPiTypeEnv + addInduct := annotatedPiAddType + family_lctx_eq := rfl + constructorContext_eq := rfl + quotInit_eq := rfl + name_not_reflected := by decide + name_not_primitive := by + simp [annotatedPiRawType, Kernel.Environment.primitives, + NameSet.ofList] + simp +decide [NameSet.contains] + +private def annotatedPiCtorCandidateContextRun : + TypeChecker.CandidateContextRun annotatedPiCtorCandidateContext := + annotatedPiFamilyStage.postContextRun + +private def annotatedPiInnerBodyCandidateContextRun : + TypeChecker.CandidateContextRun + annotatedPiInnerBodyCandidateContext := by + simpa [annotatedPiInnerBodyCandidateContext, + annotatedPiDomainAnnotations] using + annotatedPiCtorCandidateContextRun.pushLocalDecl `p .default + (.sort .zero) annotatedPiCtorCandidateFresh (.sort .zero) + (TrExprS.sort rfl) + ⟨.succ .zero, VEnv.HasType.sort (by decide)⟩ + +private def annotatedPiOuterBodyCandidateContextRun : + TypeChecker.CandidateContextRun + annotatedPiOuterBodyCandidateContext := by + have domain_tr : + annotatedPiCtorCandidateContextRun.context.TrExprS + annotatedPiInnerKernel annotatedPiRawInner := by + change + (annotatedPiFamilyStage.postFamily.contextRun.context.TrExprS + annotatedPiInnerKernel annotatedPiRawInner) + change TrExprS + annotatedPiFamilyStage.postFamily.contextRun.context.venv + annotatedPiFamilyStage.postFamily.contextRun.context.lparams + annotatedPiFamilyStage.postFamily.contextRun.context.vlctx + annotatedPiInnerKernel annotatedPiRawInner + rw [annotatedPiFamilyStage.postFamily.venv_eq, + annotatedPiFamilyStage.postFamily.lparams_eq, + annotatedPiFamilyStage.postFamily.vlctx_eq] + change TrExprS annotatedPiTypeEnv [] [] + annotatedPiInnerKernel annotatedPiRawInner + exact annotatedPiInnerSource_tr + simpa [annotatedPiOuterBodyCandidateContext, + annotatedPiInnerAnnotations] using + annotatedPiCtorCandidateContextRun.pushLocalDecl + annotatedPiOuterName .default annotatedPiInnerKernel + annotatedPiCtorCandidateFresh annotatedPiRawInner domain_tr + ⟨.succ .zero, annotatedPiRawInner_hasType []⟩ + +private theorem annotatedPiInnerBodyCandidateContextRun_vlctx : + annotatedPiInnerBodyCandidateContextRun.context.vlctx = + [(some (annotatedPiCtorCandidateContext.freshFVarId, + annotatedPiDomainAnnotations.consumed.fvarsList), + .vlam (.sort .zero))] := by + rfl + +private theorem annotatedPiOuterBodyCandidateContextRun_vlctx : + annotatedPiOuterBodyCandidateContextRun.context.vlctx = + [(some (annotatedPiCtorCandidateContext.freshFVarId, + annotatedPiInnerAnnotations.consumed.fvarsList), + .vlam annotatedPiRawInner)] := by + rfl + +private def annotatedPiFamilyCandidateNodeRun : + TypeChecker.CandidateNodeRun outParamEnv [] [] + annotatedPiFamilyCandidateContext annotatedPiInfo.type + (.sort (.succ (.succ .zero))) annotatedPiInfo.type + annotatedPiRawType.type annotatedPiRawType.type + (.sort (.succ (.succ .zero))) := by + exact TypeChecker.CandidateNodeRun.ofCandidate + annotatedPiFamilyCandidateContext annotatedPiInfo.type + (.sort (.succ (.succ .zero))) annotatedPiInfo.type + annotatedPiFamilyCheckTypeStep_valid + annotatedPiFamilyCandidateStep_valid + annotatedPiFamilyCandidateContextRun.context + annotatedPiFamilyCandidateContextRun.context_eq + rfl rfl rfl annotatedPiFamilyCandidateContextRun.state_wf + (.sort rfl) (.sort rfl) + ⟨_, TrExprS.sort rfl, + ⟨_, VEnv.HasType.sort (by decide)⟩⟩ + 10000 9999 rfl rfl + +private def annotatedPiFamilyCandidateRun : + TypeChecker.CandidateExprRun outParamEnv [] + annotatedPiFamilyCandidate.trace [] + annotatedPiRawType.type annotatedPiRawType.type + (.sort (.succ (.succ .zero))) := + .terminal annotatedPiFamilyCandidateNodeRun + +private def annotatedPiFamilySemanticRootRun : + TypeChecker.CandidateExprSemanticRootRun outParamEnv [] + annotatedPiFamilyCandidate annotatedPiRawType.type + where + contextRun := annotatedPiFamilyCandidateContextRun + venv_eq := rfl + lparams_eq := rfl + vlctx_eq := rfl + source_tr := annotatedPiFamilyCandidateRun.source_tr + whnfFuel := 9999 + whnfDepth := rfl + view := annotatedPiRawType.type + recursive := ⟨.sort (.succ (.succ .zero)), + annotatedPiFamilyCandidateRun⟩ + +private def annotatedPiFamilyRootRun : + TypeChecker.CandidateExprRootRun outParamEnv [] + annotatedPiFamilyCandidate annotatedPiRawType.type + annotatedPiRawType.type := + annotatedPiFamilySemanticRootRun.root + +private def annotatedPiFamilySpineRun : + TypeChecker.CandidateExprSpineRun outParamEnv [] + annotatedPiFamilyCandidate annotatedPiRawType.type + annotatedPiRawType.type := + annotatedPiFamilySemanticRootRun.spine rfl + +private def annotatedPiCtorCandidateNodeRun : + TypeChecker.CandidateNodeRun annotatedPiTypeEnv [] [] + annotatedPiCtorCandidateContext annotatedPiMkInfo.type + (.sort (.succ .zero)) annotatedPiMkInfo.type + annotatedPiRawType.ctors[0].type + annotatedPiRawType.ctors[0].type + (.sort (.succ .zero)) := by + exact TypeChecker.CandidateNodeRun.ofCandidate + annotatedPiCtorCandidateContext annotatedPiMkInfo.type + (.sort (.succ .zero)) annotatedPiMkInfo.type + annotatedPiCtorCheckTypeStep_valid annotatedPiCtorCandidateStep_valid + annotatedPiCtorCandidateContextRun.context + annotatedPiCtorCandidateContextRun.context_eq + rfl rfl rfl annotatedPiCtorCandidateContextRun.state_wf + annotatedPiCtorSource_tr (.sort rfl) + ⟨_, annotatedPiCtorSource_tr, ⟨_, annotatedPiRawCtor_hasType⟩⟩ + 10000 9999 rfl rfl + +private def annotatedPiInnerCandidateNodeRun : + TypeChecker.CandidateNodeRun annotatedPiTypeEnv [] [] + annotatedPiCtorCandidateContext annotatedPiInnerKernel + (.sort (.succ .zero)) annotatedPiInnerKernel + annotatedPiRawInner annotatedPiRawInner + (.sort (.succ .zero)) := by + exact TypeChecker.CandidateNodeRun.ofCandidate + annotatedPiCtorCandidateContext annotatedPiInnerKernel + (.sort (.succ .zero)) annotatedPiInnerKernel + annotatedPiInnerCheckTypeStep_valid annotatedPiInnerCandidateStep_valid + annotatedPiCtorCandidateContextRun.context + annotatedPiCtorCandidateContextRun.context_eq + rfl rfl rfl annotatedPiCtorCandidateContextRun.state_wf + annotatedPiInnerSource_tr (.sort rfl) + ⟨_, annotatedPiInnerSource_tr, + ⟨_, annotatedPiRawInner_hasType []⟩⟩ + 10000 9999 rfl rfl + +private def annotatedPiDomainCandidateNodeRun : + TypeChecker.CandidateNodeRun annotatedPiTypeEnv [] [] + annotatedPiCtorCandidateContext annotatedPiRawDomainKernel + (.sort (.succ .zero)) (.sort .zero) + annotatedPiRawDomain (.sort .zero) + (.sort (.succ .zero)) := by + exact TypeChecker.CandidateNodeRun.ofCandidate + annotatedPiCtorCandidateContext annotatedPiRawDomainKernel + (.sort (.succ .zero)) (.sort .zero) + annotatedPiDomainCheckTypeStep_valid annotatedPiDomainCandidateStep_valid + annotatedPiCtorCandidateContextRun.context + annotatedPiCtorCandidateContextRun.context_eq + rfl rfl rfl annotatedPiCtorCandidateContextRun.state_wf + annotatedPiDomainSource_tr (.sort rfl) + ⟨_, TrExprS.sort rfl, + ⟨_, VEnv.HasType.sort (by decide)⟩⟩ + 10000 9999 rfl rfl + +private def annotatedPiInnerBodyCandidateNodeRun : + TypeChecker.CandidateNodeRun annotatedPiTypeEnv [] + annotatedPiInnerBodyCandidateContextRun.context.vlctx + annotatedPiInnerBodyCandidateContext + ((Expr.const ``AnnotatedPi []).instantiate1 + annotatedPiCtorCandidateContext.freshExpr) + (.sort (.succ .zero)) (.const ``AnnotatedPi []) + (.const ``AnnotatedPi []) (.const ``AnnotatedPi []) + (.sort (.succ .zero)) := by + exact TypeChecker.CandidateNodeRun.ofCandidate + annotatedPiInnerBodyCandidateContext + ((Expr.const ``AnnotatedPi []).instantiate1 + annotatedPiCtorCandidateContext.freshExpr) + (.sort (.succ .zero)) (.const ``AnnotatedPi []) + (by simpa only [annotatedPiInnerBodyCheckTypeStep, + annotatedPiConst_instantiate1] using + annotatedPiInnerBodyCheckTypeStep_valid) + (by simpa only [annotatedPiInnerBodyCandidateStep, + annotatedPiConst_instantiate1] using + annotatedPiInnerBodyCandidateStep_valid) + annotatedPiInnerBodyCandidateContextRun.context + annotatedPiInnerBodyCandidateContextRun.context_eq + rfl rfl rfl annotatedPiInnerBodyCandidateContextRun.state_wf + (annotatedPiInstConstSource_tr + annotatedPiInnerBodyCandidateContextRun.context.vlctx) + (.sort rfl) + ⟨_, annotatedPiConstSource_tr + annotatedPiInnerBodyCandidateContextRun.context.vlctx, + ⟨_, annotatedPiFamilyConst_hasType + annotatedPiInnerBodyCandidateContextRun.context.vlctx.toCtx⟩⟩ + 10000 9999 rfl rfl + +private def annotatedPiOuterBodyCandidateNodeRun : + TypeChecker.CandidateNodeRun annotatedPiTypeEnv [] + annotatedPiOuterBodyCandidateContextRun.context.vlctx + annotatedPiOuterBodyCandidateContext + ((Expr.const ``AnnotatedPi []).instantiate1 + annotatedPiCtorCandidateContext.freshExpr) + (.sort (.succ .zero)) (.const ``AnnotatedPi []) + (.const ``AnnotatedPi []) (.const ``AnnotatedPi []) + (.sort (.succ .zero)) := by + exact TypeChecker.CandidateNodeRun.ofCandidate + annotatedPiOuterBodyCandidateContext + ((Expr.const ``AnnotatedPi []).instantiate1 + annotatedPiCtorCandidateContext.freshExpr) + (.sort (.succ .zero)) (.const ``AnnotatedPi []) + (by simpa only [annotatedPiOuterBodyCheckTypeStep, + annotatedPiConst_instantiate1] using + annotatedPiOuterBodyCheckTypeStep_valid) + (by simpa only [annotatedPiOuterBodyCandidateStep, + annotatedPiConst_instantiate1] using + annotatedPiOuterBodyCandidateStep_valid) + annotatedPiOuterBodyCandidateContextRun.context + annotatedPiOuterBodyCandidateContextRun.context_eq + rfl rfl rfl annotatedPiOuterBodyCandidateContextRun.state_wf + (annotatedPiInstConstSource_tr + annotatedPiOuterBodyCandidateContextRun.context.vlctx) + (.sort rfl) + ⟨_, annotatedPiConstSource_tr + annotatedPiOuterBodyCandidateContextRun.context.vlctx, + ⟨_, annotatedPiFamilyConst_hasType + annotatedPiOuterBodyCandidateContextRun.context.vlctx.toCtx⟩⟩ + 10000 9999 rfl rfl + +private def annotatedPiDomainAnnotationsRun : + TypeChecker.IsDefEqRun annotatedPiTypeEnv [] [] + annotatedPiRawDomainKernel annotatedPiDomainAnnotations.consumed + annotatedPiRawDomain (.sort .zero) := by + exact TypeChecker.IsDefEqRun.ofCandidateStep + ⟨annotatedPiCtorCandidateContext, annotatedPiRawDomainKernel, + annotatedPiDomainAnnotations.consumed⟩ + annotatedPiDomainAnnotationsEq + annotatedPiCtorCandidateContextRun.context + annotatedPiCtorCandidateContextRun.context_eq + rfl rfl rfl annotatedPiCtorCandidateContextRun.state_wf + annotatedPiDomainSource_tr (.sort rfl) 10000 rfl + +private def annotatedPiInnerAnnotationsRun : + TypeChecker.IsDefEqRun annotatedPiTypeEnv [] [] + annotatedPiInnerKernel annotatedPiInnerAnnotations.consumed + annotatedPiRawInner annotatedPiRawInner := by + exact TypeChecker.IsDefEqRun.ofCandidateStep + ⟨annotatedPiCtorCandidateContext, annotatedPiInnerKernel, + annotatedPiInnerAnnotations.consumed⟩ + annotatedPiInnerAnnotationsEq + annotatedPiCtorCandidateContextRun.context + annotatedPiCtorCandidateContextRun.context_eq + rfl rfl rfl annotatedPiCtorCandidateContextRun.state_wf + annotatedPiInnerSource_tr annotatedPiInnerSource_tr 10000 rfl + +private def annotatedPiDomainCandidateRun : + TypeChecker.CandidateExprRun annotatedPiTypeEnv [] + annotatedPiDomainCandidateTrace [] annotatedPiRawDomain + (.sort .zero) (.sort (.succ .zero)) := + .terminal annotatedPiDomainCandidateNodeRun + +private def annotatedPiInnerBodyCandidateRun : + TypeChecker.CandidateExprRun annotatedPiTypeEnv [] + annotatedPiInnerBodyCandidateTrace + [(some (annotatedPiCtorCandidateContext.freshFVarId, + annotatedPiDomainAnnotations.consumed.fvarsList), + .vlam (.sort .zero))] + (.const ``AnnotatedPi []) (.const ``AnnotatedPi []) + (.sort (.succ .zero)) := by + simpa only [annotatedPiInnerBodyCandidateTrace, + annotatedPiInnerBodyCandidateContextRun_vlctx] using + (TypeChecker.CandidateExprRun.terminal + annotatedPiInnerBodyCandidateNodeRun) + +private def annotatedPiOuterBodyCandidateRun : + TypeChecker.CandidateExprRun annotatedPiTypeEnv [] + annotatedPiOuterBodyCandidateTrace + [(some (annotatedPiCtorCandidateContext.freshFVarId, + annotatedPiInnerAnnotations.consumed.fvarsList), + .vlam annotatedPiRawInner)] + (.const ``AnnotatedPi []) (.const ``AnnotatedPi []) + (.sort (.succ .zero)) := by + simpa only [annotatedPiOuterBodyCandidateTrace, + annotatedPiOuterBodyCandidateContextRun_vlctx] using + (TypeChecker.CandidateExprRun.terminal + annotatedPiOuterBodyCandidateNodeRun) + +private def annotatedPiInnerCandidateRun : + TypeChecker.CandidateExprRun annotatedPiTypeEnv [] + annotatedPiInnerCandidateTrace [] annotatedPiRawInner + annotatedPiViewInner (.sort (.succ .zero)) := by + exact .forallE annotatedPiDomainAnnotations + annotatedPiDomainAnnotationsEq annotatedPiDomainCandidateTrace + annotatedPiInnerBodyCandidateTrace + annotatedPiInnerCandidateNodeRun annotatedPiDomainCandidateRun + annotatedPiDomainAnnotationsRun annotatedPiInnerBodyCandidateRun + (annotatedPiRawDomain_hasType []) + (annotatedPiFamilyConst_hasType [annotatedPiRawDomain]) + (annotatedPiFamilyConst_hasType [annotatedPiRawDomain]) rfl + +private def annotatedPiCtorCandidateRun : + TypeChecker.CandidateExprRun annotatedPiTypeEnv [] + annotatedPiCtorCandidate.trace [] + annotatedPiRawType.ctors[0].type annotatedPiViewCtor.type + (.sort (.succ .zero)) := by + exact .forallE annotatedPiInnerAnnotations + annotatedPiInnerAnnotationsEq annotatedPiInnerCandidateTrace + annotatedPiOuterBodyCandidateTrace + annotatedPiCtorCandidateNodeRun annotatedPiInnerCandidateRun + annotatedPiInnerAnnotationsRun annotatedPiOuterBodyCandidateRun + (annotatedPiRawInner_hasType []) + (annotatedPiFamilyConst_hasType [annotatedPiRawInner]) + (annotatedPiFamilyConst_hasType [annotatedPiRawInner]) rfl + +private def annotatedPiCtorSemanticRootRun : + TypeChecker.CandidateExprSemanticRootRun annotatedPiTypeEnv [] + annotatedPiCtorCandidate annotatedPiRawType.ctors[0].type + where + contextRun := annotatedPiCtorCandidateContextRun + venv_eq := rfl + lparams_eq := rfl + vlctx_eq := rfl + source_tr := annotatedPiCtorCandidateRun.source_tr + whnfFuel := 9999 + whnfDepth := rfl + view := annotatedPiViewCtor.type + recursive := ⟨.sort (.succ .zero), annotatedPiCtorCandidateRun⟩ + +private def annotatedPiCtorRootRun : + TypeChecker.CandidateExprRootRun annotatedPiTypeEnv [] + annotatedPiCtorCandidate annotatedPiRawType.ctors[0].type + annotatedPiViewCtor.type := + annotatedPiCtorSemanticRootRun.root + +private theorem annotatedPiCtorCandidate_storedSpine : + annotatedPiCtorCandidate.trace.storedSpine = true := by + have hsource : annotatedPiMkInfo.type = + .forallE annotatedPiOuterName annotatedPiInnerKernel + (.const ``AnnotatedPi []) .default := rfl + simp only [annotatedPiCtorCandidate, annotatedPiCtorCandidateTrace, + AddInductive.CandidateExprTrace.storedSpine, hsource, + beq_self_eq_true, Bool.true_and] + rfl + +private def annotatedPiCtorSpineRun : + TypeChecker.CandidateExprSpineRun annotatedPiTypeEnv [] + annotatedPiCtorCandidate annotatedPiRawType.ctors[0].type + annotatedPiViewCtor.type := + annotatedPiCtorSemanticRootRun.spine + annotatedPiCtorCandidate_storedSpine + +private def annotatedPiCandidateConstructorSemanticRun : + VInductDecl.CandidateConstructorSemanticRun annotatedPiTypeEnv [] + annotatedPiConstructorCandidate annotatedPiRawType.ctors[0] where + name_eq := rfl + uvars_eq := rfl + type := annotatedPiCtorSemanticRootRun + +private def annotatedPiCandidateConstructorRun : + VInductDecl.CandidateConstructorRun annotatedPiTypeEnv [] + annotatedPiConstructorCandidate annotatedPiRawType.ctors[0] := + annotatedPiCandidateConstructorSemanticRun.root + +private def annotatedPiCandidateConstructorSemanticListRun : + VInductDecl.CandidateConstructorSemanticListRun annotatedPiTypeEnv [] + annotatedPiFamilyListCandidate.constructors + annotatedPiRawType.ctors := by + exact .cons annotatedPiCandidateConstructorSemanticRun .nil + +private def annotatedPiCandidateConstructorListRun : + VInductDecl.CandidateConstructorListRun annotatedPiTypeEnv [] + annotatedPiFamilyListCandidate.constructors + annotatedPiRawType.ctors := + annotatedPiCandidateConstructorSemanticListRun.roots + +private def annotatedPiCandidateFamilySemanticRun : + VInductDecl.CandidateFamilySemanticRun outParamEnv [] + annotatedPiFamilyListCandidate annotatedPiRawType where + name_eq := rfl + uvars_eq := rfl + type := annotatedPiFamilySemanticRootRun + typeEnv := annotatedPiTypeEnv + addType := rfl + constructors := annotatedPiCandidateConstructorSemanticListRun + +private def annotatedPiCandidateFamilyRun : + VInductDecl.CandidateFamilyRun outParamEnv [] + annotatedPiFamilyListCandidate annotatedPiRawType := + annotatedPiCandidateFamilySemanticRun.root + +/-- Temporary L4L-01A compatibility witness for the annotation-bearing +recursive Pi fixture. The staged owner proves existence without choosing it; +L4L-01E removes this explicit downstream value. -/ +private def annotatedPiNormalizationCandidateSemanticRun : + VInductDecl.NormalizationCandidateSemanticRun outParamEnv [] + annotatedPiNormalizationCandidate annotatedPiRawDecl where + raw := annotatedPiRawType + raw_types_eq := rfl + uvars_eq := rfl + family := annotatedPiCandidateFamilySemanticRun + +private def annotatedPiStagedSemanticInput : + VInductDecl.StagedNormalizationCandidateSemanticInput + annotatedPiFamilyCandidateContext annotatedPiCtorCandidateContext + outParamEnv [] annotatedPiNormalizationCandidate + annotatedPiRawDecl where + raw := annotatedPiRawType + raw_types_eq := rfl + declaration_uvars_eq := rfl + preFamily := annotatedPiPreFamilyStage + family := annotatedPiFamilyStage + constructors := .cons { + name_eq := rfl + uvars_eq := rfl + type := { + context_eq := rfl + source_tr := annotatedPiCtorCandidateRun.source_tr + whnfFuel := 9999 + whnfDepth := rfl } } .nil + familyTypesProduced := annotatedPiFamilyTypeListProduced + familiesProduced := annotatedPiFamilyListProduced + +/-- The exact family/constructor producer traversals and verified translations +automatically determine the complete retained AnnotatedPi hierarchy, including +its nested annotation-consuming constructor trace. -/ +theorem annotatedPiProducedSemanticHierarchy_exists : + Nonempty (VInductDecl.ProducedNormalizationCandidateSemanticRun + annotatedPiFamilyCandidateContext annotatedPiCtorCandidateContext + outParamEnv [] annotatedPiNormalizationCandidate + annotatedPiRawDecl) := + annotatedPiStagedSemanticInput.exists + +def annotatedPiNormalizationCandidateRun : + VInductDecl.NormalizationCandidateRun outParamEnv [] + annotatedPiNormalizationCandidate annotatedPiRawDecl := + annotatedPiNormalizationCandidateSemanticRun.root + +example : annotatedPiNormalizationCandidateRun.viewDecl = + annotatedPiViewDecl := rfl + +theorem annotatedPiCandidateNormalization_eq : + annotatedPiNormalizationCandidateRun.normalization = + annotatedPiNormalization := rfl + +def annotatedPiNormalizationRun : + VInductDecl.NormalizationRun annotatedPiNormalization outParamEnv := by + simpa only [annotatedPiCandidateNormalization_eq] using + annotatedPiNormalizationCandidateRun.normalizationRun + +theorem annotatedPiNormalization_wf_checked : + annotatedPiNormalization.WF outParamEnv := + annotatedPiNormalizationRun.wf + +theorem annotatedPiBlock_wf_checked : + annotatedPiBlock.WF outParamEnv := by + refine ⟨annotatedPiNormalization_wf_checked, ?_⟩ + exact annotatedPiViewChecked_wf + +private theorem annotatedPiCandidate_generationShape : + annotatedPiNormalizationCandidateSemanticRun.generationShape = true := by + change ((true && true) && + (annotatedPiCtorCandidate.trace.storedSpine && true && true)) = true + rw [annotatedPiCtorCandidate_storedSpine] + rfl + +/-- Temporary L4L-01A view-WF compatibility premise. L4L-01D derives this +from retained validation and L4L-01E removes it from package construction. -/ +private theorem annotatedPiCandidate_viewDecl_wf : + annotatedPiNormalizationCandidateRun.viewDecl.WF outParamEnv := by + change annotatedPiViewDecl.WF outParamEnv + apply annotatedPiViewDecl_wf.mono + exact (VEnv.addConst_le (by rfl : + VEnv.empty.addConst ``outParam (vconst(type_of% @outParam)) = + some outParamConstEnv)).trans VEnv.addDefEq_le + +private def annotatedPiProducedGenerationShapeCandidate : + VInductDecl.ProducedGenerationShapeCandidate annotatedPiRawDecl + annotatedPiRawType annotatedPiKernelType 0 false + annotatedPiFamilyCandidateContext where + candidate := annotatedPiNormalizationCandidate + produced := annotatedPiNormalizationCandidate_produced + shape := annotatedPiCandidate_generationShape + +/-- The strengthened outer gate retains AnnotatedPi's nested annotation- +normalizing candidate only after its complete raw generation spine passes. -/ +theorem annotatedPiGenerationShapeCandidate_produced : + VInductDecl.produceGenerationShapeCandidate annotatedPiRawDecl + annotatedPiRawType annotatedPiKernelType 0 false + annotatedPiFamilyCandidateContext = + .ok annotatedPiProducedGenerationShapeCandidate := by + have produced : + AddInductive.buildNormalizationCandidate annotatedPiRawDecl.nparams + [annotatedPiKernelType] 0 false annotatedPiFamilyCandidateContext = + .ok annotatedPiNormalizationCandidate := + annotatedPiNormalizationCandidate_produced + simpa only [annotatedPiProducedGenerationShapeCandidate] using + VInductDecl.produceGenerationShapeCandidate_eq_ok + (source := annotatedPiRawDecl) (raw := annotatedPiRawType) + produced annotatedPiCandidate_generationShape + +/-- Complete source-indexed checker certificate for annotated recursive-Π +generation. This is the first live generation run whose main constructor +spine contains an annotation-normalized recursive function domain. -/ +def annotatedPiGenerationCandidateSemanticRun : + VInductDecl.GenerationCandidateSemanticRun + annotatedPiNormalizationCandidateSemanticRun + annotatedPiGenerationChecked := + VInductDecl.GenerationCandidateSemanticRun.ofGenerationShape + annotatedPiNormalizationCandidateSemanticRun + annotatedPiGenerationChecked rfl annotatedPiCandidate_viewDecl_wf + annotatedPiCandidate_generationShape + +def annotatedPiGenerationCandidateRun : + VInductDecl.GenerationCandidateRun + annotatedPiNormalizationCandidateRun + annotatedPiGenerationChecked := + annotatedPiGenerationCandidateSemanticRun.run + +/-- Complete dependent producer package for the annotation-bearing recursive +Π candidate. -/ +def annotatedPiGenerationCandidatePackage : + VInductDecl.GenerationCandidatePackage outParamEnv [] := + annotatedPiGenerationCandidateSemanticRun.package + +/-- The complete AnnotatedPi semantic package is selected by the exact +successful whole-call metadata producer, including its nested annotation- +consuming traversal in the post-family environment. -/ +def annotatedPiProducedGenerationCandidatePackage : + VInductDecl.ProducedGenerationCandidatePackage outParamEnv [] := + annotatedPiProducedGenerationShapeCandidate.producedPackage + annotatedPiNormalizationCandidateSemanticRun rfl + annotatedPiGenerationChecked rfl annotatedPiCandidate_viewDecl_wf + +/-- Theory-only erasure consumed by the public certified transaction. -/ +def annotatedPiGenerationCertificate : + annotatedPiRawDecl.GenerationCertificate outParamEnv := + annotatedPiProducedGenerationCandidatePackage.package.certificate + +def annotatedPiGenerationRun : + VInductDecl.GenerationRun annotatedPiGenerationChecked outParamEnv := + annotatedPiProducedGenerationCandidatePackage.package.run.generationRun + +theorem annotatedPiGenerationChecked_wf_checked : + annotatedPiGenerationChecked.WF outParamEnv := + annotatedPiGenerationCertificate.wf + +def annotatedPiCtorEnv : VEnv := + (annotatedPiTypeEnv.addConst annotatedPiRawType.ctors[0].name + annotatedPiRawType.ctors[0].toVConstant).get! + +def annotatedPiRecEnv : VEnv := + (annotatedPiCtorEnv.addConst ``AnnotatedPi.rec + annotatedPiGenerationChecked.recursor).get! + +def annotatedPiFinalEnv : VEnv := + (outParamEnv.addInductGeneration + annotatedPiGenerationChecked).get (by decide) + +theorem annotatedPi_addInductGeneration : + outParamEnv.addInductGeneration annotatedPiGenerationChecked = + some annotatedPiFinalEnv := rfl + +/-- The public proof-carrying path accepts the non-identity AnnotatedPi view +while computing exactly the established mixed Theory transaction. -/ +theorem annotatedPi_addInductCertified : + outParamEnv.addInductCertified annotatedPiGenerationCertificate = + some annotatedPiFinalEnv := + annotatedPi_addInductGeneration + +theorem annotatedPiCertified_ordered : annotatedPiFinalEnv.Ordered := + VEnv.addInductCertified_WF outParamEnv_ordered + annotatedPi_addInductCertified + +private theorem annotatedPiRawCtor_wf : + annotatedPiRawType.ctors[0].toVConstant.WF + annotatedPiTypeEnv := + ⟨.succ .zero, annotatedPiRawCtor_hasType⟩ + +private theorem annotatedPiCtorEnv_ordered : + annotatedPiCtorEnv.Ordered := + .const (n := annotatedPiRawType.ctors[0].name) + (ci := annotatedPiRawType.ctors[0].toVConstant) + annotatedPiTypeEnv_ordered annotatedPiRawCtor_wf rfl + +private theorem annotatedPiGenerationEnv : + VInductDecl.GenerationEnv annotatedPiGenerationChecked + annotatedPiCtorEnv := by + apply annotatedPiGenerationChecked_wf_checked.toGenerationEnv + (envT := annotatedPiTypeEnv) + · rfl + · exact (VEnv.addConst_le (show + outParamEnv.addConst annotatedPiRawType.name + annotatedPiRawType.toVConstant = some annotatedPiTypeEnv from rfl)).trans + (VEnv.addConst_le (show + annotatedPiTypeEnv.addConst annotatedPiRawType.ctors[0].name + annotatedPiRawType.ctors[0].toVConstant = + some annotatedPiCtorEnv from rfl)) + · exact VEnv.addConst_le (show + annotatedPiTypeEnv.addConst annotatedPiRawType.ctors[0].name + annotatedPiRawType.ctors[0].toVConstant = + some annotatedPiCtorEnv from rfl) + · exact annotatedPiCtorEnv_ordered + · rfl + · intro ctor hctor + change ctor ∈ + [⟨annotatedPiRawType.ctors[0], + annotatedPiViewChecked.constructors[0]⟩] at hctor + obtain rfl := List.mem_singleton.1 hctor + rfl + +private theorem annotatedPiMkInfo_tr : + TrConstVal .safe annotatedPiTypeEnv annotatedPiMkInfo + annotatedPiRawType.ctors[0] := by + exact ⟨⟨by decide, rfl, annotatedPiCtorSource_tr⟩, rfl⟩ + +private theorem annotatedPiRecInfo_tr : + TrConstVal .safe annotatedPiCtorEnv annotatedPiRecInfo + (inductGenerationRecVal annotatedPiGenerationChecked) := by + have hfamily : annotatedPiCtorEnv.constants ``AnnotatedPi = + some annotatedPiRawType.toVConstant := rfl + have hmk : annotatedPiCtorEnv.constants ``AnnotatedPi.mk = + some annotatedPiRawType.ctors[0].toVConstant := rfl + refine ⟨⟨by decide, rfl, ?_⟩, rfl⟩ + have hshape : TrTypeExpr annotatedPiCtorEnv + annotatedPiRecInfo.levelParams [] annotatedPiRecInfo.type + (inductGenerationRecVal annotatedPiGenerationChecked).type := by + tr_type_expr_tac + obtain ⟨u, hrec⟩ := annotatedPiGenerationEnv.recursor_wf + exact hshape.to_trExprS annotatedPiCtorEnv_ordered trivial + ⟨.sort u, hrec⟩ + +private def annotatedPiCtorMap : ConstMap := + annotatedPiTypeMap.insert ``AnnotatedPi.mk annotatedPiMkInfo + +private def annotatedPiMap : ConstMap := + annotatedPiCtorMap.insert ``AnnotatedPi.rec annotatedPiRecInfo + +private theorem annotatedPiMk_fresh : + annotatedPiTypeMap.find? ``AnnotatedPi.mk = none := by + rw [annotatedPiTypeMap, outParamMap_wf.find?_insert, + outParamMap, + SMap.WF.find?_insert (s := ({} : ConstMap)) SMap.WF.empty] + simp [SMap.find?] + +private theorem annotatedPiCtorMap_wf : annotatedPiCtorMap.WF := + annotatedPiTypeMap_wf.insert _ _ annotatedPiMk_fresh + +private theorem annotatedPiRec_fresh : + annotatedPiCtorMap.find? ``AnnotatedPi.rec = none := by + rw [annotatedPiCtorMap, annotatedPiTypeMap_wf.find?_insert, + annotatedPiTypeMap, outParamMap_wf.find?_insert, outParamMap, + SMap.WF.find?_insert (s := ({} : ConstMap)) SMap.WF.empty] + simp [SMap.find?] + +/-- Complete kernel-metadata replay transaction for `AnnotatedPi`, driven by +the checker-produced non-identity normalization certificate. -/ +def annotatedPiAddInductTraceChecked : + AddInductTrace outParamMap outParamEnv annotatedPiRawDecl + annotatedPiMap annotatedPiFinalEnv := by + refine annotatedPiProducedGenerationCandidatePackage.package.addInductTrace + annotatedPiTypeMap annotatedPiTypeEnv annotatedPiCtorMap + annotatedPiCtorEnv annotatedPiRecEnv annotatedPiAddType ?_ ?_ ⟨rfl⟩ + · exact .cons { + info := annotatedPiMkInfo + kind_eq := by simp [annotatedPiMkInfo, InductConstantKind.Matches] + tr := annotatedPiMkInfo_tr + map_fresh := by + simpa [annotatedPiRawType] using annotatedPiMk_fresh + env_add := rfl + map_add := rfl } .nil + · exact { + info := annotatedPiRecInfo + kind_eq := by simp [annotatedPiRecInfo, InductConstantKind.Matches] + tr := annotatedPiRecInfo_tr + map_fresh := by + rw [show + (inductGenerationRecVal + annotatedPiProducedGenerationCandidatePackage.package.generation).name = + ``AnnotatedPi.rec by rfl] + exact annotatedPiRec_fresh + env_add := rfl + map_add := rfl } + +theorem annotatedPi_addInduct_checked : + AddInduct outParamMap outParamEnv annotatedPiRawDecl + annotatedPiMap annotatedPiFinalEnv := + ⟨annotatedPiAddInductTraceChecked⟩ + +theorem annotatedPi_trEnv'_checked : + TrEnv' .safe annotatedPiMap false annotatedPiFinalEnv := + .induct annotatedPi_addInduct_checked outParam_trEnv' + +theorem annotatedPi_env_wf_checked : annotatedPiFinalEnv.WF := + annotatedPi_trEnv'_checked.wf + +theorem annotatedPi_aligned_checked : + Aligned .safe annotatedPiMap annotatedPiFinalEnv := + annotatedPi_trEnv'_checked.aligned + +theorem annotatedPiFinalEnv_trace : + Nonempty (VEnv.AddInductGenerationTrace outParamEnv + annotatedPiFinalEnv annotatedPiGenerationChecked) := + VEnv.addInductGeneration_trace annotatedPi_addInductGeneration + +/-- The public certified wrapper exposes the same trace. This deliberately +stays separate from the minimal Theory-only iota root below: the concrete +certificate remembers its Verify provenance, while the transaction equality +itself admits the smaller Theory proof. -/ +theorem annotatedPiCertified_trace : + Nonempty (VEnv.AddInductGenerationTrace outParamEnv + annotatedPiFinalEnv annotatedPiGenerationChecked) := + VEnv.addInductCertified_trace annotatedPi_addInductCertified + +theorem annotatedPiFinalEnv_family_lookup : + annotatedPiFinalEnv.constants ``AnnotatedPi = + some annotatedPiRawType.toVConstant := by + rcases annotatedPiFinalEnv_trace with ⟨trace⟩ + exact trace.family_lookup + +theorem annotatedPiFinalEnv_ctor_lookup : + annotatedPiFinalEnv.constants ``AnnotatedPi.mk = + some annotatedPiRawType.ctors[0].toVConstant := by + rcases annotatedPiFinalEnv_trace with ⟨trace⟩ + exact trace.ctor_lookup (.head _) + +theorem annotatedPiFinalEnv_rec_lookup : + annotatedPiFinalEnv.constants ``AnnotatedPi.rec = + some annotatedPiGenerationChecked.recursor := by + rcases annotatedPiFinalEnv_trace with ⟨trace⟩ + exact trace.rec_lookup + +theorem annotatedPiFinalEnv_rule_mem : + ∀ df ∈ annotatedPiGenerationChecked.generatedRules, + annotatedPiFinalEnv.defeqs df := by + intro df hdf + rcases annotatedPiFinalEnv_trace with ⟨trace⟩ + exact trace.rule_mem hdf + +theorem annotatedPiFinalEnv_iota_mem : + annotatedPiFinalEnv.defeqs + annotatedPiGenerationChecked.generatedRules[0] := by + apply annotatedPiFinalEnv_rule_mem + exact .head _ + +theorem annotatedPi_iota_rhs_matches_kernel : + annotatedPiKernelRuleRhs = + annotatedPiGenerationChecked.generatedRules[0].rhs := rfl + +theorem annotatedPi_type_map_lookup : + annotatedPiMap.find? ``AnnotatedPi = some annotatedPiInfo := by + rw [annotatedPiMap, annotatedPiCtorMap_wf.find?_insert, + annotatedPiCtorMap, annotatedPiTypeMap_wf.find?_insert] + simp +decide + rw [annotatedPiTypeMap, outParamMap_wf.find?_insert] + simp +decide + +theorem annotatedPi_mk_map_lookup : + annotatedPiMap.find? ``AnnotatedPi.mk = some annotatedPiMkInfo := by + rw [annotatedPiMap, annotatedPiCtorMap_wf.find?_insert, + annotatedPiCtorMap, annotatedPiTypeMap_wf.find?_insert] + rfl + +theorem annotatedPi_rec_map_lookup : + annotatedPiMap.find? ``AnnotatedPi.rec = some annotatedPiRecInfo := by + rw [annotatedPiMap, annotatedPiCtorMap_wf.find?_insert] + rfl + +theorem annotatedPi_type_lookup_unique : + annotatedPiInfo.name = ``AnnotatedPi ∧ + TrConstant .safe annotatedPiFinalEnv annotatedPiInfo + annotatedPiRawType.toVConstant := + annotatedPi_aligned_checked.find?_uniq annotatedPi_type_map_lookup + annotatedPiFinalEnv_family_lookup + +theorem annotatedPi_mk_lookup_unique : + annotatedPiMkInfo.name = ``AnnotatedPi.mk ∧ + TrConstant .safe annotatedPiFinalEnv annotatedPiMkInfo + annotatedPiRawType.ctors[0].toVConstant := + annotatedPi_aligned_checked.find?_uniq annotatedPi_mk_map_lookup + annotatedPiFinalEnv_ctor_lookup + +theorem annotatedPi_rec_lookup_unique : + annotatedPiRecInfo.name = ``AnnotatedPi.rec ∧ + TrConstant .safe annotatedPiFinalEnv annotatedPiRecInfo + annotatedPiGenerationChecked.recursor := + annotatedPi_aligned_checked.find?_uniq annotatedPi_rec_map_lookup + annotatedPiFinalEnv_rec_lookup + +/-- The complete AliasFormer metadata trace with the generation-WF field +supplied by the checker-produced certificate. All computational metadata +witnesses are shared with the existing replay. -/ +def aliasFormerAddInductTraceChecked : + AddInductTrace typeFamilyAliasMap typeFamilyAliasEnv + aliasFormerRawDecl aliasFormerMap aliasFormerFinalEnv := + let replay := + aliasFormerAddInductTraceWith aliasFormerGenerationCertificate.wf + aliasFormerProducedGenerationCandidatePackage.package.addInductTrace + replay.typeMap replay.typeEnv replay.ctorMap replay.ctorEnv replay.recEnv + replay.addType replay.addCtors replay.addRec replay.addRules + +theorem aliasFormer_addInduct_checked : + AddInduct typeFamilyAliasMap typeFamilyAliasEnv + aliasFormerRawDecl aliasFormerMap aliasFormerFinalEnv := + ⟨aliasFormerAddInductTraceChecked⟩ + +theorem aliasFormer_trEnv'_checked : + TrEnv' .safe aliasFormerMap false aliasFormerFinalEnv := + .induct aliasFormer_addInduct_checked typeFamilyAlias_trEnv' + +theorem aliasFormer_env_wf_checked : aliasFormerFinalEnv.WF := + aliasFormer_trEnv'_checked.wf + +theorem aliasFormer_aligned_checked : + Aligned .safe aliasFormerMap aliasFormerFinalEnv := + aliasFormer_trEnv'_checked.aligned + +/-- The complete AliasRec metadata trace with the generation-WF field supplied +by the checker-produced normalization certificate. -/ +def aliasRecAddInductTraceChecked : + AddInductTrace recAliasMap recAliasEnv aliasRecRawDecl + aliasRecMap aliasRecFinalEnv := + aliasRecAddInductTraceWith aliasRecGenerationChecked_wf_checked + +theorem aliasRec_addInduct_checked : + AddInduct recAliasMap recAliasEnv aliasRecRawDecl + aliasRecMap aliasRecFinalEnv := + ⟨aliasRecAddInductTraceChecked⟩ + +theorem aliasRec_trEnv'_checked : + TrEnv' .safe aliasRecMap false aliasRecFinalEnv := + .induct aliasRec_addInduct_checked recAlias_trEnv' + +theorem aliasRec_env_wf_checked : aliasRecFinalEnv.WF := + aliasRec_trEnv'_checked.wf + +theorem aliasRec_aligned_checked : + Aligned .safe aliasRecMap aliasRecFinalEnv := + aliasRec_trEnv'_checked.aligned + +/- The operational traces do not reach the pointer-equality contracts. Their +semantic endpoints intentionally inherit Verify's existing checker-refinement +and reflection contracts, including pointer equality, plus the separately +tracked `TrProj` frontier. No new axiom or native-evaluation principle is +used. -/ +/-- +info: 'Lean4Lean.InductiveReplayFixtures.aliasFormerFamily_candidateTrace' depends on axioms: [propext, + sorryAx, + Classical.choice, + Quot.sound, + Expr.eqv_eq, + Expr.looseBVarRange_eq, + Level.instLawfulBEqLevel, + PersistentHashMap.findAux_isSome, + Syntax.structEq_eq, + PersistentHashMap.WF.find?_eq, + PersistentHashMap.WF.toList'_insert] +-/ +#guard_msgs in +#print axioms aliasFormerFamily_candidateTrace + +/-- +info: 'Lean4Lean.InductiveReplayFixtures.aliasFormerCtor_candidateTrace' depends on axioms: [propext, + sorryAx, + Classical.choice, + Quot.sound, + Expr.eqv_eq, + Expr.looseBVarRange_eq, + Level.instLawfulBEqLevel, + PersistentHashMap.findAux_isSome, + Syntax.structEq_eq, + PersistentHashMap.WF.find?_eq, + PersistentHashMap.WF.toList'_insert] +-/ +#guard_msgs in +#print axioms aliasFormerCtor_candidateTrace + +/-- +info: 'Lean4Lean.InductiveReplayFixtures.aliasFormerFamily_candidate' depends on axioms: [propext, + sorryAx, + Classical.choice, + Quot.sound, + Expr.eqv_eq, + Expr.looseBVarRange_eq, + Level.instLawfulBEqLevel, + PersistentHashMap.findAux_isSome, + Syntax.structEq_eq, + PersistentHashMap.WF.find?_eq, + PersistentHashMap.WF.toList'_insert] +-/ +#guard_msgs in +#print axioms aliasFormerFamily_candidate + +/-- +info: 'Lean4Lean.InductiveReplayFixtures.aliasFormerFamily_candidateRun_exists' depends on axioms: [propext, + sorryAx, + Classical.choice, + ptrEqConstantInfo_eq, + ptrEqExpr_eq, + Quot.sound, + Expr.abstractRange_eq, + Expr.abstract_eq, + Expr.eqv_eq, + Expr.hasLooseBVar_eq, + Expr.instantiate1_eq, + Expr.instantiateRange_eq, + Expr.instantiateRevRange_eq, + Expr.instantiateRev_eq, + Expr.instantiate_eq, + Expr.looseBVarRange_eq, + Expr.lowerLooseBVars_eq, + Expr.mkAppData_eq, + Expr.mkData_eq, + Expr.replace_eq, + Level.hasMVar_eq, + Level.hasParam_eq, + Level.instLawfulBEqLevel, + PersistentArray.toList'_push, + PersistentHashMap.findAux_isSome, + Syntax.structEq_eq, + PersistentHashMap.WF.find?_eq, + PersistentHashMap.WF.toList'_insert] +-/ +#guard_msgs in +#print axioms aliasFormerFamily_candidateRun_exists + +/-- +info: 'Lean4Lean.InductiveReplayFixtures.aliasFormerFamily_candidateSource_tr' depends on axioms: [propext, + sorryAx, + Classical.choice, + Quot.sound, + Expr.eqv_eq, + Expr.looseBVarRange_eq, + Level.instLawfulBEqLevel, + PersistentHashMap.findAux_isSome, + Syntax.structEq_eq, + PersistentHashMap.WF.find?_eq, + PersistentHashMap.WF.toList'_insert] +-/ +#guard_msgs in +#print axioms aliasFormerFamily_candidateSource_tr + +/-- +info: 'Lean4Lean.InductiveReplayFixtures.aliasFormerFamily_candidateView_tr' depends on axioms: [propext, + sorryAx, + Classical.choice, + ptrEqConstantInfo_eq, + ptrEqExpr_eq, + Quot.sound, + Expr.abstractRange_eq, + Expr.abstract_eq, + Expr.eqv_eq, + Expr.hasLooseBVar_eq, + Expr.instantiate1_eq, + Expr.instantiateRange_eq, + Expr.instantiateRevRange_eq, + Expr.instantiateRev_eq, + Expr.instantiate_eq, + Expr.looseBVarRange_eq, + Expr.lowerLooseBVars_eq, + Expr.mkAppData_eq, + Expr.mkData_eq, + Expr.replace_eq, + Level.hasMVar_eq, + Level.hasParam_eq, + Level.instLawfulBEqLevel, + PersistentArray.toList'_push, + PersistentHashMap.findAux_isSome, + Syntax.structEq_eq, + PersistentHashMap.WF.find?_eq, + PersistentHashMap.WF.toList'_insert] +-/ +#guard_msgs in +#print axioms aliasFormerFamily_candidateView_tr + +/-- +info: 'Lean4Lean.InductiveReplayFixtures.aliasFormerNormalizationCandidateRun' depends on axioms: [propext, + sorryAx, + Classical.choice, + ptrEqConstantInfo_eq, + ptrEqExpr_eq, + Quot.sound, + Expr.abstractRange_eq, + Expr.abstract_eq, + Expr.eqv_eq, + Expr.hasLooseBVar_eq, + Expr.instantiate1_eq, + Expr.instantiateRange_eq, + Expr.instantiateRevRange_eq, + Expr.instantiateRev_eq, + Expr.instantiate_eq, + Expr.looseBVarRange_eq, + Expr.lowerLooseBVars_eq, + Expr.mkAppData_eq, + Expr.mkData_eq, + Expr.replace_eq, + Level.hasMVar_eq, + Level.hasParam_eq, + Level.instLawfulBEqLevel, + PersistentArray.toList'_push, + PersistentHashMap.findAux_isSome, + Syntax.structEq_eq, + PersistentHashMap.WF.find?_eq, + PersistentHashMap.WF.toList'_insert] +-/ +#guard_msgs in +#print axioms aliasFormerNormalizationCandidateRun + +/-- +info: 'Lean4Lean.InductiveReplayFixtures.aliasFormerCandidateNormalization_eq' depends on axioms: [propext, + sorryAx, + Classical.choice, + ptrEqConstantInfo_eq, + ptrEqExpr_eq, + Quot.sound, + Expr.abstractRange_eq, + Expr.abstract_eq, + Expr.eqv_eq, + Expr.hasLooseBVar_eq, + Expr.instantiate1_eq, + Expr.instantiateRange_eq, + Expr.instantiateRevRange_eq, + Expr.instantiateRev_eq, + Expr.instantiate_eq, + Expr.looseBVarRange_eq, + Expr.lowerLooseBVars_eq, + Expr.mkAppData_eq, + Expr.mkData_eq, + Expr.replace_eq, + Level.hasMVar_eq, + Level.hasParam_eq, + Level.instLawfulBEqLevel, + PersistentArray.toList'_push, + PersistentHashMap.findAux_isSome, + Syntax.structEq_eq, + PersistentHashMap.WF.find?_eq, + PersistentHashMap.WF.toList'_insert] +-/ +#guard_msgs in +#print axioms aliasFormerCandidateNormalization_eq + +/-- +info: 'Lean4Lean.InductiveReplayFixtures.aliasFormerTruncatedView_rejected' depends on axioms: [propext] +-/ +#guard_msgs in +#print axioms aliasFormerTruncatedView_rejected + +/-- +info: 'Lean4Lean.InductiveReplayFixtures.aliasRecField_checkType' depends on axioms: [propext, + sorryAx, + Classical.choice, + Quot.sound, + Expr.eqv_eq, + Expr.instantiate1_eq, + Expr.looseBVarRange_eq, + Expr.mkAppData_eq, + Expr.mkData_eq, + Expr.replace_eq, + Level.hasParam_eq, + Level.instLawfulBEqLevel, + PersistentHashMap.findAux_isSome, + Syntax.structEq_eq, + PersistentHashMap.WF.find?_eq, + PersistentHashMap.WF.toList'_insert] +-/ +#guard_msgs in +#print axioms aliasRecField_checkType + +/-- +info: 'Lean4Lean.InductiveReplayFixtures.aliasRecField_hasType_checked' depends on axioms: [propext, + sorryAx, + Classical.choice, + ptrEqConstantInfo_eq, + ptrEqExpr_eq, + Quot.sound, + Expr.abstractRange_eq, + Expr.abstract_eq, + Expr.eqv_eq, + Expr.hasLooseBVar_eq, + Expr.instantiate1_eq, + Expr.instantiateRange_eq, + Expr.instantiateRevRange_eq, + Expr.instantiateRev_eq, + Expr.instantiate_eq, + Expr.looseBVarRange_eq, + Expr.lowerLooseBVars_eq, + Expr.mkAppData_eq, + Expr.mkData_eq, + Expr.replace_eq, + Level.hasMVar_eq, + Level.hasParam_eq, + Level.instLawfulBEqLevel, + PersistentArray.toList'_push, + PersistentHashMap.findAux_isSome, + Syntax.structEq_eq, + PersistentHashMap.WF.find?_eq, + PersistentHashMap.WF.toList'_insert] +-/ +#guard_msgs in +#print axioms aliasRecField_hasType_checked + +/-- +info: 'Lean4Lean.InductiveReplayFixtures.aliasFormerFamily_whnf' depends on axioms: [propext, + sorryAx, + Classical.choice, + Quot.sound, + Expr.eqv_eq, + Level.instLawfulBEqLevel, + PersistentHashMap.findAux_isSome, + Syntax.structEq_eq, + PersistentHashMap.WF.find?_eq, + PersistentHashMap.WF.toList'_insert] +-/ +#guard_msgs in +#print axioms aliasFormerFamily_whnf + +/-- +info: 'Lean4Lean.InductiveReplayFixtures.aliasFormerCtor_whnf' depends on axioms: [propext, + sorryAx, + Classical.choice, + Quot.sound, + Expr.eqv_eq, + Level.instLawfulBEqLevel, + PersistentHashMap.findAux_isSome, + Syntax.structEq_eq, + PersistentHashMap.WF.find?_eq, + PersistentHashMap.WF.toList'_insert] +-/ +#guard_msgs in +#print axioms aliasFormerCtor_whnf -/-- The complete AliasFormer metadata trace with the generation-WF field -supplied by the checker-produced certificate. All computational metadata -witnesses are shared with the existing replay. -/ -def aliasFormerAddInductTraceChecked : - AddInductTrace typeFamilyAliasMap typeFamilyAliasEnv - aliasFormerRawDecl aliasFormerMap aliasFormerFinalEnv := - aliasFormerAddInductTraceWith aliasFormerGenerationChecked_wf_checked +/-- +info: 'Lean4Lean.InductiveReplayFixtures.recAlias_whnf' depends on axioms: [propext, + sorryAx, + Classical.choice, + Quot.sound, + Expr.eqv_eq, + Expr.mkAppData_eq, + Expr.mkData_eq, + Expr.replace_eq, + Level.hasParam_eq, + Level.instLawfulBEqLevel, + PersistentHashMap.findAux_isSome, + Syntax.structEq_eq, + PersistentHashMap.WF.find?_eq, + PersistentHashMap.WF.toList'_insert] +-/ +#guard_msgs in +#print axioms recAlias_whnf -theorem aliasFormer_addInduct_checked : - AddInduct typeFamilyAliasMap typeFamilyAliasEnv - aliasFormerRawDecl aliasFormerMap aliasFormerFinalEnv := - ⟨aliasFormerAddInductTraceChecked⟩ +/-- +info: 'Lean4Lean.InductiveReplayFixtures.aliasFormerFamily_checkType' depends on axioms: [propext, + sorryAx, + Classical.choice, + Quot.sound, + Expr.eqv_eq, + Expr.looseBVarRange_eq, + Level.instLawfulBEqLevel, + PersistentHashMap.findAux_isSome, + Syntax.structEq_eq, + PersistentHashMap.WF.find?_eq, + PersistentHashMap.WF.toList'_insert] +-/ +#guard_msgs in +#print axioms aliasFormerFamily_checkType + +/-- +info: 'Lean4Lean.InductiveReplayFixtures.aliasFormerCtor_checkType' depends on axioms: [propext, + sorryAx, + Classical.choice, + Quot.sound, + Expr.eqv_eq, + Expr.looseBVarRange_eq, + Level.instLawfulBEqLevel, + PersistentHashMap.findAux_isSome, + Syntax.structEq_eq, + PersistentHashMap.WF.find?_eq, + PersistentHashMap.WF.toList'_insert] +-/ +#guard_msgs in +#print axioms aliasFormerCtor_checkType + +/-- +info: 'Lean4Lean.InductiveReplayFixtures.aliasFormerFamily_isType_checked' depends on axioms: [propext, + sorryAx, + Classical.choice, + ptrEqConstantInfo_eq, + ptrEqExpr_eq, + Quot.sound, + Expr.abstractRange_eq, + Expr.abstract_eq, + Expr.eqv_eq, + Expr.hasLooseBVar_eq, + Expr.instantiate1_eq, + Expr.instantiateRange_eq, + Expr.instantiateRevRange_eq, + Expr.instantiateRev_eq, + Expr.instantiate_eq, + Expr.looseBVarRange_eq, + Expr.lowerLooseBVars_eq, + Expr.mkAppData_eq, + Expr.mkData_eq, + Expr.replace_eq, + Level.hasMVar_eq, + Level.hasParam_eq, + Level.instLawfulBEqLevel, + PersistentArray.toList'_push, + PersistentHashMap.findAux_isSome, + Syntax.structEq_eq, + PersistentHashMap.WF.find?_eq, + PersistentHashMap.WF.toList'_insert] +-/ +#guard_msgs in +#print axioms aliasFormerFamily_isType_checked + +/-- +info: 'Lean4Lean.InductiveReplayFixtures.aliasFormerCtor_isType_checked' depends on axioms: [propext, + sorryAx, + Classical.choice, + ptrEqConstantInfo_eq, + ptrEqExpr_eq, + Quot.sound, + Expr.abstractRange_eq, + Expr.abstract_eq, + Expr.eqv_eq, + Expr.hasLooseBVar_eq, + Expr.instantiate1_eq, + Expr.instantiateRange_eq, + Expr.instantiateRevRange_eq, + Expr.instantiateRev_eq, + Expr.instantiate_eq, + Expr.looseBVarRange_eq, + Expr.lowerLooseBVars_eq, + Expr.mkAppData_eq, + Expr.mkData_eq, + Expr.replace_eq, + Level.hasMVar_eq, + Level.hasParam_eq, + Level.instLawfulBEqLevel, + PersistentArray.toList'_push, + PersistentHashMap.findAux_isSome, + Syntax.structEq_eq, + PersistentHashMap.WF.find?_eq, + PersistentHashMap.WF.toList'_insert] +-/ +#guard_msgs in +#print axioms aliasFormerCtor_isType_checked + +/-- +info: 'Lean4Lean.InductiveReplayFixtures.aliasFormerNormalization_wf_checked' depends on axioms: [propext, + sorryAx, + Classical.choice, + ptrEqConstantInfo_eq, + ptrEqExpr_eq, + Quot.sound, + Expr.abstractRange_eq, + Expr.abstract_eq, + Expr.eqv_eq, + Expr.hasLooseBVar_eq, + Expr.instantiate1_eq, + Expr.instantiateRange_eq, + Expr.instantiateRevRange_eq, + Expr.instantiateRev_eq, + Expr.instantiate_eq, + Expr.looseBVarRange_eq, + Expr.lowerLooseBVars_eq, + Expr.mkAppData_eq, + Expr.mkData_eq, + Expr.replace_eq, + Level.hasMVar_eq, + Level.hasParam_eq, + Level.instLawfulBEqLevel, + PersistentArray.toList'_push, + PersistentHashMap.findAux_isSome, + Syntax.structEq_eq, + PersistentHashMap.WF.find?_eq, + PersistentHashMap.WF.toList'_insert] +-/ +#guard_msgs in +#print axioms aliasFormerNormalization_wf_checked + +/-- +info: 'Lean4Lean.InductiveReplayFixtures.aliasRecNormalization_wf_checked' depends on axioms: [propext, + sorryAx, + Classical.choice, + ptrEqConstantInfo_eq, + ptrEqExpr_eq, + Quot.sound, + Expr.abstractRange_eq, + Expr.abstract_eq, + Expr.eqv_eq, + Expr.hasLooseBVar_eq, + Expr.instantiate1_eq, + Expr.instantiateRange_eq, + Expr.instantiateRevRange_eq, + Expr.instantiateRev_eq, + Expr.instantiate_eq, + Expr.looseBVarRange_eq, + Expr.lowerLooseBVars_eq, + Expr.mkAppData_eq, + Expr.mkData_eq, + Expr.replace_eq, + Level.hasMVar_eq, + Level.hasParam_eq, + Level.instLawfulBEqLevel, + PersistentArray.toList'_push, + PersistentHashMap.findAux_isSome, + Syntax.structEq_eq, + PersistentHashMap.WF.find?_eq, + PersistentHashMap.WF.toList'_insert] +-/ +#guard_msgs in +#print axioms aliasRecNormalization_wf_checked + +/-- +info: 'Lean4Lean.InductiveReplayFixtures.aliasFormerBlock_wf_checked' depends on axioms: [propext, + sorryAx, + Classical.choice, + ptrEqConstantInfo_eq, + ptrEqExpr_eq, + Quot.sound, + Expr.abstractRange_eq, + Expr.abstract_eq, + Expr.eqv_eq, + Expr.hasLooseBVar_eq, + Expr.instantiate1_eq, + Expr.instantiateRange_eq, + Expr.instantiateRevRange_eq, + Expr.instantiateRev_eq, + Expr.instantiate_eq, + Expr.looseBVarRange_eq, + Expr.lowerLooseBVars_eq, + Expr.mkAppData_eq, + Expr.mkData_eq, + Expr.replace_eq, + Level.hasMVar_eq, + Level.hasParam_eq, + Level.instLawfulBEqLevel, + PersistentArray.toList'_push, + PersistentHashMap.findAux_isSome, + Syntax.structEq_eq, + PersistentHashMap.WF.find?_eq, + PersistentHashMap.WF.toList'_insert] +-/ +#guard_msgs in +#print axioms aliasFormerBlock_wf_checked + +/-- +info: 'Lean4Lean.InductiveReplayFixtures.aliasFormerProducedSemanticHierarchy_exists' depends on axioms: [propext, + sorryAx, + Classical.choice, + ptrEqConstantInfo_eq, + ptrEqExpr_eq, + Quot.sound, + Expr.abstractRange_eq, + Expr.abstract_eq, + Expr.eqv_eq, + Expr.hasLooseBVar_eq, + Expr.instantiate1_eq, + Expr.instantiateRange_eq, + Expr.instantiateRevRange_eq, + Expr.instantiateRev_eq, + Expr.instantiate_eq, + Expr.looseBVarRange_eq, + Expr.lowerLooseBVars_eq, + Expr.mkAppData_eq, + Expr.mkData_eq, + Expr.replace_eq, + Level.hasMVar_eq, + Level.hasParam_eq, + Level.instLawfulBEqLevel, + PersistentArray.toList'_push, + PersistentHashMap.findAux_isSome, + Syntax.structEq_eq, + PersistentHashMap.WF.find?_eq, + PersistentHashMap.WF.toList'_insert] +-/ +#guard_msgs in +#print axioms aliasFormerProducedSemanticHierarchy_exists -theorem aliasFormer_trEnv'_checked : - TrEnv' .safe aliasFormerMap false aliasFormerFinalEnv := - .induct aliasFormer_addInduct_checked typeFamilyAlias_trEnv' +/-- +info: 'Lean4Lean.InductiveReplayFixtures.aliasFormerGenerationCandidateSemanticRun' depends on axioms: [propext, + sorryAx, + Classical.choice, + ptrEqConstantInfo_eq, + ptrEqExpr_eq, + Quot.sound, + Expr.abstractRange_eq, + Expr.abstract_eq, + Expr.eqv_eq, + Expr.hasLooseBVar_eq, + Expr.instantiate1_eq, + Expr.instantiateRange_eq, + Expr.instantiateRevRange_eq, + Expr.instantiateRev_eq, + Expr.instantiate_eq, + Expr.looseBVarRange_eq, + Expr.lowerLooseBVars_eq, + Expr.mkAppData_eq, + Expr.mkData_eq, + Expr.replace_eq, + Level.hasMVar_eq, + Level.hasParam_eq, + Level.instLawfulBEqLevel, + PersistentArray.toList'_push, + PersistentHashMap.findAux_isSome, + Syntax.structEq_eq, + PersistentHashMap.WF.find?_eq, + PersistentHashMap.WF.toList'_insert] +-/ +#guard_msgs in +#print axioms aliasFormerGenerationCandidateSemanticRun -theorem aliasFormer_env_wf_checked : aliasFormerFinalEnv.WF := - aliasFormer_trEnv'_checked.wf +/-- +info: 'Lean4Lean.InductiveReplayFixtures.aliasFormerGenerationCandidateRun' depends on axioms: [propext, + sorryAx, + Classical.choice, + ptrEqConstantInfo_eq, + ptrEqExpr_eq, + Quot.sound, + Expr.abstractRange_eq, + Expr.abstract_eq, + Expr.eqv_eq, + Expr.hasLooseBVar_eq, + Expr.instantiate1_eq, + Expr.instantiateRange_eq, + Expr.instantiateRevRange_eq, + Expr.instantiateRev_eq, + Expr.instantiate_eq, + Expr.looseBVarRange_eq, + Expr.lowerLooseBVars_eq, + Expr.mkAppData_eq, + Expr.mkData_eq, + Expr.replace_eq, + Level.hasMVar_eq, + Level.hasParam_eq, + Level.instLawfulBEqLevel, + PersistentArray.toList'_push, + PersistentHashMap.findAux_isSome, + Syntax.structEq_eq, + PersistentHashMap.WF.find?_eq, + PersistentHashMap.WF.toList'_insert] +-/ +#guard_msgs in +#print axioms aliasFormerGenerationCandidateRun -theorem aliasFormer_aligned_checked : - Aligned .safe aliasFormerMap aliasFormerFinalEnv := - aliasFormer_trEnv'_checked.aligned +/-- +info: 'Lean4Lean.InductiveReplayFixtures.aliasFormerGenerationCandidatePackage' depends on axioms: [propext, + sorryAx, + Classical.choice, + ptrEqConstantInfo_eq, + ptrEqExpr_eq, + Quot.sound, + Expr.abstractRange_eq, + Expr.abstract_eq, + Expr.eqv_eq, + Expr.hasLooseBVar_eq, + Expr.instantiate1_eq, + Expr.instantiateRange_eq, + Expr.instantiateRevRange_eq, + Expr.instantiateRev_eq, + Expr.instantiate_eq, + Expr.looseBVarRange_eq, + Expr.lowerLooseBVars_eq, + Expr.mkAppData_eq, + Expr.mkData_eq, + Expr.replace_eq, + Level.hasMVar_eq, + Level.hasParam_eq, + Level.instLawfulBEqLevel, + PersistentArray.toList'_push, + PersistentHashMap.findAux_isSome, + Syntax.structEq_eq, + PersistentHashMap.WF.find?_eq, + PersistentHashMap.WF.toList'_insert] +-/ +#guard_msgs in +#print axioms aliasFormerGenerationCandidatePackage -/-- The complete AliasRec metadata trace with the generation-WF field supplied -by the checker-produced normalization certificate. -/ -def aliasRecAddInductTraceChecked : - AddInductTrace recAliasMap recAliasEnv aliasRecRawDecl - aliasRecMap aliasRecFinalEnv := - aliasRecAddInductTraceWith aliasRecGenerationChecked_wf_checked +/-- +info: 'Lean4Lean.InductiveReplayFixtures.aliasFormerNormalizationCandidate_produced' depends on axioms: [propext, + sorryAx, + Classical.choice, + Quot.sound, + Expr.eqv_eq, + Expr.looseBVarRange_eq, + Expr.mkAppData_eq, + Expr.mkData_eq, + Level.instLawfulBEqLevel, + PersistentHashMap.findAux_isSome, + Syntax.structEq_eq, + PersistentHashMap.WF.find?_eq, + PersistentHashMap.WF.toList'_insert] +-/ +#guard_msgs in +#print axioms aliasFormerNormalizationCandidate_produced -theorem aliasRec_addInduct_checked : - AddInduct recAliasMap recAliasEnv aliasRecRawDecl - aliasRecMap aliasRecFinalEnv := - ⟨aliasRecAddInductTraceChecked⟩ +/-- +info: 'Lean4Lean.InductiveReplayFixtures.aliasFormerGenerationShapeCandidate_produced' depends on axioms: [propext, + sorryAx, + Classical.choice, + ptrEqConstantInfo_eq, + ptrEqExpr_eq, + Quot.sound, + Expr.abstractRange_eq, + Expr.abstract_eq, + Expr.eqv_eq, + Expr.hasLooseBVar_eq, + Expr.instantiate1_eq, + Expr.instantiateRange_eq, + Expr.instantiateRevRange_eq, + Expr.instantiateRev_eq, + Expr.instantiate_eq, + Expr.looseBVarRange_eq, + Expr.lowerLooseBVars_eq, + Expr.mkAppData_eq, + Expr.mkData_eq, + Expr.replace_eq, + Level.hasMVar_eq, + Level.hasParam_eq, + Level.instLawfulBEqLevel, + PersistentArray.toList'_push, + PersistentHashMap.findAux_isSome, + Syntax.structEq_eq, + PersistentHashMap.WF.find?_eq, + PersistentHashMap.WF.toList'_insert] +-/ +#guard_msgs in +#print axioms aliasFormerGenerationShapeCandidate_produced -theorem aliasRec_trEnv'_checked : - TrEnv' .safe aliasRecMap false aliasRecFinalEnv := - .induct aliasRec_addInduct_checked recAlias_trEnv' +/-- +info: 'Lean4Lean.InductiveReplayFixtures.aliasFormerProducedGenerationCandidatePackage' depends on axioms: [propext, + sorryAx, + Classical.choice, + ptrEqConstantInfo_eq, + ptrEqExpr_eq, + Quot.sound, + Expr.abstractRange_eq, + Expr.abstract_eq, + Expr.eqv_eq, + Expr.hasLooseBVar_eq, + Expr.instantiate1_eq, + Expr.instantiateRange_eq, + Expr.instantiateRevRange_eq, + Expr.instantiateRev_eq, + Expr.instantiate_eq, + Expr.looseBVarRange_eq, + Expr.lowerLooseBVars_eq, + Expr.mkAppData_eq, + Expr.mkData_eq, + Expr.replace_eq, + Level.hasMVar_eq, + Level.hasParam_eq, + Level.instLawfulBEqLevel, + PersistentArray.toList'_push, + PersistentHashMap.findAux_isSome, + Syntax.structEq_eq, + PersistentHashMap.WF.find?_eq, + PersistentHashMap.WF.toList'_insert] +-/ +#guard_msgs in +#print axioms aliasFormerProducedGenerationCandidatePackage -theorem aliasRec_env_wf_checked : aliasRecFinalEnv.WF := - aliasRec_trEnv'_checked.wf +/-- +info: 'Lean4Lean.InductiveReplayFixtures.aliasFormer_addInductCertified_checked' depends on axioms: [propext, + sorryAx, + Classical.choice, + ptrEqConstantInfo_eq, + ptrEqExpr_eq, + Quot.sound, + Expr.abstractRange_eq, + Expr.abstract_eq, + Expr.eqv_eq, + Expr.hasLooseBVar_eq, + Expr.instantiate1_eq, + Expr.instantiateRange_eq, + Expr.instantiateRevRange_eq, + Expr.instantiateRev_eq, + Expr.instantiate_eq, + Expr.looseBVarRange_eq, + Expr.lowerLooseBVars_eq, + Expr.mkAppData_eq, + Expr.mkData_eq, + Expr.replace_eq, + Level.hasMVar_eq, + Level.hasParam_eq, + Level.instLawfulBEqLevel, + PersistentArray.toList'_push, + PersistentHashMap.findAux_isSome, + Syntax.structEq_eq, + PersistentHashMap.WF.find?_eq, + PersistentHashMap.WF.toList'_insert] +-/ +#guard_msgs in +#print axioms aliasFormer_addInductCertified_checked -theorem aliasRec_aligned_checked : - Aligned .safe aliasRecMap aliasRecFinalEnv := - aliasRec_trEnv'_checked.aligned +/-- +info: 'Lean4Lean.InductiveReplayFixtures.aliasFormerGenerationChecked_wf_checked' depends on axioms: [propext, + sorryAx, + Classical.choice, + ptrEqConstantInfo_eq, + ptrEqExpr_eq, + Quot.sound, + Expr.abstractRange_eq, + Expr.abstract_eq, + Expr.eqv_eq, + Expr.hasLooseBVar_eq, + Expr.instantiate1_eq, + Expr.instantiateRange_eq, + Expr.instantiateRevRange_eq, + Expr.instantiateRev_eq, + Expr.instantiate_eq, + Expr.looseBVarRange_eq, + Expr.lowerLooseBVars_eq, + Expr.mkAppData_eq, + Expr.mkData_eq, + Expr.replace_eq, + Level.hasMVar_eq, + Level.hasParam_eq, + Level.instLawfulBEqLevel, + PersistentArray.toList'_push, + PersistentHashMap.findAux_isSome, + Syntax.structEq_eq, + PersistentHashMap.WF.find?_eq, + PersistentHashMap.WF.toList'_insert] +-/ +#guard_msgs in +#print axioms aliasFormerGenerationChecked_wf_checked -/- The operational traces do not reach the pointer-equality contracts. Their -semantic endpoints intentionally inherit Verify's existing checker-refinement -and reflection contracts, including pointer equality, plus the separately -tracked `TrProj` frontier. No new axiom or native-evaluation principle is -used. -/ /-- -info: 'Lean4Lean.InductiveReplayFixtures.aliasFormerFamily_candidateTrace' depends on axioms: [propext, +info: 'Lean4Lean.InductiveReplayFixtures.aliasRecBlock_wf_checked' depends on axioms: [propext, sorryAx, Classical.choice, + ptrEqConstantInfo_eq, + ptrEqExpr_eq, Quot.sound, + Expr.abstractRange_eq, + Expr.abstract_eq, Expr.eqv_eq, + Expr.hasLooseBVar_eq, + Expr.instantiate1_eq, + Expr.instantiateRange_eq, + Expr.instantiateRevRange_eq, + Expr.instantiateRev_eq, + Expr.instantiate_eq, Expr.looseBVarRange_eq, + Expr.lowerLooseBVars_eq, + Expr.mkAppData_eq, + Expr.mkData_eq, + Expr.replace_eq, + Level.hasMVar_eq, + Level.hasParam_eq, Level.instLawfulBEqLevel, + PersistentArray.toList'_push, PersistentHashMap.findAux_isSome, Syntax.structEq_eq, PersistentHashMap.WF.find?_eq, PersistentHashMap.WF.toList'_insert] -/ #guard_msgs in -#print axioms aliasFormerFamily_candidateTrace +#print axioms aliasRecBlock_wf_checked /-- -info: 'Lean4Lean.InductiveReplayFixtures.aliasFormerFamily_candidate' depends on axioms: [propext, +info: 'Lean4Lean.InductiveReplayFixtures.aliasRecGenerationChecked_wf_checked' depends on axioms: [propext, sorryAx, Classical.choice, + ptrEqConstantInfo_eq, + ptrEqExpr_eq, Quot.sound, + Expr.abstractRange_eq, + Expr.abstract_eq, Expr.eqv_eq, + Expr.hasLooseBVar_eq, + Expr.instantiate1_eq, + Expr.instantiateRange_eq, + Expr.instantiateRevRange_eq, + Expr.instantiateRev_eq, + Expr.instantiate_eq, Expr.looseBVarRange_eq, + Expr.lowerLooseBVars_eq, + Expr.mkAppData_eq, + Expr.mkData_eq, + Expr.replace_eq, + Level.hasMVar_eq, + Level.hasParam_eq, Level.instLawfulBEqLevel, + PersistentArray.toList'_push, PersistentHashMap.findAux_isSome, Syntax.structEq_eq, PersistentHashMap.WF.find?_eq, PersistentHashMap.WF.toList'_insert] -/ #guard_msgs in -#print axioms aliasFormerFamily_candidate +#print axioms aliasRecGenerationChecked_wf_checked /-- -info: 'Lean4Lean.InductiveReplayFixtures.aliasFormerFamily_candidateSource_tr' depends on axioms: [propext, +info: 'Lean4Lean.InductiveReplayFixtures.aliasFormerAddInductTraceChecked' depends on axioms: [propext, sorryAx, Classical.choice, + ptrEqConstantInfo_eq, + ptrEqExpr_eq, Quot.sound, + Expr.abstractRange_eq, + Expr.abstract_eq, Expr.eqv_eq, + Expr.hasLooseBVar_eq, + Expr.instantiate1_eq, + Expr.instantiateRange_eq, + Expr.instantiateRevRange_eq, + Expr.instantiateRev_eq, + Expr.instantiate_eq, Expr.looseBVarRange_eq, + Expr.lowerLooseBVars_eq, + Expr.mkAppData_eq, + Expr.mkData_eq, + Expr.replace_eq, + Level.hasMVar_eq, + Level.hasParam_eq, Level.instLawfulBEqLevel, + PersistentArray.toList'_push, PersistentHashMap.findAux_isSome, Syntax.structEq_eq, PersistentHashMap.WF.find?_eq, PersistentHashMap.WF.toList'_insert] -/ #guard_msgs in -#print axioms aliasFormerFamily_candidateSource_tr +#print axioms aliasFormerAddInductTraceChecked /-- -info: 'Lean4Lean.InductiveReplayFixtures.aliasFormerFamily_candidateView_tr' depends on axioms: [propext, +info: 'Lean4Lean.InductiveReplayFixtures.aliasFormer_trEnv'_checked' depends on axioms: [propext, sorryAx, Classical.choice, ptrEqConstantInfo_eq, @@ -3917,7 +9571,6 @@ info: 'Lean4Lean.InductiveReplayFixtures.aliasFormerFamily_candidateView_tr' dep Expr.abstractRange_eq, Expr.abstract_eq, Expr.eqv_eq, - Expr.hasLevelParam_eq, Expr.hasLooseBVar_eq, Expr.instantiate1_eq, Expr.instantiateRange_eq, @@ -3926,6 +9579,8 @@ info: 'Lean4Lean.InductiveReplayFixtures.aliasFormerFamily_candidateView_tr' dep Expr.instantiate_eq, Expr.looseBVarRange_eq, Expr.lowerLooseBVars_eq, + Expr.mkAppData_eq, + Expr.mkData_eq, Expr.replace_eq, Level.hasMVar_eq, Level.hasParam_eq, @@ -3933,36 +9588,47 @@ info: 'Lean4Lean.InductiveReplayFixtures.aliasFormerFamily_candidateView_tr' dep PersistentArray.toList'_push, PersistentHashMap.findAux_isSome, Syntax.structEq_eq, - Std.TreeMap.all_eq_all_toList, - Expr.mkAppRangeAux.eq_def, PersistentHashMap.WF.find?_eq, PersistentHashMap.WF.toList'_insert] -/ #guard_msgs in -#print axioms aliasFormerFamily_candidateView_tr +#print axioms aliasFormer_trEnv'_checked /-- -info: 'Lean4Lean.InductiveReplayFixtures.aliasRecField_checkType' depends on axioms: [propext, +info: 'Lean4Lean.InductiveReplayFixtures.aliasRecAddInductTraceChecked' depends on axioms: [propext, sorryAx, Classical.choice, + ptrEqConstantInfo_eq, + ptrEqExpr_eq, Quot.sound, + Expr.abstractRange_eq, + Expr.abstract_eq, Expr.eqv_eq, - Expr.hasLevelParam_eq, + Expr.hasLooseBVar_eq, Expr.instantiate1_eq, + Expr.instantiateRange_eq, + Expr.instantiateRevRange_eq, + Expr.instantiateRev_eq, + Expr.instantiate_eq, Expr.looseBVarRange_eq, + Expr.lowerLooseBVars_eq, + Expr.mkAppData_eq, + Expr.mkData_eq, Expr.replace_eq, + Level.hasMVar_eq, Level.hasParam_eq, Level.instLawfulBEqLevel, + PersistentArray.toList'_push, PersistentHashMap.findAux_isSome, Syntax.structEq_eq, PersistentHashMap.WF.find?_eq, PersistentHashMap.WF.toList'_insert] -/ #guard_msgs in -#print axioms aliasRecField_checkType +#print axioms aliasRecAddInductTraceChecked /-- -info: 'Lean4Lean.InductiveReplayFixtures.aliasRecField_hasType_checked' depends on axioms: [propext, +info: 'Lean4Lean.InductiveReplayFixtures.aliasRec_trEnv'_checked' depends on axioms: [propext, sorryAx, Classical.choice, ptrEqConstantInfo_eq, @@ -3971,7 +9637,6 @@ info: 'Lean4Lean.InductiveReplayFixtures.aliasRecField_hasType_checked' depends Expr.abstractRange_eq, Expr.abstract_eq, Expr.eqv_eq, - Expr.hasLevelParam_eq, Expr.hasLooseBVar_eq, Expr.instantiate1_eq, Expr.instantiateRange_eq, @@ -3980,6 +9645,8 @@ info: 'Lean4Lean.InductiveReplayFixtures.aliasRecField_hasType_checked' depends Expr.instantiate_eq, Expr.looseBVarRange_eq, Expr.lowerLooseBVars_eq, + Expr.mkAppData_eq, + Expr.mkData_eq, Expr.replace_eq, Level.hasMVar_eq, Level.hasParam_eq, @@ -3987,81 +9654,90 @@ info: 'Lean4Lean.InductiveReplayFixtures.aliasRecField_hasType_checked' depends PersistentArray.toList'_push, PersistentHashMap.findAux_isSome, Syntax.structEq_eq, - Std.TreeMap.all_eq_all_toList, - Expr.mkAppRangeAux.eq_def, PersistentHashMap.WF.find?_eq, PersistentHashMap.WF.toList'_insert] -/ #guard_msgs in -#print axioms aliasRecField_hasType_checked +#print axioms aliasRec_trEnv'_checked +/- Both alias replays have the same explicitly transitional Verify closure as +the identity fixtures. `sorryAx` is inherited only through `TrProj`, and the +three persistent-map contracts enter through concrete `ConstMap` freshness +proofs. -/ /-- -info: 'Lean4Lean.InductiveReplayFixtures.aliasFormerFamily_whnf' depends on axioms: [propext, +info: 'Lean4Lean.InductiveReplayFixtures.aliasFormer_trEnv'' depends on axioms: [propext, sorryAx, Classical.choice, Quot.sound, - Expr.eqv_eq, - Level.instLawfulBEqLevel, PersistentHashMap.findAux_isSome, - Syntax.structEq_eq, PersistentHashMap.WF.find?_eq, PersistentHashMap.WF.toList'_insert] -/ #guard_msgs in -#print axioms aliasFormerFamily_whnf +#print axioms aliasFormer_trEnv' /-- -info: 'Lean4Lean.InductiveReplayFixtures.recAlias_whnf' depends on axioms: [propext, +info: 'Lean4Lean.InductiveReplayFixtures.aliasFormer_env_wf' depends on axioms: [propext, sorryAx, Classical.choice, Quot.sound, - Expr.eqv_eq, - Expr.hasLevelParam_eq, - Expr.replace_eq, - Level.hasParam_eq, - Level.instLawfulBEqLevel, PersistentHashMap.findAux_isSome, - Syntax.structEq_eq, PersistentHashMap.WF.find?_eq, PersistentHashMap.WF.toList'_insert] -/ #guard_msgs in -#print axioms recAlias_whnf +#print axioms aliasFormer_env_wf /-- -info: 'Lean4Lean.InductiveReplayFixtures.aliasFormerFamily_checkType' depends on axioms: [propext, +info: 'Lean4Lean.InductiveReplayFixtures.aliasFormer_aligned' depends on axioms: [propext, sorryAx, Classical.choice, Quot.sound, - Expr.eqv_eq, - Expr.looseBVarRange_eq, - Level.instLawfulBEqLevel, PersistentHashMap.findAux_isSome, - Syntax.structEq_eq, PersistentHashMap.WF.find?_eq, PersistentHashMap.WF.toList'_insert] -/ #guard_msgs in -#print axioms aliasFormerFamily_checkType +#print axioms aliasFormer_aligned /-- -info: 'Lean4Lean.InductiveReplayFixtures.aliasFormerCtor_checkType' depends on axioms: [propext, +info: 'Lean4Lean.InductiveReplayFixtures.aliasRec_trEnv'' depends on axioms: [propext, sorryAx, Classical.choice, Quot.sound, - Expr.eqv_eq, - Expr.looseBVarRange_eq, - Level.instLawfulBEqLevel, PersistentHashMap.findAux_isSome, - Syntax.structEq_eq, PersistentHashMap.WF.find?_eq, PersistentHashMap.WF.toList'_insert] -/ #guard_msgs in -#print axioms aliasFormerCtor_checkType +#print axioms aliasRec_trEnv' /-- -info: 'Lean4Lean.InductiveReplayFixtures.aliasFormerFamily_isType_checked' depends on axioms: [propext, +info: 'Lean4Lean.InductiveReplayFixtures.aliasRec_env_wf' depends on axioms: [propext, + sorryAx, + Classical.choice, + Quot.sound, + PersistentHashMap.findAux_isSome, + PersistentHashMap.WF.find?_eq, + PersistentHashMap.WF.toList'_insert] +-/ +#guard_msgs in +#print axioms aliasRec_env_wf + +/-- +info: 'Lean4Lean.InductiveReplayFixtures.aliasRec_aligned' depends on axioms: [propext, + sorryAx, + Classical.choice, + Quot.sound, + PersistentHashMap.findAux_isSome, + PersistentHashMap.WF.find?_eq, + PersistentHashMap.WF.toList'_insert] +-/ +#guard_msgs in +#print axioms aliasRec_aligned + +/-- +info: 'Lean4Lean.InductiveReplayFixtures.annotatedPiProducedSemanticHierarchy_exists' depends on axioms: [propext, sorryAx, Classical.choice, ptrEqConstantInfo_eq, @@ -4070,7 +9746,6 @@ info: 'Lean4Lean.InductiveReplayFixtures.aliasFormerFamily_isType_checked' depen Expr.abstractRange_eq, Expr.abstract_eq, Expr.eqv_eq, - Expr.hasLevelParam_eq, Expr.hasLooseBVar_eq, Expr.instantiate1_eq, Expr.instantiateRange_eq, @@ -4079,6 +9754,8 @@ info: 'Lean4Lean.InductiveReplayFixtures.aliasFormerFamily_isType_checked' depen Expr.instantiate_eq, Expr.looseBVarRange_eq, Expr.lowerLooseBVars_eq, + Expr.mkAppData_eq, + Expr.mkData_eq, Expr.replace_eq, Level.hasMVar_eq, Level.hasParam_eq, @@ -4086,16 +9763,14 @@ info: 'Lean4Lean.InductiveReplayFixtures.aliasFormerFamily_isType_checked' depen PersistentArray.toList'_push, PersistentHashMap.findAux_isSome, Syntax.structEq_eq, - Std.TreeMap.all_eq_all_toList, - Expr.mkAppRangeAux.eq_def, PersistentHashMap.WF.find?_eq, PersistentHashMap.WF.toList'_insert] -/ #guard_msgs in -#print axioms aliasFormerFamily_isType_checked +#print axioms annotatedPiProducedSemanticHierarchy_exists /-- -info: 'Lean4Lean.InductiveReplayFixtures.aliasFormerCtor_isType_checked' depends on axioms: [propext, +info: 'Lean4Lean.InductiveReplayFixtures.annotatedPiNormalizationCandidateRun' depends on axioms: [propext, sorryAx, Classical.choice, ptrEqConstantInfo_eq, @@ -4104,7 +9779,6 @@ info: 'Lean4Lean.InductiveReplayFixtures.aliasFormerCtor_isType_checked' depends Expr.abstractRange_eq, Expr.abstract_eq, Expr.eqv_eq, - Expr.hasLevelParam_eq, Expr.hasLooseBVar_eq, Expr.instantiate1_eq, Expr.instantiateRange_eq, @@ -4113,6 +9787,8 @@ info: 'Lean4Lean.InductiveReplayFixtures.aliasFormerCtor_isType_checked' depends Expr.instantiate_eq, Expr.looseBVarRange_eq, Expr.lowerLooseBVars_eq, + Expr.mkAppData_eq, + Expr.mkData_eq, Expr.replace_eq, Level.hasMVar_eq, Level.hasParam_eq, @@ -4120,16 +9796,14 @@ info: 'Lean4Lean.InductiveReplayFixtures.aliasFormerCtor_isType_checked' depends PersistentArray.toList'_push, PersistentHashMap.findAux_isSome, Syntax.structEq_eq, - Std.TreeMap.all_eq_all_toList, - Expr.mkAppRangeAux.eq_def, PersistentHashMap.WF.find?_eq, PersistentHashMap.WF.toList'_insert] -/ #guard_msgs in -#print axioms aliasFormerCtor_isType_checked +#print axioms annotatedPiNormalizationCandidateRun /-- -info: 'Lean4Lean.InductiveReplayFixtures.aliasFormerNormalization_wf_checked' depends on axioms: [propext, +info: 'Lean4Lean.InductiveReplayFixtures.annotatedPiGenerationCandidateSemanticRun' depends on axioms: [propext, sorryAx, Classical.choice, ptrEqConstantInfo_eq, @@ -4138,7 +9812,6 @@ info: 'Lean4Lean.InductiveReplayFixtures.aliasFormerNormalization_wf_checked' de Expr.abstractRange_eq, Expr.abstract_eq, Expr.eqv_eq, - Expr.hasLevelParam_eq, Expr.hasLooseBVar_eq, Expr.instantiate1_eq, Expr.instantiateRange_eq, @@ -4147,6 +9820,8 @@ info: 'Lean4Lean.InductiveReplayFixtures.aliasFormerNormalization_wf_checked' de Expr.instantiate_eq, Expr.looseBVarRange_eq, Expr.lowerLooseBVars_eq, + Expr.mkAppData_eq, + Expr.mkData_eq, Expr.replace_eq, Level.hasMVar_eq, Level.hasParam_eq, @@ -4154,16 +9829,14 @@ info: 'Lean4Lean.InductiveReplayFixtures.aliasFormerNormalization_wf_checked' de PersistentArray.toList'_push, PersistentHashMap.findAux_isSome, Syntax.structEq_eq, - Std.TreeMap.all_eq_all_toList, - Expr.mkAppRangeAux.eq_def, PersistentHashMap.WF.find?_eq, PersistentHashMap.WF.toList'_insert] -/ #guard_msgs in -#print axioms aliasFormerNormalization_wf_checked +#print axioms annotatedPiGenerationCandidateSemanticRun /-- -info: 'Lean4Lean.InductiveReplayFixtures.aliasRecNormalization_wf_checked' depends on axioms: [propext, +info: 'Lean4Lean.InductiveReplayFixtures.annotatedPiGenerationCandidateRun' depends on axioms: [propext, sorryAx, Classical.choice, ptrEqConstantInfo_eq, @@ -4172,7 +9845,6 @@ info: 'Lean4Lean.InductiveReplayFixtures.aliasRecNormalization_wf_checked' depen Expr.abstractRange_eq, Expr.abstract_eq, Expr.eqv_eq, - Expr.hasLevelParam_eq, Expr.hasLooseBVar_eq, Expr.instantiate1_eq, Expr.instantiateRange_eq, @@ -4181,6 +9853,8 @@ info: 'Lean4Lean.InductiveReplayFixtures.aliasRecNormalization_wf_checked' depen Expr.instantiate_eq, Expr.looseBVarRange_eq, Expr.lowerLooseBVars_eq, + Expr.mkAppData_eq, + Expr.mkData_eq, Expr.replace_eq, Level.hasMVar_eq, Level.hasParam_eq, @@ -4188,16 +9862,14 @@ info: 'Lean4Lean.InductiveReplayFixtures.aliasRecNormalization_wf_checked' depen PersistentArray.toList'_push, PersistentHashMap.findAux_isSome, Syntax.structEq_eq, - Std.TreeMap.all_eq_all_toList, - Expr.mkAppRangeAux.eq_def, PersistentHashMap.WF.find?_eq, PersistentHashMap.WF.toList'_insert] -/ #guard_msgs in -#print axioms aliasRecNormalization_wf_checked +#print axioms annotatedPiGenerationCandidateRun /-- -info: 'Lean4Lean.InductiveReplayFixtures.aliasFormerBlock_wf_checked' depends on axioms: [propext, +info: 'Lean4Lean.InductiveReplayFixtures.annotatedPiGenerationCandidatePackage' depends on axioms: [propext, sorryAx, Classical.choice, ptrEqConstantInfo_eq, @@ -4206,7 +9878,6 @@ info: 'Lean4Lean.InductiveReplayFixtures.aliasFormerBlock_wf_checked' depends on Expr.abstractRange_eq, Expr.abstract_eq, Expr.eqv_eq, - Expr.hasLevelParam_eq, Expr.hasLooseBVar_eq, Expr.instantiate1_eq, Expr.instantiateRange_eq, @@ -4215,6 +9886,8 @@ info: 'Lean4Lean.InductiveReplayFixtures.aliasFormerBlock_wf_checked' depends on Expr.instantiate_eq, Expr.looseBVarRange_eq, Expr.lowerLooseBVars_eq, + Expr.mkAppData_eq, + Expr.mkData_eq, Expr.replace_eq, Level.hasMVar_eq, Level.hasParam_eq, @@ -4222,67 +9895,67 @@ info: 'Lean4Lean.InductiveReplayFixtures.aliasFormerBlock_wf_checked' depends on PersistentArray.toList'_push, PersistentHashMap.findAux_isSome, Syntax.structEq_eq, - Std.TreeMap.all_eq_all_toList, - Expr.mkAppRangeAux.eq_def, PersistentHashMap.WF.find?_eq, PersistentHashMap.WF.toList'_insert] -/ #guard_msgs in -#print axioms aliasFormerBlock_wf_checked +#print axioms annotatedPiGenerationCandidatePackage /-- -info: 'Lean4Lean.InductiveReplayFixtures.aliasFormerGenerationChecked_wf_checked' depends on axioms: [propext, +info: 'Lean4Lean.InductiveReplayFixtures.annotatedPiCtor_candidateTrace' depends on axioms: [propext, sorryAx, Classical.choice, - ptrEqConstantInfo_eq, ptrEqExpr_eq, Quot.sound, - Expr.abstractRange_eq, - Expr.abstract_eq, Expr.eqv_eq, - Expr.hasLevelParam_eq, - Expr.hasLooseBVar_eq, Expr.instantiate1_eq, Expr.instantiateRange_eq, Expr.instantiateRevRange_eq, Expr.instantiateRev_eq, Expr.instantiate_eq, Expr.looseBVarRange_eq, - Expr.lowerLooseBVars_eq, + Expr.mkAppData_eq, + Expr.mkData_eq, Expr.replace_eq, - Level.hasMVar_eq, Level.hasParam_eq, Level.instLawfulBEqLevel, PersistentArray.toList'_push, PersistentHashMap.findAux_isSome, Syntax.structEq_eq, - Std.TreeMap.all_eq_all_toList, - Expr.mkAppRangeAux.eq_def, PersistentHashMap.WF.find?_eq, PersistentHashMap.WF.toList'_insert] -/ #guard_msgs in -#print axioms aliasFormerGenerationChecked_wf_checked +#print axioms annotatedPiCtor_candidateTrace /-- -info: 'Lean4Lean.InductiveReplayFixtures.aliasRecBlock_wf_checked' depends on axioms: [propext, +info: 'Lean4Lean.InductiveReplayFixtures.annotatedPiFamily_candidateTrace' depends on axioms: [propext, + Classical.choice, + Quot.sound, + Expr.eqv_eq, + Expr.looseBVarRange_eq, + Level.hasParam_eq, + Level.instLawfulBEqLevel, + Syntax.structEq_eq] +-/ +#guard_msgs in +#print axioms annotatedPiFamily_candidateTrace + +/-- +info: 'Lean4Lean.InductiveReplayFixtures.annotatedPiNormalizationCandidate_produced' depends on axioms: [propext, sorryAx, Classical.choice, - ptrEqConstantInfo_eq, ptrEqExpr_eq, Quot.sound, - Expr.abstractRange_eq, - Expr.abstract_eq, Expr.eqv_eq, - Expr.hasLevelParam_eq, - Expr.hasLooseBVar_eq, Expr.instantiate1_eq, Expr.instantiateRange_eq, Expr.instantiateRevRange_eq, Expr.instantiateRev_eq, Expr.instantiate_eq, Expr.looseBVarRange_eq, - Expr.lowerLooseBVars_eq, + Expr.mkAppData_eq, + Expr.mkData_eq, Expr.replace_eq, Level.hasMVar_eq, Level.hasParam_eq, @@ -4290,16 +9963,14 @@ info: 'Lean4Lean.InductiveReplayFixtures.aliasRecBlock_wf_checked' depends on ax PersistentArray.toList'_push, PersistentHashMap.findAux_isSome, Syntax.structEq_eq, - Std.TreeMap.all_eq_all_toList, - Expr.mkAppRangeAux.eq_def, PersistentHashMap.WF.find?_eq, PersistentHashMap.WF.toList'_insert] -/ #guard_msgs in -#print axioms aliasRecBlock_wf_checked +#print axioms annotatedPiNormalizationCandidate_produced /-- -info: 'Lean4Lean.InductiveReplayFixtures.aliasRecGenerationChecked_wf_checked' depends on axioms: [propext, +info: 'Lean4Lean.InductiveReplayFixtures.annotatedPiGenerationShapeCandidate_produced' depends on axioms: [propext, sorryAx, Classical.choice, ptrEqConstantInfo_eq, @@ -4308,7 +9979,6 @@ info: 'Lean4Lean.InductiveReplayFixtures.aliasRecGenerationChecked_wf_checked' d Expr.abstractRange_eq, Expr.abstract_eq, Expr.eqv_eq, - Expr.hasLevelParam_eq, Expr.hasLooseBVar_eq, Expr.instantiate1_eq, Expr.instantiateRange_eq, @@ -4317,6 +9987,8 @@ info: 'Lean4Lean.InductiveReplayFixtures.aliasRecGenerationChecked_wf_checked' d Expr.instantiate_eq, Expr.looseBVarRange_eq, Expr.lowerLooseBVars_eq, + Expr.mkAppData_eq, + Expr.mkData_eq, Expr.replace_eq, Level.hasMVar_eq, Level.hasParam_eq, @@ -4324,16 +9996,14 @@ info: 'Lean4Lean.InductiveReplayFixtures.aliasRecGenerationChecked_wf_checked' d PersistentArray.toList'_push, PersistentHashMap.findAux_isSome, Syntax.structEq_eq, - Std.TreeMap.all_eq_all_toList, - Expr.mkAppRangeAux.eq_def, PersistentHashMap.WF.find?_eq, PersistentHashMap.WF.toList'_insert] -/ #guard_msgs in -#print axioms aliasRecGenerationChecked_wf_checked +#print axioms annotatedPiGenerationShapeCandidate_produced /-- -info: 'Lean4Lean.InductiveReplayFixtures.aliasFormerAddInductTraceChecked' depends on axioms: [propext, +info: 'Lean4Lean.InductiveReplayFixtures.annotatedPiProducedGenerationCandidatePackage' depends on axioms: [propext, sorryAx, Classical.choice, ptrEqConstantInfo_eq, @@ -4342,7 +10012,6 @@ info: 'Lean4Lean.InductiveReplayFixtures.aliasFormerAddInductTraceChecked' depen Expr.abstractRange_eq, Expr.abstract_eq, Expr.eqv_eq, - Expr.hasLevelParam_eq, Expr.hasLooseBVar_eq, Expr.instantiate1_eq, Expr.instantiateRange_eq, @@ -4351,6 +10020,8 @@ info: 'Lean4Lean.InductiveReplayFixtures.aliasFormerAddInductTraceChecked' depen Expr.instantiate_eq, Expr.looseBVarRange_eq, Expr.lowerLooseBVars_eq, + Expr.mkAppData_eq, + Expr.mkData_eq, Expr.replace_eq, Level.hasMVar_eq, Level.hasParam_eq, @@ -4358,16 +10029,14 @@ info: 'Lean4Lean.InductiveReplayFixtures.aliasFormerAddInductTraceChecked' depen PersistentArray.toList'_push, PersistentHashMap.findAux_isSome, Syntax.structEq_eq, - Std.TreeMap.all_eq_all_toList, - Expr.mkAppRangeAux.eq_def, PersistentHashMap.WF.find?_eq, PersistentHashMap.WF.toList'_insert] -/ #guard_msgs in -#print axioms aliasFormerAddInductTraceChecked +#print axioms annotatedPiProducedGenerationCandidatePackage /-- -info: 'Lean4Lean.InductiveReplayFixtures.aliasFormer_trEnv'_checked' depends on axioms: [propext, +info: 'Lean4Lean.InductiveReplayFixtures.annotatedPi_addInductCertified' depends on axioms: [propext, sorryAx, Classical.choice, ptrEqConstantInfo_eq, @@ -4376,7 +10045,6 @@ info: 'Lean4Lean.InductiveReplayFixtures.aliasFormer_trEnv'_checked' depends on Expr.abstractRange_eq, Expr.abstract_eq, Expr.eqv_eq, - Expr.hasLevelParam_eq, Expr.hasLooseBVar_eq, Expr.instantiate1_eq, Expr.instantiateRange_eq, @@ -4385,6 +10053,8 @@ info: 'Lean4Lean.InductiveReplayFixtures.aliasFormer_trEnv'_checked' depends on Expr.instantiate_eq, Expr.looseBVarRange_eq, Expr.lowerLooseBVars_eq, + Expr.mkAppData_eq, + Expr.mkData_eq, Expr.replace_eq, Level.hasMVar_eq, Level.hasParam_eq, @@ -4392,16 +10062,14 @@ info: 'Lean4Lean.InductiveReplayFixtures.aliasFormer_trEnv'_checked' depends on PersistentArray.toList'_push, PersistentHashMap.findAux_isSome, Syntax.structEq_eq, - Std.TreeMap.all_eq_all_toList, - Expr.mkAppRangeAux.eq_def, PersistentHashMap.WF.find?_eq, PersistentHashMap.WF.toList'_insert] -/ #guard_msgs in -#print axioms aliasFormer_trEnv'_checked +#print axioms annotatedPi_addInductCertified /-- -info: 'Lean4Lean.InductiveReplayFixtures.aliasRecAddInductTraceChecked' depends on axioms: [propext, +info: 'Lean4Lean.InductiveReplayFixtures.annotatedPiGenerationChecked_wf_checked' depends on axioms: [propext, sorryAx, Classical.choice, ptrEqConstantInfo_eq, @@ -4410,7 +10078,6 @@ info: 'Lean4Lean.InductiveReplayFixtures.aliasRecAddInductTraceChecked' depends Expr.abstractRange_eq, Expr.abstract_eq, Expr.eqv_eq, - Expr.hasLevelParam_eq, Expr.hasLooseBVar_eq, Expr.instantiate1_eq, Expr.instantiateRange_eq, @@ -4419,6 +10086,8 @@ info: 'Lean4Lean.InductiveReplayFixtures.aliasRecAddInductTraceChecked' depends Expr.instantiate_eq, Expr.looseBVarRange_eq, Expr.lowerLooseBVars_eq, + Expr.mkAppData_eq, + Expr.mkData_eq, Expr.replace_eq, Level.hasMVar_eq, Level.hasParam_eq, @@ -4426,16 +10095,14 @@ info: 'Lean4Lean.InductiveReplayFixtures.aliasRecAddInductTraceChecked' depends PersistentArray.toList'_push, PersistentHashMap.findAux_isSome, Syntax.structEq_eq, - Std.TreeMap.all_eq_all_toList, - Expr.mkAppRangeAux.eq_def, PersistentHashMap.WF.find?_eq, PersistentHashMap.WF.toList'_insert] -/ #guard_msgs in -#print axioms aliasRecAddInductTraceChecked +#print axioms annotatedPiGenerationChecked_wf_checked /-- -info: 'Lean4Lean.InductiveReplayFixtures.aliasRec_trEnv'_checked' depends on axioms: [propext, +info: 'Lean4Lean.InductiveReplayFixtures.annotatedPiAddInductTraceChecked' depends on axioms: [propext, sorryAx, Classical.choice, ptrEqConstantInfo_eq, @@ -4444,7 +10111,6 @@ info: 'Lean4Lean.InductiveReplayFixtures.aliasRec_trEnv'_checked' depends on axi Expr.abstractRange_eq, Expr.abstract_eq, Expr.eqv_eq, - Expr.hasLevelParam_eq, Expr.hasLooseBVar_eq, Expr.instantiate1_eq, Expr.instantiateRange_eq, @@ -4453,6 +10119,8 @@ info: 'Lean4Lean.InductiveReplayFixtures.aliasRec_trEnv'_checked' depends on axi Expr.instantiate_eq, Expr.looseBVarRange_eq, Expr.lowerLooseBVars_eq, + Expr.mkAppData_eq, + Expr.mkData_eq, Expr.replace_eq, Level.hasMVar_eq, Level.hasParam_eq, @@ -4460,88 +10128,49 @@ info: 'Lean4Lean.InductiveReplayFixtures.aliasRec_trEnv'_checked' depends on axi PersistentArray.toList'_push, PersistentHashMap.findAux_isSome, Syntax.structEq_eq, - Std.TreeMap.all_eq_all_toList, - Expr.mkAppRangeAux.eq_def, - PersistentHashMap.WF.find?_eq, - PersistentHashMap.WF.toList'_insert] --/ -#guard_msgs in -#print axioms aliasRec_trEnv'_checked - -/- Both alias replays have the same explicitly transitional Verify closure as -the identity fixtures. `sorryAx` is inherited only through `TrProj`, and the -three persistent-map contracts enter through concrete `ConstMap` freshness -proofs. -/ -/-- -info: 'Lean4Lean.InductiveReplayFixtures.aliasFormer_trEnv'' depends on axioms: [propext, - sorryAx, - Classical.choice, - Quot.sound, - PersistentHashMap.findAux_isSome, - PersistentHashMap.WF.find?_eq, - PersistentHashMap.WF.toList'_insert] --/ -#guard_msgs in -#print axioms aliasFormer_trEnv' - -/-- -info: 'Lean4Lean.InductiveReplayFixtures.aliasFormer_env_wf' depends on axioms: [propext, - sorryAx, - Classical.choice, - Quot.sound, - PersistentHashMap.findAux_isSome, - PersistentHashMap.WF.find?_eq, - PersistentHashMap.WF.toList'_insert] --/ -#guard_msgs in -#print axioms aliasFormer_env_wf - -/-- -info: 'Lean4Lean.InductiveReplayFixtures.aliasFormer_aligned' depends on axioms: [propext, - sorryAx, - Classical.choice, - Quot.sound, - PersistentHashMap.findAux_isSome, - PersistentHashMap.WF.find?_eq, - PersistentHashMap.WF.toList'_insert] --/ -#guard_msgs in -#print axioms aliasFormer_aligned - -/-- -info: 'Lean4Lean.InductiveReplayFixtures.aliasRec_trEnv'' depends on axioms: [propext, - sorryAx, - Classical.choice, - Quot.sound, - PersistentHashMap.findAux_isSome, PersistentHashMap.WF.find?_eq, PersistentHashMap.WF.toList'_insert] -/ #guard_msgs in -#print axioms aliasRec_trEnv' +#print axioms annotatedPiAddInductTraceChecked /-- -info: 'Lean4Lean.InductiveReplayFixtures.aliasRec_env_wf' depends on axioms: [propext, +info: 'Lean4Lean.InductiveReplayFixtures.annotatedPi_trEnv'_checked' depends on axioms: [propext, sorryAx, Classical.choice, + ptrEqConstantInfo_eq, + ptrEqExpr_eq, Quot.sound, + Expr.abstractRange_eq, + Expr.abstract_eq, + Expr.eqv_eq, + Expr.hasLooseBVar_eq, + Expr.instantiate1_eq, + Expr.instantiateRange_eq, + Expr.instantiateRevRange_eq, + Expr.instantiateRev_eq, + Expr.instantiate_eq, + Expr.looseBVarRange_eq, + Expr.lowerLooseBVars_eq, + Expr.mkAppData_eq, + Expr.mkData_eq, + Expr.replace_eq, + Level.hasMVar_eq, + Level.hasParam_eq, + Level.instLawfulBEqLevel, + PersistentArray.toList'_push, PersistentHashMap.findAux_isSome, + Syntax.structEq_eq, PersistentHashMap.WF.find?_eq, PersistentHashMap.WF.toList'_insert] -/ #guard_msgs in -#print axioms aliasRec_env_wf +#print axioms annotatedPi_trEnv'_checked /-- -info: 'Lean4Lean.InductiveReplayFixtures.aliasRec_aligned' depends on axioms: [propext, - sorryAx, - Classical.choice, - Quot.sound, - PersistentHashMap.findAux_isSome, - PersistentHashMap.WF.find?_eq, - PersistentHashMap.WF.toList'_insert] +info: 'Lean4Lean.InductiveReplayFixtures.annotatedPiFinalEnv_iota_mem' depends on axioms: [propext, Quot.sound] -/ #guard_msgs in -#print axioms aliasRec_aligned +#print axioms annotatedPiFinalEnv_iota_mem end Lean4Lean.InductiveReplayFixtures diff --git a/Lean4Lean/Verify/Environment/Lemmas.lean b/Lean4Lean/Verify/Environment/Lemmas.lean index d632d622..97029fed 100644 --- a/Lean4Lean/Verify/Environment/Lemmas.lean +++ b/Lean4Lean/Verify/Environment/Lemmas.lean @@ -1,4 +1,5 @@ import Lean4Lean.Std.SMap +import Lean4Lean.Declaration import Lean4Lean.Verify.Environment.Basic namespace Lean4Lean @@ -91,17 +92,23 @@ theorem AddInductConstant.map_wf rw [H.map_add] exact wf.insert _ _ H.map_fresh +theorem InductConstantKind.Matches.deltaValue?_eq_none + {kind : InductConstantKind} {ci : ConstantInfo} + (H : InductConstantKind.Matches kind ci) : ci.deltaValue? = none := by + cases kind <;> cases ci <;> + simp_all [InductConstantKind.Matches, ConstantInfo.deltaValue?] + /-- An inductive metadata insertion cannot introduce a declaration body. Consequently, any value-bearing entry in the result map was already present in the input map. -/ theorem AddInductConstant.old_of_value (H : AddInductConstant kind C₁ env₁ ci' C₂ env₂) (wf : C₁.WF) - (hout : C₂.find? name = some ci) (hv : ci.value? = some v) : + (hout : C₂.find? name = some ci) (hv : ci.deltaValue? = some v) : C₁.find? name = some ci := by rw [H.map_add, wf.find?_insert] at hout split at hout · cases hout - have hnone := InductConstantKind.Matches.value?_eq_none H.kind_eq + have hnone := InductConstantKind.Matches.deltaValue?_eq_none H.kind_eq simp_all · exact hout @@ -112,7 +119,7 @@ theorem AddInductConstants.map_wf : theorem AddInductConstants.old_of_value : (H : AddInductConstants kind C₁ env₁ cis C₂ env₂) → C₁.WF → - C₂.find? name = some ci → ci.value? = some v → C₁.find? name = some ci + C₂.find? name = some ci → ci.deltaValue? = some v → C₁.find? name = some ci | .nil, _, hout, _ => hout | .cons h hrest, wf, hout, hv => h.old_of_value wf (hrest.old_of_value (h.map_wf wf) hout hv) hv @@ -123,7 +130,7 @@ theorem AddInduct.map_wf (H : AddInduct C₁ env₁ decl C₂ env₂) exact H.addRec.map_wf <| H.addCtors.map_wf <| H.addType.map_wf wf theorem AddInduct.old_of_value (H : AddInduct C₁ env₁ decl C₂ env₂) - (wf : C₁.WF) (hout : C₂.find? name = some ci) (hv : ci.value? = some v) : + (wf : C₁.WF) (hout : C₂.find? name = some ci) (hv : ci.deltaValue? = some v) : C₁.find? name = some ci := by rcases H with ⟨H⟩ have wfType := H.addType.map_wf wf @@ -244,7 +251,7 @@ theorem TrEnv.find?_uniq (H : TrEnv safety env venv) H.aligned.find?_uniq (H.map_wf.find?'_eq_find? _ ▸ h) hs theorem TrEnv'.of_value (H : TrEnv' safety C Q venv) (h : C.find? name = some ci) - (hs : safety ≤ ci.safety) (hv : ci.value? = some v) : + (hs : safety ≤ ci.safety) (hv : ci.deltaValue? = some v) : TrExpr venv ci.levelParams [] v (.const ci.name (VLevel.params ci.levelParams.length)) := by have {C n ci'} (hC : C.WF) : (SMap.insert C n ci').find? name = some ci → @@ -281,6 +288,6 @@ theorem TrEnv'.of_value (H : TrEnv' safety C Q venv) (h : C.find? name = some ci exact (ih (h1.old_of_value H.map_wf h hv)).mono h1.le nonrec theorem TrEnv.of_value (H : TrEnv safety env venv) (h : env.find? name = some ci) - (hs : safety ≤ ci.safety) (hv : ci.value? = some v) : + (hs : safety ≤ ci.safety) (hv : ci.deltaValue? = some v) : TrExpr venv ci.levelParams [] v (.const ci.name (VLevel.params ci.levelParams.length)) := H.of_value (by rwa [← H.map_wf.find?'_eq_find?]) hs hv diff --git a/Lean4Lean/Verify/Environment/Normalization.lean b/Lean4Lean/Verify/Environment/Normalization.lean index f7ac4923..2aafb958 100644 --- a/Lean4Lean/Verify/Environment/Normalization.lean +++ b/Lean4Lean/Verify/Environment/Normalization.lean @@ -84,6 +84,114 @@ theorem VEnv.HasPrimitives.of_avoids (noLookup ``String.ofList (by simp [reflectedPrimitiveNames]) hci).elim } +/-- A fresh Theory constant leaves every other lookup unchanged. -/ +theorem VEnv.addConst_other + {env env' : VEnv} {name other : Name} {ci : VConstant} + (hadd : env.addConst name ci = some env') + (hne : name ≠ other) : + env'.constants other = env.constants other := by + unfold Lean4Lean.VEnv.addConst at hadd + split at hadd <;> cases hadd + simp [hne] + +/-- Inserting a non-primitive constant preserves the verified checker's +primitive-reflection contract. The computational reflection equations are +transported monotonically; the primitive constant lookups themselves are +unchanged. -/ +theorem VEnv.HasPrimitives.addConst + {env env' : VEnv} {name : Name} {ci : VConstant} + (H : env.HasPrimitives) + (hname : name ∉ reflectedPrimitiveNames) + (hadd : env.addConst name ci = some env') : + env'.HasPrimitives := by + have lookup (other : Name) (hother : other ∈ reflectedPrimitiveNames) : + env'.constants other = env.constants other := + VEnv.addConst_other hadd (by + intro h + apply hname + simpa only [h] using hother) + have oldContains (other : Name) + (hother : other ∈ reflectedPrimitiveNames) : + env'.contains other → env.contains other := by + rintro ⟨value, hvalue⟩ + exact ⟨value, by simpa only [lookup other hother] using hvalue⟩ + have newContains (other : Name) : + env.contains other → env'.contains other := by + rintro ⟨value, hvalue⟩ + exact ⟨value, (VEnv.addConst_le hadd).constants hvalue⟩ + have hle := VEnv.addConst_le hadd + exact { + bool := fun h => by + obtain ⟨hfalse, htrue⟩ := H.bool (oldContains ``Bool + (by simp [reflectedPrimitiveNames]) h) + exact ⟨newContains _ hfalse, newContains _ htrue⟩ + boolFalse := fun h => H.boolFalse (by + simpa only [lookup ``Bool.false + (by simp [reflectedPrimitiveNames])] using h) + boolTrue := fun h => H.boolTrue (by + simpa only [lookup ``Bool.true + (by simp [reflectedPrimitiveNames])] using h) + nat := fun h => by + obtain ⟨hzero, hsucc⟩ := H.nat (oldContains ``Nat + (by simp [reflectedPrimitiveNames]) h) + exact ⟨newContains _ hzero, newContains _ hsucc⟩ + natZero := fun h => H.natZero (by + simpa only [lookup ``Nat.zero + (by simp [reflectedPrimitiveNames])] using h) + natSucc := fun h => H.natSucc (by + simpa only [lookup ``Nat.succ + (by simp [reflectedPrimitiveNames])] using h) + natAdd := fun h a b => + (H.natAdd (oldContains ``Nat.add + (by simp [reflectedPrimitiveNames]) h) a b).mono hle + natSub := fun h a b => + (H.natSub (oldContains ``Nat.sub + (by simp [reflectedPrimitiveNames]) h) a b).mono hle + natMul := fun h a b => + (H.natMul (oldContains ``Nat.mul + (by simp [reflectedPrimitiveNames]) h) a b).mono hle + natPow := fun h a b => + (H.natPow (oldContains ``Nat.pow + (by simp [reflectedPrimitiveNames]) h) a b).mono hle + natGcd := fun h a b => + (H.natGcd (oldContains ``Nat.gcd + (by simp [reflectedPrimitiveNames]) h) a b).mono hle + natMod := fun h a b => + (H.natMod (oldContains ``Nat.mod + (by simp [reflectedPrimitiveNames]) h) a b).mono hle + natDiv := fun h a b => + (H.natDiv (oldContains ``Nat.div + (by simp [reflectedPrimitiveNames]) h) a b).mono hle + natBEq := fun h a b => + (H.natBEq (oldContains ``Nat.beq + (by simp [reflectedPrimitiveNames]) h) a b).mono hle + natBLE := fun h a b => + (H.natBLE (oldContains ``Nat.ble + (by simp [reflectedPrimitiveNames]) h) a b).mono hle + natLAnd := fun h a b => + (H.natLAnd (oldContains ``Nat.land + (by simp [reflectedPrimitiveNames]) h) a b).mono hle + natLOr := fun h a b => + (H.natLOr (oldContains ``Nat.lor + (by simp [reflectedPrimitiveNames]) h) a b).mono hle + natXor := fun h a b => + (H.natXor (oldContains ``Nat.xor + (by simp [reflectedPrimitiveNames]) h) a b).mono hle + natShiftLeft := fun h a b => + (H.natShiftLeft (oldContains ``Nat.shiftLeft + (by simp [reflectedPrimitiveNames]) h) a b).mono hle + natShiftRight := fun h a b => + (H.natShiftRight (oldContains ``Nat.shiftRight + (by simp [reflectedPrimitiveNames]) h) a b).mono hle + charOfNat := fun h => H.charOfNat (by + simpa only [lookup ``Char.ofNat + (by simp [reflectedPrimitiveNames])] using h) + stringOfList := fun h => by + obtain ⟨hconstant, hnil, hcons⟩ := H.stringOfList (by + simpa only [lookup ``String.ofList + (by simp [reflectedPrimitiveNames])] using h) + exact ⟨hconstant, hnil.mono hle, hcons.mono hle⟩ } + /-- Kernel-side counterpart of `VEnv.HasPrimitives.of_avoids`: if an isolated constant map contains no hard-coded primitive name, the safety premise needed by `VContext` is vacuous. -/ @@ -97,6 +205,38 @@ theorem safePrimitives_of_avoids rw [h n hprim] at hfind contradiction +/-- Staging one fresh non-primitive inductive family preserves the kernel-side +primitive safety contract. All old lookups are inherited from the input map; +the only new lookup cannot be primitive by hypothesis. -/ +theorem AddInductConstant.safePrimitives + {pre post : Environment} {env typeEnv : VEnv} {raw : VConstVal} + (stage : AddInductConstant .induct pre.constants env raw + post.constants typeEnv) + (preMapWF : pre.constants.WF) + (H : pre.find? n = some ci → + Environment.primitives.contains n → + ci.safety = .safe ∧ ci.levelParams = []) + (hname : Environment.primitives.contains raw.name = false) : + post.find? n = some ci → + Environment.primitives.contains n → + ci.safety = .safe ∧ ci.levelParams = [] := by + intro hfind hprim + have postMapWF := stage.map_wf preMapWF + change post.constants.find?' n = some ci at hfind + rw [postMapWF.find?'_eq_find?, stage.map_add, + preMapWF.find?_insert] at hfind + split at hfind + · rename_i heq + have : raw.name = n := by simpa using heq + subst n + rw [hname] at hprim + contradiction + · apply H + change pre.constants.find?' n = some ci + rw [preMapWF.find?'_eq_find?] + exact hfind + exact hprim + /-- Evidence that Verify's recursive WHNF procedure returned an exact kernel expression, together with strict translations of the input and output into one Theory context. @@ -254,6 +394,36 @@ def CheckTypeRun.ofCandidateStep rw [context_eq] exact step.innerRun recursionFuel hdepth hvalid +/-- Recover the strict Theory translations and typing judgment supplied by an +exact retained full-check observation. + +This is the proof-producing counterpart of `CheckTypeRun.ofCandidateStep` for +callers that do not yet have named translations. The only source-side premise +is the free-variable condition required by the verified checker refinement. -/ +theorem candidateCheckTypeStep_exists_translation + (step : AddInductive.CandidateCheckTypeStep) + (hvalid : step.Valid) + (context : VContext) + (context_eq : context.toContext = step.context.toTypeChecker) + (state_wf : VState.WF context {}) + (source_fvars : + step.source.FVarsIn (· ∈ context.vlctx.fvars)) + (recursionFuel : Nat) + (hdepth : step.context.fuel.recDepth = recursionFuel) : + ∃ source' inferred', + context.TrExprS step.source source' ∧ + context.TrExprS step.inferred inferred' ∧ + context.HasType source' inferred' := by + obtain ⟨state, run⟩ := + step.innerRun recursionFuel hdepth hvalid + rw [← context_eq] at run + obtain ⟨_, _, _, _, source', inferred', typing⟩ := + (Inner.checkType.WF source_fvars + (Methods.withFuel recursionFuel) Methods.withFuel.WF) + state_wf step.inferred state run + exact ⟨source', inferred', typing.2.1, typing.2.2.1, + typing.2.2.2⟩ + /-- An exact successful `checkType` execution supplies the corresponding Theory typing judgment. Translation uniqueness transports the verifier's existential result to the precise translations named by the certificate. -/ @@ -306,6 +476,284 @@ theorem CheckTypeRun.isType_of_whnf run.context.Δwf.toCtx exact ⟨u, run.hasType.defeqU_r henv hΔ typeRun.isDefEqU⟩ +/-- Evidence for one exact successful checker definitional-equality run, with +strict translations of both kernel endpoints in the same Theory context. -/ +structure IsDefEqRun (env : VEnv) (Us : List Name) (Δ : VLCtx) + (lhs rhs : Expr) (lhs' rhs' : VExpr) where + context : VContext + venv_eq : context.venv = env + lparams_eq : context.lparams = Us + vlctx_eq : context.vlctx = Δ + state_wf : VState.WF context {} + lhs_tr : TrExprS env Us Δ lhs lhs' + rhs_tr : TrExprS env Us Δ rhs rhs' + recursionFuel : Nat + run_eq : ∃ state : State, + Inner.isDefEq lhs rhs (Methods.withFuel recursionFuel) + context.toContext ({} : State) = .ok (true, state) + +/-- Convert the retained candidate equality observation to a state-bearing +Verify certificate. -/ +def IsDefEqRun.ofCandidateStep + (step : AddInductive.CandidateIsDefEqStep) + (hvalid : step.Valid) + (context : VContext) + (context_eq : context.toContext = step.context.toTypeChecker) + (venv_eq : context.venv = env) + (lparams_eq : context.lparams = Us) + (vlctx_eq : context.vlctx = Δ) + (state_wf : VState.WF context {}) + (lhs_tr : TrExprS env Us Δ step.lhs lhs') + (rhs_tr : TrExprS env Us Δ step.rhs rhs') + (recursionFuel : Nat) + (hdepth : step.context.fuel.recDepth = recursionFuel) : + IsDefEqRun env Us Δ step.lhs step.rhs lhs' rhs' where + context := context + venv_eq := venv_eq + lparams_eq := lparams_eq + vlctx_eq := vlctx_eq + state_wf := state_wf + lhs_tr := lhs_tr + rhs_tr := rhs_tr + recursionFuel := recursionFuel + run_eq := by + rw [context_eq] + exact step.innerRun recursionFuel hdepth hvalid + +/-- A successful verified equality run supplies ordinary Theory +definitional equality. -/ +theorem IsDefEqRun.isDefEqU + (run : IsDefEqRun env Us Δ lhs rhs lhs' rhs') : + env.IsDefEqU Us.length Δ.toCtx lhs' rhs' := by + have hlhs : run.context.TrExprS lhs lhs' := by + simpa only [VContext.TrExprS, run.venv_eq, run.lparams_eq, + run.vlctx_eq] using run.lhs_tr + have hrhs : run.context.TrExprS rhs rhs' := by + simpa only [VContext.TrExprS, run.venv_eq, run.lparams_eq, + run.vlctx_eq] using run.rhs_tr + obtain ⟨state, hrun⟩ := run.run_eq + obtain ⟨_, _, _, _, hdefeq⟩ := + (TypeChecker.Inner.isDefEq.WF hlhs hrhs + (Methods.withFuel run.recursionFuel) Methods.withFuel.WF) + run.state_wf true state hrun + simpa only [VContext.IsDefEqU, run.venv_eq, run.lparams_eq, + run.vlctx_eq] using hdefeq (by simp) + +/-- Consuming a certified annotation path cannot introduce a free variable or +level metavariable. -/ +theorem candidateTypeAnnotation_fvarsIn + (trace : AddInductive.CandidateTypeAnnotationTrace source consumed) + (h : source.FVarsIn fvars) : consumed.FVarsIn fvars := by + induction trace with + | identity => exact h + | outParam _ _ _ ih => exact ih h.2 + | semiOutParam _ _ _ ih => exact ih h.2 + | optParam _ _ _ _ ih => exact ih h.1.2 + | autoParam _ _ _ _ ih => exact ih h.1.2 + +/-- Extract a strict translation of the consumed annotation argument from the +strict translation of the raw wrapper application. -/ +theorem candidateTypeAnnotation_exists_translation + (trace : AddInductive.CandidateTypeAnnotationTrace source consumed) + (source_tr : TrExprS env Us Δ source source') : + ∃ consumed', TrExprS env Us Δ consumed consumed' := by + induction trace generalizing source' with + | identity => exact ⟨source', source_tr⟩ + | outParam _ _ _ ih => + let .app _ _ _ type_tr := source_tr + exact ih type_tr + | semiOutParam _ _ _ ih => + let .app _ _ _ type_tr := source_tr + exact ih type_tr + | optParam _ _ _ _ ih => + let .app _ _ fn_tr _ := source_tr + let .app _ _ _ type_tr := fn_tr + exact ih type_tr + | autoParam _ _ _ _ ih => + let .app _ _ fn_tr _ := source_tr + let .app _ _ _ type_tr := fn_tr + exact ih type_tr + +/-- The empty executable checker state is well formed for any verified +context whose free-variable names are already reserved by the kernel name +generator. `VState.WF.empty` is the empty-local-context specialization; +candidate normalization needs this slightly more general form after entering +raw Pi binders. -/ +theorem VState.WF.empty_of_reserves + (context : VContext) + (reserved : ∀ fv ∈ context.vlctx.fvars, + (({} : VState).ngen).Reserves fv) : + VState.WF context {} where + trctx := context.trlctx + ngen_wf := reserved + ectx := ⟨context.vlctx, .refl, context.Δwf, .refl, .empty, reserved⟩ + inferTypeI_wf := .empty + inferTypeC_wf := .empty + whnfCore_wf := .empty + whnf_wf := .empty + unfold_wf _ := by simp + +/-- Positional verified context for an executable normalization candidate. + +The equality pins every checker-visible field (environment, local context, +safety, level parameters, and fuel) to the `AddInductive.Context` retained by +the candidate trace. The state certificate is kept with it because every +retained full-check and WHNF observation starts from the empty checker state. -/ +structure CandidateContextRun + (candidateContext : AddInductive.Context) where + context : VContext + context_eq : context.toContext = candidateContext.toTypeChecker + state_wf : VState.WF context {} + namePrefix_ne : candidateContext.ngen.namePrefix ≠ + (({} : VState).ngen).namePrefix + +/-- Candidate binders and the kernel checker's own temporary names use +different prefixes, so every candidate binder is reserved by a freshly +initialized kernel checker state. -/ +theorem candidateFreshFVarId_reserved + (candidateContext : AddInductive.Context) + (namePrefix_ne : candidateContext.ngen.namePrefix ≠ + (({} : VState).ngen).namePrefix) : + (({} : VState).ngen).Reserves candidateContext.freshFVarId := by + simp [NameGenerator.Reserves, AddInductive.Context.freshFVarId] + intro i h + apply namePrefix_ne + simpa only [NameGenerator.curr, Name.getPrefix] using + congrArg Name.getPrefix h + +/-- Package an already verified checker context at a candidate position. -/ +def CandidateContextRun.ofVContext + (candidateContext : AddInductive.Context) + (context : VContext) + (context_eq : context.toContext = candidateContext.toTypeChecker) + (state_wf : VState.WF context {}) + (namePrefix_ne : candidateContext.ngen.namePrefix ≠ + (({} : VState).ngen).namePrefix) : + CandidateContextRun candidateContext := + ⟨context, context_eq, state_wf, namePrefix_ne⟩ + +/-- Construct the root certificate used by family and constructor candidates. +Their candidate traversal deliberately resets the local context to empty. -/ +def CandidateContextRun.root + {ves : VEnvs} (wf : ves.WF candidateContext.env) + (lctx_eq : candidateContext.lctx = {}) + (namePrefix_ne : candidateContext.ngen.namePrefix ≠ + (({} : VState).ngen).namePrefix) : + CandidateContextRun candidateContext := by + let context := VContext.mk' wf candidateContext.safety + candidateContext.lparams candidateContext.fuel + refine ⟨context, ?_, ?_, namePrefix_ne⟩ + · simp [context, VContext.mk', MLCtx.lctx, + AddInductive.Context.toTypeChecker, lctx_eq] + · exact VState.WF.empty + +@[simp] theorem CandidateContextRun.context_env + (run : CandidateContextRun candidateContext) : + run.context.env = candidateContext.env := by + have h := congrArg (fun c : TypeChecker.Context => c.env) run.context_eq + simpa only [AddInductive.Context.toTypeChecker] using h + +@[simp] theorem CandidateContextRun.context_lctx + (run : CandidateContextRun candidateContext) : + run.context.lctx = candidateContext.lctx := by + have h := congrArg (fun c : TypeChecker.Context => c.lctx) run.context_eq + simpa only [AddInductive.Context.toTypeChecker] using h + +@[simp] theorem CandidateContextRun.context_safety + (run : CandidateContextRun candidateContext) : + run.context.safety = candidateContext.safety := by + have h := congrArg (fun c : TypeChecker.Context => c.safety) run.context_eq + simpa only [AddInductive.Context.toTypeChecker] using h + +@[simp] theorem CandidateContextRun.context_lparams + (run : CandidateContextRun candidateContext) : + run.context.lparams = candidateContext.lparams := by + have h := congrArg (fun c : TypeChecker.Context => c.lparams) run.context_eq + simpa only [AddInductive.Context.toTypeChecker] using h + +@[simp] theorem CandidateContextRun.context_fuel + (run : CandidateContextRun candidateContext) : + run.context.fuel = candidateContext.fuel := by + have h := congrArg (fun c : TypeChecker.Context => c.fuel) run.context_eq + simpa only [AddInductive.Context.toTypeChecker] using h + +/-- Extend a verified candidate context by precisely the raw local declaration +used by `AddInductive.Context.pushLocalDecl`. + +The caller supplies the strict Theory translation and typing of the *stored* +local-domain expression. Freshness comes from the trace index; reservation is +the independent fact needed to restart each retained checker observation from +the empty kernel checker state. -/ +def CandidateContextRun.pushLocalDecl + (run : CandidateContextRun candidateContext) + (name : Name) (binderInfo : BinderInfo) (domain : Expr) + (fresh : candidateContext.lctx.find? + candidateContext.freshFVarId = none) + (domain' : VExpr) + (domain_tr : run.context.TrExprS domain domain') + (domain_type : run.context.IsType domain') : + CandidateContextRun + (candidateContext.pushLocalDecl name binderInfo domain) := by + let mlctx := run.context.mlctx.vlam candidateContext.freshFVarId + name domain domain' binderInfo + have lctx_eq : run.context.mlctx.lctx = candidateContext.lctx := by + calc + run.context.mlctx.lctx = run.context.lctx := run.context.lctx_eq + _ = candidateContext.lctx := by + have h := congrArg (fun c : TypeChecker.Context => c.lctx) + run.context_eq + simpa [AddInductive.Context.toTypeChecker] using h + have fresh' : run.context.mlctx.lctx.find? + candidateContext.freshFVarId = none := by + rw [lctx_eq] + exact fresh + have mlctx_wf : mlctx.WF run.context.venv run.context.lparams := + ⟨run.context.mlctx_wf, fresh', domain_tr, domain_type⟩ + let context := run.context.withMLC mlctx (wf := ⟨mlctx_wf⟩) + have context_eq : context.toContext = + (candidateContext.pushLocalDecl name binderInfo domain).toTypeChecker := by + change { run.context.toContext with + lctx := run.context.mlctx.lctx.mkLocalDecl + candidateContext.freshFVarId name domain binderInfo } = _ + rw [run.context_eq, lctx_eq] + rfl + refine ⟨context, context_eq, VState.WF.empty_of_reserves context ?_, ?_⟩ + intro fv hfv + change fv ∈ candidateContext.freshFVarId :: + run.context.vlctx.fvars at hfv + simp only [List.mem_cons] at hfv + rcases hfv with rfl | hfv + · exact candidateFreshFVarId_reserved candidateContext run.namePrefix_ne + · exact run.state_wf.ngen_wf fv hfv + simpa [AddInductive.Context.pushLocalDecl, NameGenerator.next] using + run.namePrefix_ne + +@[simp] theorem CandidateContextRun.pushLocalDecl_venv + (run : CandidateContextRun candidateContext) + (domain_tr : run.context.TrExprS domain domain') + (domain_type : run.context.IsType domain') : + (run.pushLocalDecl name binderInfo domain fresh domain' domain_tr + domain_type).context.venv = run.context.venv := by + simp [CandidateContextRun.pushLocalDecl, VContext.withMLC] + +@[simp] theorem CandidateContextRun.pushLocalDecl_lparams + (run : CandidateContextRun candidateContext) + (domain_tr : run.context.TrExprS domain domain') + (domain_type : run.context.IsType domain') : + (run.pushLocalDecl name binderInfo domain fresh domain' domain_tr + domain_type).context.lparams = run.context.lparams := by + simp [CandidateContextRun.pushLocalDecl, VContext.withMLC] + +@[simp] theorem CandidateContextRun.pushLocalDecl_vlctx + (run : CandidateContextRun candidateContext) + (domain_tr : run.context.TrExprS domain domain') + (domain_type : run.context.IsType domain') : + (run.pushLocalDecl name binderInfo domain fresh domain' domain_tr + domain_type).context.vlctx = + (some (candidateContext.freshFVarId, domain.fvarsList), + .vlam domain') :: run.context.vlctx := by + simp [CandidateContextRun.pushLocalDecl, VContext.withMLC] + /-- The two exact verifier runs attached to one retained candidate node. The indices force both runs to use the node's kernel source and observed @@ -405,6 +853,38 @@ theorem CandidateNodeRun.exists_ofCandidate (result_tr.trExpr context.Ewf context.Δwf) checkFuel whnfFuel checkDepth whnfDepth +/-- Construct a paired candidate node with a caller-selected Theory endpoint +for the retained WHNF result. The exact full-check execution still selects +and strictly translates its inferred type; only the already translated WHNF +endpoint is fixed by the caller. -/ +theorem CandidateNodeRun.exists_ofCandidateAtResult + (candidateContext : AddInductive.Context) + (source inferred result : Expr) + (checked : AddInductive.CandidateCheckTypeStep.Valid + ⟨candidateContext, source, inferred⟩) + (normalized : AddInductive.CandidateWhnfStep.Valid + ⟨candidateContext, source, result⟩) + (context : VContext) + (context_eq : context.toContext = candidateContext.toTypeChecker) + (state_wf : VState.WF context {}) + (source' result' : VExpr) + (source_tr : context.TrExprS source source') + (result_tr : context.TrExpr result result') + (checkFuel whnfFuel : Nat) + (checkDepth : candidateContext.fuel.recDepth = checkFuel) + (whnfDepth : candidateContext.fuel.recDepth = whnfFuel + 1) : + ∃ inferred', Nonempty + (CandidateNodeRun context.venv context.lparams context.vlctx + candidateContext source inferred result source' result' inferred') := by + obtain ⟨_, inferred', _, inferred_tr, _⟩ := + candidateCheckTypeStep_exists_translation + ⟨candidateContext, source, inferred⟩ checked + context context_eq state_wf source_tr.fvarsIn checkFuel checkDepth + exact ⟨inferred', ⟨CandidateNodeRun.ofCandidate + candidateContext source inferred result checked normalized + context context_eq rfl rfl rfl state_wf source_tr inferred_tr + result_tr checkFuel whnfFuel checkDepth whnfDepth⟩⟩ + /-- Compositional evidence for a normalization comparison. Leaves are either reflexive, already typed syntax or exact verified WHNF @@ -434,6 +914,8 @@ inductive DefEqEvidence (env : VEnv) : (type : env.IsDefEq U Γ A B (.sort u)) (term : DefEqEvidence env U Γ lhs rhs A) : DefEqEvidence env U Γ lhs rhs B + | ofDefEq (proof : env.IsDefEq U Γ lhs rhs A) : + DefEqEvidence env U Γ lhs rhs A | forallE (domain : DefEqEvidence env U Γ A A' (.sort u)) (body : DefEqEvidence env U (A :: Γ) B B' (.sort v)) : @@ -451,6 +933,7 @@ theorem DefEqEvidence.isDefEq : | .beta body arg => .beta body arg | .trans left right => .trans left.isDefEq right.isDefEq | .change type term => .defeqDF type term.isDefEq + | .ofDefEq proof => proof | .forallE domain body => .forallEDF domain.isDefEq body.isDefEq @@ -463,12 +946,10 @@ def CandidateNodeRun.evidence /-- Recursive semantic interpretation of a source-indexed candidate trace. -For a terminal node the exact full-check/WHNF pair is sufficient. For an -exposed Pi, the root WHNF reaches the raw Pi, while recursively interpreted -domain and instantiated-body traces provide congruence from that raw Pi to -the candidate view. The body context equation makes the raw-binder discipline -explicit and prevents evidence checked under a different telescope from being -reused here. -/ +At a Pi node the raw domain and the annotation-consumed local domain may have +different strict Theory translations. The retained equality run relates them; +the body is checked in the consumed-domain context and transported back to the +raw Pi context only when forming congruence evidence. -/ inductive CandidateExprRun (env : VEnv) (Us : List Name) : {candidateContext : AddInductive.Context} → {source : Expr} → AddInductive.CandidateExprTrace candidateContext source → @@ -480,30 +961,330 @@ inductive CandidateExprRun (env : VEnv) (Us : List Name) : (.terminal context source inferred result checked normalized) Δ source' result' inferred' | forallE + (annotations : AddInductive.CandidateTypeAnnotations domain) + (annotationsEq : AddInductive.CandidateIsDefEqStep.Valid + ⟨context, domain, annotations.consumed⟩) (domainCandidate : AddInductive.CandidateExprTrace context domain) (bodyCandidate : AddInductive.CandidateExprTrace - (context.pushLocalDecl name binderInfo domain.consumeTypeAnnotations) + (context.pushLocalDecl name binderInfo annotations.consumed) (body.instantiate1 context.freshExpr)) (node : CandidateNodeRun env Us Δ context source inferred (.forallE name domain body binderInfo) source' (.forallE domain' body') inferred') (domainRun : CandidateExprRun env Us domainCandidate Δ domain' domainView' domainInferred') + (annotationsRun : IsDefEqRun env Us Δ + domain annotations.consumed domain' storedDomain') (bodyRun : CandidateExprRun env Us bodyCandidate bodyΔ - body' bodyView' bodyInferred') + storedBody' bodyView' bodyInferred') (domainType : env.HasType Us.length Δ.toCtx domain' (.sort u)) (bodyType : env.HasType Us.length (domain' :: Δ.toCtx) body' (.sort v)) + (bodySource : env.IsDefEq Us.length (domain' :: Δ.toCtx) + body' storedBody' (.sort v)) (bodyContext : bodyΔ = - (some (context.freshFVarId, - domain.consumeTypeAnnotations.fvarsList), - .vlam domain') :: Δ) : + (some (context.freshFVarId, annotations.consumed.fvarsList), + .vlam storedDomain') :: Δ) : CandidateExprRun env Us - (.forallE context source inferred name domain body binderInfo - checked normalized domainCandidate bodyCandidate) + (.forallE context source inferred name domain body binderInfo fresh + annotations annotationsEq checked normalized + domainCandidate bodyCandidate) Δ source' (.forallE domainView' bodyView') inferred' +/-- Structural witness that a retained candidate trace is syntactically +identity-normalizing at every inspected node. + +The witness is deliberately recursive rather than a single root equality: +generation consumes the exposed Pi spine positionally. At Pi nodes it also +records that annotation processing kept the binder domain unchanged. -/ +inductive CandidateExprIdentity : + {candidateContext : AddInductive.Context} → {source : Expr} → + AddInductive.CandidateExprTrace candidateContext source → Prop where + | terminal + (result_eq : result = source) : + CandidateExprIdentity + (.terminal context source inferred result checked normalized) + | forallE + (domainCandidate : AddInductive.CandidateExprTrace context domain) + (bodyCandidate : AddInductive.CandidateExprTrace + (context.pushLocalDecl name binderInfo annotations.consumed) + (body.instantiate1 context.freshExpr)) + (source_eq : source = .forallE name domain body binderInfo) + (consumed_eq : annotations.consumed = domain) + (domainIdentity : CandidateExprIdentity domainCandidate) + (bodyIdentity : CandidateExprIdentity bodyCandidate) : + CandidateExprIdentity + (.forallE context source inferred name domain body binderInfo fresh + annotations annotationsEq checked normalized + domainCandidate bodyCandidate) + +/-- An identity-normalizing trace necessarily preserves the stored main Pi +spine. This turns the recursive identity witness into the Boolean gate used +by the generation assembler. -/ +theorem CandidateExprIdentity.storedSpine + {trace : AddInductive.CandidateExprTrace candidateContext source} + (identity : CandidateExprIdentity trace) : + trace.storedSpine = true := by + induction identity with + | terminal => rfl + | forallE _ _ source_eq _ _ _ _ bodyIH => + simp [AddInductive.CandidateExprTrace.storedSpine, + source_eq, bodyIH] + +/-- Exact component inversion for a strict translation of a kernel Pi. -/ +theorem TrExprS.forallE_components + (run : TrExprS env Us Δ (.forallE name domain body binderInfo) source') : + ∃ domain' body', + source' = .forallE domain' body' ∧ + env.IsType Us.length Δ.toCtx domain' ∧ + env.IsType Us.length (domain' :: Δ.toCtx) body' ∧ + TrExprS env Us Δ domain domain' ∧ + TrExprS env Us ((none, .vlam domain') :: Δ) body body' := by + cases run with + | forallE domainType bodyType domain_tr body_tr => + exact ⟨_, _, rfl, domainType, bodyType, domain_tr, body_tr⟩ + +/-- Recursively turn every retained candidate observation into verified +normalization evidence, constructing and transporting the exact verified +binder context at each Pi node. -/ +theorem CandidateExprRun.exists_ofCandidate + (trace : AddInductive.CandidateExprTrace candidateContext source) + (candidateRun : CandidateContextRun candidateContext) + (source' : VExpr) + (source_tr : candidateRun.context.TrExprS source source') + (whnfFuel : Nat) + (whnfDepth : candidateContext.fuel.recDepth = whnfFuel + 1) : + ∃ view' inferred', + Nonempty (CandidateExprRun candidateRun.context.venv + candidateRun.context.lparams trace candidateRun.context.vlctx + source' view' inferred') := by + induction trace generalizing source' with + | terminal context source inferred result checked normalized => + obtain ⟨inferred', result', _, _, ⟨node⟩⟩ := + CandidateNodeRun.exists_ofCandidate context source inferred result + checked normalized candidateRun.context candidateRun.context_eq + candidateRun.state_wf source' source_tr + context.fuel.recDepth whnfFuel rfl whnfDepth + exact ⟨result', inferred', ⟨.terminal node⟩⟩ + | forallE context source inferred name domain body binderInfo fresh + annotations annotationsEq checked normalized + domainCandidate bodyCandidate domainIH bodyIH => + obtain ⟨inferred', result', _, result_tr, ⟨node⟩⟩ := + CandidateNodeRun.exists_ofCandidate context source inferred + (.forallE name domain body binderInfo) checked normalized + candidateRun.context candidateRun.context_eq candidateRun.state_wf + source' source_tr context.fuel.recDepth whnfFuel rfl whnfDepth + let .forallE domainType bodyType domain_tr body_tr := result_tr + obtain ⟨u, domainTypeHasType⟩ := domainType + obtain ⟨v, bodyTypeHasType⟩ := bodyType + obtain ⟨domainView', domainInferred', ⟨domainRun⟩⟩ := + domainIH candidateRun _ domain_tr whnfDepth + obtain ⟨storedDomain', storedDomain_tr⟩ := + candidateTypeAnnotation_exists_translation annotations.trace domain_tr + let annotationsRun := IsDefEqRun.ofCandidateStep + ⟨context, domain, annotations.consumed⟩ annotationsEq + candidateRun.context candidateRun.context_eq rfl rfl rfl + candidateRun.state_wf domain_tr storedDomain_tr + context.fuel.recDepth rfl + have henv : VEnv.WF candidateRun.context.venv := + candidateRun.context.Ewf + have hΔ : OnCtx candidateRun.context.vlctx.toCtx + (candidateRun.context.venv.IsType + candidateRun.context.lparams.length) := + candidateRun.context.Δwf.toCtx + have annotationDef := + annotationsRun.isDefEqU.of_l henv hΔ domainTypeHasType + let bodyCandidateRun := candidateRun.pushLocalDecl name binderInfo + annotations.consumed fresh storedDomain' storedDomain_tr + ⟨u, annotationDef.hasType.2⟩ + have bodyVenv : bodyCandidateRun.context.venv = + candidateRun.context.venv := by simp [bodyCandidateRun] + have bodyLparams : bodyCandidateRun.context.lparams = + candidateRun.context.lparams := by + simp [bodyCandidateRun, AddInductive.Context.pushLocalDecl] + have bodyVlctx : bodyCandidateRun.context.vlctx = + (some (context.freshFVarId, annotations.consumed.fvarsList), + .vlam storedDomain') :: candidateRun.context.vlctx := by + simp [bodyCandidateRun] + have bodyDepth : + (context.pushLocalDecl name binderInfo + annotations.consumed).fuel.recDepth = whnfFuel + 1 := by + simpa [AddInductive.Context.pushLocalDecl] using whnfDepth + have domainContext : VLCtx.IsDefEq + candidateRun.context.venv candidateRun.context.lparams.length + ((none, .vlam _) :: candidateRun.context.vlctx) + ((none, .vlam storedDomain') :: candidateRun.context.vlctx) := + .cons (.refl henv candidateRun.context.Δwf) (by nofun) + (.vlam annotationDef) + obtain ⟨storedBody', storedBody_tr⟩ := + body_tr.defeqDFC henv domainContext + have hRawBody : OnCtx + (_ :: candidateRun.context.vlctx.toCtx) + (candidateRun.context.venv.IsType + candidateRun.context.lparams.length) := + ⟨hΔ, ⟨u, domainTypeHasType⟩⟩ + have bodySource := + (body_tr.uniq henv domainContext storedBody_tr).of_l + henv hRawBody bodyTypeHasType + have bodyΔwf := bodyCandidateRun.context.Δwf + rw [bodyVenv, bodyLparams, bodyVlctx] at bodyΔwf + have instantiatedBody_tr := + storedBody_tr.inst_fvar henv.ordered bodyΔwf + obtain ⟨bodyView', bodyInferred', ⟨bodyRun⟩⟩ := + bodyIH bodyCandidateRun _ (by + change TrExprS bodyCandidateRun.context.venv + bodyCandidateRun.context.lparams bodyCandidateRun.context.vlctx + (body.instantiate1 context.freshExpr) _ + rw [bodyVenv, bodyLparams, bodyVlctx] + simpa only [AddInductive.Context.freshExpr, + Expr.instantiate1_eq] using instantiatedBody_tr) + bodyDepth + refine ⟨.forallE domainView' bodyView', inferred', ⟨?_⟩⟩ + exact .forallE annotations annotationsEq domainCandidate bodyCandidate node + domainRun annotationsRun bodyRun domainTypeHasType bodyTypeHasType + bodySource bodyVlctx + +/-- Interpret a recursively identity-normalizing candidate at the exact +strict Theory translation of its source. + +Unlike `exists_ofCandidate`, whose verified executions select an existential +Theory endpoint, this theorem retains `source'` as the endpoint at every +recursive position. That stronger conclusion is what the generation spine +assembler needs for declarations whose executable normalization is +syntactically the identity. -/ +theorem CandidateExprRun.exists_ofIdentity + (trace : AddInductive.CandidateExprTrace candidateContext source) + (identity : CandidateExprIdentity trace) + (candidateRun : CandidateContextRun candidateContext) + (source' : VExpr) + (source_tr : candidateRun.context.TrExprS source source') + (whnfFuel : Nat) + (whnfDepth : candidateContext.fuel.recDepth = whnfFuel + 1) : + ∃ inferred', Nonempty + (CandidateExprRun candidateRun.context.venv + candidateRun.context.lparams trace candidateRun.context.vlctx + source' source' inferred') := by + induction identity generalizing source' with + | @terminal result source context inferred checked normalized result_eq => + subst result + have result_tr : candidateRun.context.TrExpr source source' := + source_tr.trExpr candidateRun.context.Ewf candidateRun.context.Δwf + obtain ⟨inferred', ⟨node⟩⟩ := + CandidateNodeRun.exists_ofCandidateAtResult + context source inferred source checked normalized + candidateRun.context candidateRun.context_eq candidateRun.state_wf + source' source' source_tr result_tr + context.fuel.recDepth whnfFuel rfl whnfDepth + exact ⟨inferred', ⟨.terminal node⟩⟩ + | @forallE context domain name binderInfo source inferred body fresh + annotations annotationsEq checked normalized domainCandidate + bodyCandidate source_eq consumed_eq domainIdentity bodyIdentity + domainIH bodyIH => + subst source + obtain ⟨domain', body', rfl, domainWF, bodyWF, domain_tr, body_tr⟩ := + TypeChecker.TrExprS.forallE_components source_tr + obtain ⟨u, domainType⟩ := domainWF + obtain ⟨v, bodyType⟩ := bodyWF + have result_tr : candidateRun.context.TrExpr + (.forallE name domain body binderInfo) + (.forallE domain' body') := + source_tr.trExpr candidateRun.context.Ewf candidateRun.context.Δwf + obtain ⟨inferred', ⟨node⟩⟩ := + CandidateNodeRun.exists_ofCandidateAtResult + context (.forallE name domain body binderInfo) inferred + (.forallE name domain body binderInfo) checked normalized + candidateRun.context candidateRun.context_eq candidateRun.state_wf + (.forallE domain' body') (.forallE domain' body') + source_tr result_tr + context.fuel.recDepth whnfFuel rfl whnfDepth + obtain ⟨domainInferred', ⟨domainRun⟩⟩ := + domainIH candidateRun domain' domain_tr whnfDepth + have consumed_tr : candidateRun.context.TrExprS + annotations.consumed domain' := by + rw [consumed_eq] + exact domain_tr + let annotationsRun := IsDefEqRun.ofCandidateStep + ⟨context, domain, annotations.consumed⟩ annotationsEq + candidateRun.context candidateRun.context_eq rfl rfl rfl + candidateRun.state_wf domain_tr consumed_tr + context.fuel.recDepth rfl + let bodyCandidateRun := candidateRun.pushLocalDecl name binderInfo + annotations.consumed fresh domain' consumed_tr ⟨u, domainType⟩ + have bodyVenv : bodyCandidateRun.context.venv = + candidateRun.context.venv := by simp [bodyCandidateRun] + have bodyLparams : bodyCandidateRun.context.lparams = + candidateRun.context.lparams := by + simp [bodyCandidateRun, AddInductive.Context.pushLocalDecl] + have bodyVlctx : bodyCandidateRun.context.vlctx = + (some (context.freshFVarId, annotations.consumed.fvarsList), + .vlam domain') :: candidateRun.context.vlctx := by + simp [bodyCandidateRun] + have bodyDepth : + (context.pushLocalDecl name binderInfo + annotations.consumed).fuel.recDepth = + whnfFuel + 1 := by + simpa [AddInductive.Context.pushLocalDecl] using whnfDepth + have bodyDeltaWF := bodyCandidateRun.context.Δwf + rw [bodyVenv, bodyLparams, bodyVlctx] at bodyDeltaWF + have instantiatedBody_tr := + body_tr.inst_fvar candidateRun.context.Ewf.ordered + bodyDeltaWF + obtain ⟨bodyInferred', ⟨bodyRun⟩⟩ := + bodyIH bodyCandidateRun body' (by + change TrExprS bodyCandidateRun.context.venv + bodyCandidateRun.context.lparams bodyCandidateRun.context.vlctx + (body.instantiate1 context.freshExpr) body' + rw [bodyVenv, bodyLparams, bodyVlctx] + simpa only [AddInductive.Context.freshExpr, + Expr.instantiate1_eq] using instantiatedBody_tr) + bodyDepth + refine ⟨inferred', ⟨?_⟩⟩ + exact .forallE annotations annotationsEq domainCandidate bodyCandidate + node domainRun annotationsRun bodyRun domainType bodyType bodyType rfl + +/-- Recover a trace root's strict source translation from its retained full +check. Unlike recursive child nodes, whose source translations are obtained +from the parent Pi translation, a root needs only the checker's syntactic +free-variable premise. -/ +theorem candidateExprTrace_exists_source_translation + (trace : AddInductive.CandidateExprTrace candidateContext source) + (candidateRun : CandidateContextRun candidateContext) + (source_fvars : + source.FVarsIn (· ∈ candidateRun.context.vlctx.fvars)) : + ∃ source', candidateRun.context.TrExprS source source' := by + let checked := trace.rootCheck + obtain ⟨source', _, source_tr, _, _⟩ := + candidateCheckTypeStep_exists_translation + ⟨candidateContext, source, checked.inferred⟩ checked.valid + candidateRun.context candidateRun.context_eq candidateRun.state_wf + source_fvars candidateContext.fuel.recDepth rfl + exact ⟨source', source_tr⟩ + +/-- Recursively certify an annotation-complete candidate trace without asking +the caller for any Theory expression. The retained root full check chooses the +source translation; all output and child translations then come from verified +checker executions, structural annotation traces, and Pi decomposition. -/ +theorem CandidateExprRun.exists_ofCandidateFVars + (trace : AddInductive.CandidateExprTrace candidateContext source) + (candidateRun : CandidateContextRun candidateContext) + (source_fvars : + source.FVarsIn (· ∈ candidateRun.context.vlctx.fvars)) + (whnfFuel : Nat) + (whnfDepth : candidateContext.fuel.recDepth = whnfFuel + 1) : + ∃ source' view' inferred', + candidateRun.context.TrExprS source source' ∧ + Nonempty (CandidateExprRun candidateRun.context.venv + candidateRun.context.lparams trace candidateRun.context.vlctx + source' view' inferred') := by + obtain ⟨source', source_tr⟩ := + candidateExprTrace_exists_source_translation trace candidateRun + source_fvars + obtain ⟨view', inferred', run⟩ := + CandidateExprRun.exists_ofCandidate trace candidateRun source' + source_tr whnfFuel whnfDepth + exact ⟨source', view', inferred', source_tr, run⟩ + /-- Fold a complete candidate trace into the compositional equality language consumed by `NormalizationRun` and `GenerationRun`. -/ def CandidateExprRun.evidence @@ -514,29 +1295,43 @@ def CandidateExprRun.evidence CandidateExprRun env Us trace Δ source' view' inferred' → DefEqEvidence env Us.length Δ.toCtx source' view' inferred' | .terminal node => node.evidence - | .forallE _ _ node domainRun bodyRun domainType bodyType bodyContext => by + | .forallE _ _ _ _ node domainRun annotationsRun bodyRun domainType + bodyType bodySource bodyContext => by have henv : VEnv.WF env := by simpa only [node.check.venv_eq] using node.check.context.Ewf - have hΓ : OnCtx Δ.toCtx (env.IsType Us.length) := by + have hΔ : VLCtx.WF env Us.length Δ := by simpa only [node.check.venv_eq, node.check.lparams_eq, - node.check.vlctx_eq] using node.check.context.Δwf.toCtx + node.check.vlctx_eq] using node.check.context.Δwf + have hΓ : OnCtx Δ.toCtx (env.IsType Us.length) := hΔ.toCtx have domainEvidence := domainRun.evidence obtain ⟨_, domainTypeEq⟩ := domainType.uniq henv hΓ domainEvidence.isDefEq have domainAtSort : DefEqEvidence env Us.length Δ.toCtx _ _ (.sort _) := .change domainTypeEq.symm domainEvidence + have annotationDef := + annotationsRun.isDefEqU.of_l henv hΓ domainType + have domainContext : VLCtx.IsDefEq env Us.length + ((none, .vlam _) :: Δ) ((none, .vlam _) :: Δ) := + .cons (.refl henv hΔ) (by nofun) (.vlam annotationDef) have bodyEvidence := bodyRun.evidence rw [bodyContext] at bodyEvidence simp only [VLCtx.toCtx] at bodyEvidence + have bodyStoredType := + bodySource.hasType.2.defeqDFC henv domainContext.defeqCtx have hBodyΓ : OnCtx (_ :: Δ.toCtx) (env.IsType Us.length) := - ⟨hΓ, ⟨_, domainType⟩⟩ + ⟨hΓ, ⟨_, annotationDef.hasType.2⟩⟩ obtain ⟨_, bodyTypeEq⟩ := - bodyType.uniq henv hBodyΓ bodyEvidence.isDefEq - have bodyAtSort : DefEqEvidence env Us.length + bodyStoredType.uniq henv hBodyΓ bodyEvidence.isDefEq + have bodyAtSortStored : DefEqEvidence env Us.length (_ :: Δ.toCtx) _ _ (.sort _) := .change bodyTypeEq.symm bodyEvidence - have piEvidence := DefEqEvidence.forallE domainAtSort bodyAtSort + have bodyAtSortRaw := + bodyAtSortStored.isDefEq.defeqDFC henv + (domainContext.symm henv).defeqCtx + have bodyFinal := bodySource.trans bodyAtSortRaw + have piEvidence := DefEqEvidence.forallE domainAtSort + (DefEqEvidence.ofDefEq bodyFinal) obtain ⟨_, nodeTypeEq⟩ := node.evidence.isDefEq.uniq henv hΓ (domainType.forallE bodyType) exact .trans node.evidence (.change nodeTypeEq.symm piEvidence) @@ -552,7 +1347,7 @@ theorem CandidateExprRun.source_tr TrExprS env Us Δ source source' := by cases run with | terminal node => exact node.check.expr_tr - | forallE _ _ node => exact node.check.expr_tr + | forallE _ _ _ _ node => exact node.check.expr_tr /-- Move a weak expression translation between definitionally equal verified local contexts while retaining its named Theory meaning. -/ @@ -584,11 +1379,12 @@ theorem CandidateExprRun.view_tr TrExpr env Us Δ trace.view view' := by induction run with | terminal node => exact node.whnf.rhs_tr - | @forallE context domain name binderInfo Δ source inferred body - source' domain' body' inferred' domainView' domainInferred' bodyΔ - bodyView' bodyInferred' u v - checked normalized domainCandidate bodyCandidate node domainRun bodyRun - domainType bodyType bodyContext domainIH bodyIH => + | @forallE domain context name binderInfo Δ source inferred body + source' domain' body' inferred' domainView' domainInferred' + storedDomain' bodyΔ storedBody' bodyView' bodyInferred' u v fresh + checked normalized annotations annotationsEq domainCandidate + bodyCandidate node domainRun annotationsRun bodyRun domainType bodyType + bodySource bodyContext domainIH bodyIH => have henv : VEnv.WF env := by simpa only [node.check.venv_eq] using node.check.context.Ewf have hΔ : VLCtx.WF env Us.length Δ := by @@ -599,30 +1395,42 @@ theorem CandidateExprRun.view_tr have domainDef : env.IsDefEq Us.length Δ.toCtx domain' domainView' (.sort u) := (DefEqEvidence.change domainTypeEq.symm domainRun.evidence).isDefEq + have annotationDef := + annotationsRun.isDefEqU.of_l henv hΔ.toCtx domainType + have storedToView : env.IsDefEq Us.length Δ.toCtx + storedDomain' domainView' (.sort u) := + annotationDef.symm.trans domainDef have bodyIH' : TrExpr env Us ((some (context.freshFVarId, - domain.consumeTypeAnnotations.fvarsList), .vlam domain') :: Δ) + annotations.consumed.fvarsList), .vlam storedDomain') :: Δ) bodyCandidate.view bodyView' := by simpa only [bodyContext] using bodyIH have bodyAbstract := bodyIH'.abstract VLCtx.Abstract.zero have hctx : VLCtx.IsDefEq env Us.length - ((none, .vlam domain') :: Δ) + ((none, .vlam storedDomain') :: Δ) ((none, .vlam domainView') :: Δ) := .cons (.refl henv hΔ) (by nofun) - (.vlam domainDef) + (.vlam storedToView) have bodyMoved := candidateTrExpr_moveCtx henv hctx bodyAbstract have bodyEvidence := bodyRun.evidence rw [bodyContext] at bodyEvidence simp only [VLCtx.toCtx] at bodyEvidence - have hBodyΓ : OnCtx (domain' :: Δ.toCtx) - (env.IsType Us.length) := ⟨hΔ.toCtx, ⟨_, domainType⟩⟩ + have annotationContext : VLCtx.IsDefEq env Us.length + ((none, .vlam domain') :: Δ) + ((none, .vlam storedDomain') :: Δ) := + .cons (.refl henv hΔ) (by nofun) (.vlam annotationDef) + have bodyStoredType := + bodySource.hasType.2.defeqDFC henv annotationContext.defeqCtx + have hBodyΓ : OnCtx (storedDomain' :: Δ.toCtx) + (env.IsType Us.length) := + ⟨hΔ.toCtx, ⟨_, annotationDef.hasType.2⟩⟩ obtain ⟨_, bodyTypeEq⟩ := - bodyType.uniq henv hBodyΓ bodyEvidence.isDefEq - have bodyDefRaw : env.IsDefEq Us.length - (domain' :: Δ.toCtx) body' bodyView' (.sort v) := + bodyStoredType.uniq henv hBodyΓ bodyEvidence.isDefEq + have bodyDefStored : env.IsDefEq Us.length + (storedDomain' :: Δ.toCtx) storedBody' bodyView' (.sort v) := (DefEqEvidence.change bodyTypeEq.symm bodyEvidence).isDefEq have bodyDefMoved := - bodyDefRaw.defeqDFC henv hctx.defeqCtx + bodyDefStored.defeqDFC henv hctx.defeqCtx have habstract : bodyCandidate.view.abstract #[context.freshExpr] = Expr.abstract1 context.freshFVarId bodyCandidate.view := by @@ -636,6 +1444,219 @@ theorem CandidateExprRun.view_tr · simpa only [AddInductive.CandidateExprTrace.view, habstract] using bodyMoved +/-- Root-level verified context and translations for an exact executable +candidate expression and an explicitly named Theory view. + +The raw endpoint is a strict translation of the stored kernel source. The +view endpoint translates the exact reconstructed candidate syntax; allowing +the ordinary `TrExpr` relation here accounts for the definitional transport +performed while recursively rebuilding Pi bodies. -/ +structure CandidateExprRootRun (env : VEnv) (Us : List Name) + {source : Expr} (candidate : AddInductive.CandidateExpr source) + (source' view' : VExpr) where + contextRun : CandidateContextRun candidate.context + venv_eq : contextRun.context.venv = env + lparams_eq : contextRun.context.lparams = Us + vlctx_eq : contextRun.context.vlctx = [] + source_tr : TrExprS env Us [] source source' + view_tr : TrExpr env Us [] candidate.view view' + whnfFuel : Nat + whnfDepth : candidate.context.fuel.recDepth = whnfFuel + 1 + +/-- Interpret a root candidate against its explicitly translated endpoints. +The candidate view is not selected from a proof-only existential: the caller +names it and proves that it translates the exact executable view, while the +verified recursive run supplies the equality to the strict raw endpoint. -/ +theorem CandidateExprRootRun.evidence + {env : VEnv} {Us : List Name} {source : Expr} + {candidate : AddInductive.CandidateExpr source} + {source' view' : VExpr} + (run : CandidateExprRootRun env Us candidate source' view') : + ∃ A, DefEqEvidence env Us.length [] source' view' A := by + have source_tr : run.contextRun.context.TrExprS source source' := by + simpa only [VContext.TrExprS, run.venv_eq, run.lparams_eq, + run.vlctx_eq] using run.source_tr + obtain ⟨candidateView', inferred', ⟨candidateRun⟩⟩ := + CandidateExprRun.exists_ofCandidate candidate.trace run.contextRun + source' source_tr run.whnfFuel run.whnfDepth + have henv : VEnv.WF env := by + simpa only [run.venv_eq] using run.contextRun.context.Ewf + have hΔ : VLCtx.WF env Us.length [] := by + simpa only [run.venv_eq, run.lparams_eq, run.vlctx_eq] using + run.contextRun.context.Δwf + have candidateView_tr : + TrExpr env Us [] candidate.view candidateView' := by + simpa only [AddInductive.CandidateExpr.view, run.venv_eq, + run.lparams_eq, run.vlctx_eq] using + candidateRun.view_tr + have viewDef : env.IsDefEqU Us.length [] candidateView' view' := + candidateView_tr.uniq henv (.refl henv hΔ) run.view_tr + have sourceDef : env.IsDefEqU Us.length [] source' candidateView' := by + simpa only [run.venv_eq, run.lparams_eq, run.vlctx_eq, + VLCtx.toCtx] using + candidateRun.evidence.isDefEq.toU + obtain ⟨A, hfinal⟩ := sourceDef.trans henv hΔ.toCtx viewDef + exact ⟨A, .ofDefEq hfinal⟩ + +/-- A root candidate together with the exact recursively interpreted semantic +run selected by its retained checker executions. + +Unlike `CandidateExprRootRun`, this bundle does not stop at whole-expression +equality: it retains the exact inferred type and reconstructed Theory view at +every recursive candidate position. Consequently the same value can supply +both normalization evidence and, when the executable trace preserves its main +Pi spine, the positional telescope/result evidence required by generation. +The view is selected by the verified run rather than supplied independently by +a caller. -/ +structure CandidateExprSemanticRootRun (env : VEnv) (Us : List Name) + {source : Expr} (candidate : AddInductive.CandidateExpr source) + (source' : VExpr) where + contextRun : CandidateContextRun candidate.context + venv_eq : contextRun.context.venv = env + lparams_eq : contextRun.context.lparams = Us + vlctx_eq : contextRun.context.vlctx = [] + source_tr : TrExprS env Us [] source source' + whnfFuel : Nat + whnfDepth : candidate.context.fuel.recDepth = whnfFuel + 1 + view : VExpr + recursive : ∃ inferred, CandidateExprRun env Us candidate.trace [] + source' view inferred + +/-- Forget the retained recursive run and expose the existing root semantic +interface. The reconstructed view translation is derived from that same run, +so it cannot name an unrelated endpoint. -/ +def CandidateExprSemanticRootRun.root + (run : CandidateExprSemanticRootRun env Us candidate source') : + CandidateExprRootRun env Us candidate source' run.view where + contextRun := run.contextRun + venv_eq := run.venv_eq + lparams_eq := run.lparams_eq + vlctx_eq := run.vlctx_eq + source_tr := run.source_tr + view_tr := by + obtain ⟨_, recursive⟩ := run.recursive + simpa only [AddInductive.CandidateExpr.view] using + recursive.view_tr + whnfFuel := run.whnfFuel + whnfDepth := run.whnfDepth + +/-- Automatically construct the retained root semantics from an exact +verified candidate context and strict translation of the stored kernel +source. + +The checker run selects the Theory view and inferred type existentially; the +result records those exact selections. No caller-selected normalization view, +erasure equality, or whole-Pi injectivity principle is used. -/ +theorem CandidateExprSemanticRootRun.exists_ofCandidate + {env : VEnv} {Us : List Name} {source : Expr} + {candidate : AddInductive.CandidateExpr source} {source' : VExpr} + (contextRun : CandidateContextRun candidate.context) + (venv_eq : contextRun.context.venv = env) + (lparams_eq : contextRun.context.lparams = Us) + (vlctx_eq : contextRun.context.vlctx = []) + (source_tr : TrExprS env Us [] source source') + (whnfFuel : Nat) + (whnfDepth : candidate.context.fuel.recDepth = whnfFuel + 1) : + Nonempty (CandidateExprSemanticRootRun env Us candidate source') := by + have contextualSource : + contextRun.context.TrExprS source source' := by + simpa only [VContext.TrExprS, venv_eq, lparams_eq, vlctx_eq] using + source_tr + obtain ⟨view, inferred, ⟨recursive⟩⟩ := + CandidateExprRun.exists_ofCandidate candidate.trace contextRun source' + contextualSource whnfFuel whnfDepth + refine ⟨{ + contextRun := contextRun + venv_eq := venv_eq + lparams_eq := lparams_eq + vlctx_eq := vlctx_eq + source_tr := source_tr + whnfFuel := whnfFuel + whnfDepth := whnfDepth + view := view + recursive := ⟨inferred, ?_⟩ }⟩ + simpa only [venv_eq, lparams_eq, vlctx_eq] using recursive + +/-- The exact pre-run evidence needed to interpret one candidate root without +asking a caller to choose its normalized Theory view. + +This bundle deliberately stops before the recursive semantic run. It contains +only the verified implementation context, its alignment with the requested +Theory environment, the strict translation of the stored source, and the fuel +relation consumed by `CandidateExprRun.exists_ofCandidate`. -/ +structure CandidateExprSemanticRootInput (env : VEnv) (Us : List Name) + {source : Expr} (candidate : AddInductive.CandidateExpr source) + (source' : VExpr) where + contextRun : CandidateContextRun candidate.context + venv_eq : contextRun.context.venv = env + lparams_eq : contextRun.context.lparams = Us + vlctx_eq : contextRun.context.vlctx = [] + source_tr : TrExprS env Us [] source source' + whnfFuel : Nat + whnfDepth : candidate.context.fuel.recDepth = whnfFuel + 1 + +/-- Run the retained checker interpreter on an exact root input. The result is +`Nonempty` because the checker-selected Theory view is semantic evidence rather +than executable metadata; no choice operator or caller-supplied endpoint is +introduced by this boundary. -/ +theorem CandidateExprSemanticRootInput.exists + (input : CandidateExprSemanticRootInput env Us candidate source') : + Nonempty (CandidateExprSemanticRootRun env Us candidate source') := + CandidateExprSemanticRootRun.exists_ofCandidate input.contextRun + input.venv_eq input.lparams_eq input.vlctx_eq input.source_tr + input.whnfFuel input.whnfDepth + +/-- One explicitly verified root stage shared by every candidate expression +interpreted before or after family insertion. + +The stage owns the implementation/Theory context alignment once. Individual +source positions retain only their strict translation, fuel relation, and the +equality identifying the candidate's stored context with this stage. This is +the reusable boundary between staged environment validation and the retained +recursive candidate interpreter. -/ +structure CandidateSemanticStage + (candidateContext : AddInductive.Context) (env : VEnv) (Us : List Name) + where + contextRun : CandidateContextRun candidateContext + venv_eq : contextRun.context.venv = env + lparams_eq : contextRun.context.lparams = Us + vlctx_eq : contextRun.context.vlctx = [] + +/-- Source-position evidence interpreted in one shared candidate stage. + +`context_eq` prevents a verified stage for another producer position from +being reused. The normalized Theory endpoint is deliberately absent: it is +selected only by `CandidateExprSemanticRootInput.exists`. -/ +structure CandidateExprStagedInput + {candidateContext : AddInductive.Context} {env : VEnv} {Us : List Name} + (stage : CandidateSemanticStage candidateContext env Us) + {source : Expr} (candidate : AddInductive.CandidateExpr source) + (source' : VExpr) where + context_eq : candidateContext = candidate.context + source_tr : TrExprS env Us [] source source' + whnfFuel : Nat + whnfDepth : candidate.context.fuel.recDepth = whnfFuel + 1 + +/-- Specialize a shared verified stage to one exact source-indexed candidate +root. This is a pure dependent transport; it neither runs the checker nor +chooses the semantic view. -/ +def CandidateExprStagedInput.rootInput + {candidateContext : AddInductive.Context} {env : VEnv} {Us : List Name} + {source : Expr} {candidate : AddInductive.CandidateExpr source} + {source' : VExpr} + {stage : CandidateSemanticStage candidateContext env Us} + (input : CandidateExprStagedInput stage candidate source') : + CandidateExprSemanticRootInput env Us candidate source' := by + cases input.context_eq + exact { + contextRun := stage.contextRun + venv_eq := stage.venv_eq + lparams_eq := stage.lparams_eq + vlctx_eq := stage.vlctx_eq + source_tr := input.source_tr + whnfFuel := input.whnfFuel + whnfDepth := input.whnfDepth } + /-- Pointwise checker-produced equality for a pair of binder telescopes. The tail is checked in the context extended by the raw binder, exactly matching `VEnv.TelDefEq` and the mixed generator's raw-binder discipline. -/ @@ -655,6 +1676,658 @@ theorem TelDefEqEvidence.telDefEq : | .nil => trivial | .cons head tail => ⟨⟨_, head.isDefEq⟩, tail.telDefEq⟩ +/-- Pointwise telescope equality followed by equality of the terminal result. + +Keeping these witnesses in one inductive preserves the raw-binder context at +every recursive step. In particular, the result is checked in +`rawBinders.reverse ++ Γ`, exactly the context used by mixed generation. -/ +inductive TelResultDefEqEvidence (env : VEnv) (U : Nat) : + (Γ : List VExpr) → (rawBinders viewBinders : List VExpr) → + (rawResult viewResult resultType : VExpr) → Prop where + | terminal + (result : DefEqEvidence env U Γ rawResult viewResult resultType) : + TelResultDefEqEvidence env U Γ [] [] rawResult viewResult resultType + | forallE + (domain : DefEqEvidence env U Γ rawDomain viewDomain (.sort u)) + (tail : TelResultDefEqEvidence env U (rawDomain :: Γ) + rawBinders viewBinders rawResult viewResult resultType) : + TelResultDefEqEvidence env U Γ + (rawDomain :: rawBinders) (viewDomain :: viewBinders) + rawResult viewResult resultType + +/-- Telescope component of a combined spine/result certificate. -/ +def TelResultDefEqEvidence.telescope : + TelResultDefEqEvidence env U Γ rawBinders viewBinders + rawResult viewResult resultType → + TelDefEqEvidence env U Γ rawBinders viewBinders + | .terminal _ => .nil + | .forallE domain tail => .cons domain tail.telescope + +/-- Terminal component, in the context generated by all raw binders. -/ +def TelResultDefEqEvidence.result : + TelResultDefEqEvidence env U Γ rawBinders viewBinders + rawResult viewResult resultType → + DefEqEvidence env U (rawBinders.reverse ++ Γ) + rawResult viewResult resultType + | .terminal result => by simpa using result + | .forallE _ tail => by + simpa [List.reverse_cons, List.append_assoc] using tail.result + +theorem TelResultDefEqEvidence.length_eq : + TelResultDefEqEvidence env U Γ rawBinders viewBinders + rawResult viewResult resultType → + rawBinders.length = viewBinders.length + | .terminal _ => rfl + | .forallE _ tail => congrArg Nat.succ tail.length_eq + +/-- Reify a Theory telescope equality as explicit checker-produced evidence. +This direction is useful after telescope operations such as `take`, `drop`, +and context transport have rearranged a candidate certificate. -/ +def TelDefEqEvidence.ofTelDefEq : + ∀ {Γ As As'}, env.TelDefEq U Γ As As' → + TelDefEqEvidence env U Γ As As' + | _, [], [], _ => .nil + | _, _ :: _, _ :: _, ⟨⟨_, head⟩, tail⟩ => + .cons (.ofDefEq head) (TelDefEqEvidence.ofTelDefEq tail) + +/-- Retain an exact prefix of a checker-produced telescope certificate. -/ +def TelDefEqEvidence.take + (run : TelDefEqEvidence env U Γ As As') (n : Nat) : + TelDefEqEvidence env U Γ (As.take n) (As'.take n) := + .ofTelDefEq (run.telDefEq.take n) + +/-- Transport a checker-produced telescope certificate through environment +growth. -/ +def TelDefEqEvidence.mono + (run : TelDefEqEvidence env U Γ As As') (henv : env ≤ env') : + TelDefEqEvidence env' U Γ As As' := + .ofTelDefEq (run.telDefEq.mono henv) + +/-- Combine an independently transformed telescope certificate with its +terminal result certificate. -/ +def TelResultDefEqEvidence.ofTelescopeResult + (tel : TelDefEqEvidence env U Γ rawBinders viewBinders) + (result : DefEqEvidence env U (rawBinders.reverse ++ Γ) + rawResult viewResult resultType) : + TelResultDefEqEvidence env U Γ rawBinders viewBinders + rawResult viewResult resultType := by + induction tel with + | nil => exact .terminal (by simpa using result) + | cons head tail ih => + exact .forallE head (ih (by + simpa [List.reverse_cons, List.append_assoc] using result)) + +private theorem candidateDefEqCtx_trans (henv : VEnv.WF env) : + ∀ {Γ₁ Γ₂ Γ₃}, + env.IsDefEqCtx U [] Γ₁ Γ₂ → + env.IsDefEqCtx U [] Γ₂ Γ₃ → + env.IsDefEqCtx U [] Γ₁ Γ₃ + | _, _, _, .zero, h₂₃ => h₂₃ + | _, _, _, .succ h₁₂ head₁₂, .succ h₂₃ head₂₃ => by + have tail := candidateDefEqCtx_trans henv h₁₂ h₂₃ + have head₂₃' := head₂₃.defeqDFC henv (h₁₂.symm henv) + exact .succ tail (VEnv.IsDefEq.trans_l henv h₁₂.isType + head₁₂ head₂₃') + +private theorem candidateTelDefEq_defeqDFC (henv : VEnv.WF env) + (hctx : env.IsDefEqCtx U [] Γ₁ Γ₂) : + ∀ {As As'}, env.TelDefEq U Γ₁ As As' → + env.TelDefEq U Γ₂ As As' + | [], [], _ => trivial + | _ :: _, _ :: _, ⟨⟨u, head⟩, tail⟩ => + ⟨⟨u, head.defeqDFC henv hctx⟩, + candidateTelDefEq_defeqDFC henv + (.succ hctx head.hasType.1) tail⟩ + +private theorem candidateTelDefEq_append + {env : VEnv} {U : Nat} {Γ : List VExpr} : + ∀ {As As' Bs Bs'}, env.TelDefEq U Γ As As' → + env.TelDefEq U (As.reverse ++ Γ) Bs Bs' → + env.TelDefEq U Γ (As ++ Bs) (As' ++ Bs') + | [], [], _, _, _, suffix => by simpa using suffix + | _ :: As, _ :: As', Bs, Bs', ⟨head, tail⟩, suffix => by + exact ⟨head, candidateTelDefEq_append tail (by + simpa [List.reverse_cons, List.append_assoc] using suffix)⟩ + +/-- Replace a constructor candidate's stored parameter prefix by the family's +raw parameter prefix. + +The two raw prefixes need not be syntactically equal: both are related to the +same checked view prefix. The field telescope and terminal result are then +transported through the induced context equality, yielding exactly the mixed +raw/view context emitted by generation. -/ +def TelResultDefEqEvidence.replacePrefix + (henv : VEnv.WF env) + (newPrefix : TelDefEqEvidence env U [] newRawPrefix viewPrefix) + (run : TelResultDefEqEvidence env U [] + (oldRawPrefix ++ rawSuffix) (viewPrefix ++ viewSuffix) + rawResult viewResult resultType) + (prefixLength : oldRawPrefix.length = viewPrefix.length) : + TelResultDefEqEvidence env U [] + (newRawPrefix ++ rawSuffix) (viewPrefix ++ viewSuffix) + rawResult viewResult resultType := by + have declaredTel := run.telescope.telDefEq + have oldPrefix : env.TelDefEq U [] oldRawPrefix viewPrefix := by + have hprefix := declaredTel.take oldRawPrefix.length + simpa [prefixLength] using hprefix + have oldSuffix : env.TelDefEq U oldRawPrefix.reverse + rawSuffix viewSuffix := by + have suffix := declaredTel.drop oldRawPrefix.length + simpa [prefixLength] using suffix + have newPrefixTheory := newPrefix.telDefEq + have newPrefixContext : env.IsDefEqCtx U [] + newRawPrefix.reverse viewPrefix.reverse := by + simpa using newPrefixTheory.ctx + have oldPrefixContext : env.IsDefEqCtx U [] + oldRawPrefix.reverse viewPrefix.reverse := by + simpa using oldPrefix.ctx + have prefixContext : env.IsDefEqCtx U [] + newRawPrefix.reverse oldRawPrefix.reverse := + candidateDefEqCtx_trans henv newPrefixContext + (oldPrefixContext.symm henv) + have newSuffix : env.TelDefEq U newRawPrefix.reverse + rawSuffix viewSuffix := + candidateTelDefEq_defeqDFC henv (prefixContext.symm henv) oldSuffix + have emittedTel : env.TelDefEq U [] + (newRawPrefix ++ rawSuffix) (viewPrefix ++ viewSuffix) := + candidateTelDefEq_append newPrefixTheory (by simpa using newSuffix) + have fullContext : env.IsDefEqCtx U [] + ((newRawPrefix ++ rawSuffix).reverse) + ((oldRawPrefix ++ rawSuffix).reverse) := by + have extended := newSuffix.raw_onTel.extendDefEqCtx prefixContext + simpa [List.reverse_append] using extended + have oldResult : DefEqEvidence env U + (oldRawPrefix ++ rawSuffix).reverse + rawResult viewResult resultType := by + simpa using run.result + have emittedResult : DefEqEvidence env U + (newRawPrefix ++ rawSuffix).reverse + rawResult viewResult resultType := + .ofDefEq (oldResult.isDefEq.defeqDFC henv + (fullContext.symm henv)) + exact TelResultDefEqEvidence.ofTelescopeResult + (.ofTelDefEq emittedTel) (by simpa using emittedResult) + +/-- Every recursive candidate run carries the well-formed local context used +by its root checker observation. -/ +theorem CandidateExprRun.context_wf + {env : VEnv} {Us : List Name} + {candidateContext : AddInductive.Context} {source : Expr} + {trace : AddInductive.CandidateExprTrace candidateContext source} + {Δ : VLCtx} {source' view' inferred' : VExpr} + (run : CandidateExprRun env Us trace Δ source' view' inferred') : + VLCtx.WF env Us.length Δ := by + cases run with + | @terminal Δ context source inferred result source' result' inferred' + checked normalized node => + simpa only [node.check.venv_eq, node.check.lparams_eq, + node.check.vlctx_eq] using node.check.context.Δwf + | forallE _ _ _ _ node => + simpa only [node.check.venv_eq, node.check.lparams_eq, + node.check.vlctx_eq] using node.check.context.Δwf + +private theorem candidateTelN_forallN_length : + ∀ (As : List VExpr) (B : VExpr), + VExpr.telN As.length (VExpr.forallN As B) = As + | [], _ => rfl + | _ :: As, B => by + simp only [List.length_cons, VExpr.forallN, VExpr.telN, + candidateTelN_forallN_length As B] + +private theorem candidateDropN_forallN_length : + ∀ (As : List VExpr) (B : VExpr), + VExpr.dropN As.length (VExpr.forallN As B) = B + | [], _ => rfl + | _ :: As, B => by + simp only [List.length_cons, VExpr.forallN, VExpr.dropN, + candidateDropN_forallN_length As B] + +/-- Syntactic terminal marker used only to recover a telescope from a known +`dropN` endpoint. -/ +private def CandidateTerminal : VExpr → Prop + | .forallE _ _ => False + | _ => True + +/-- If dropping `n` binders from a telescope reaches its non-forall terminal, +then taking `n` binders recovers the entire telescope. -/ +private theorem candidateTelN_of_dropN_terminal + {B : VExpr} (hB : CandidateTerminal B) : + ∀ (As : List VExpr) (n : Nat), + VExpr.dropN n (VExpr.forallN As B) = B → + VExpr.telN n (VExpr.forallN As B) = As + | [], n, _ => by + cases B <;> cases n <;> simp_all [CandidateTerminal, + VExpr.forallN, VExpr.dropN, VExpr.telN] + | A :: As, 0, h => by + cases B <;> simp_all [CandidateTerminal, + VExpr.forallN, VExpr.dropN] + | A :: As, n + 1, h => by + simp only [VExpr.forallN, VExpr.telN, + List.cons.injEq, true_and] + exact candidateTelN_of_dropN_terminal hB As n (by + simpa only [VExpr.forallN, VExpr.dropN] using h) + +private theorem candidateTerminal_appN_app (f a : VExpr) : + ∀ args, CandidateTerminal (VExpr.appN (.app f a) args) + | [] => trivial + | b :: args => candidateTerminal_appN_app (.app f a) b args + +private theorem candidateTerminal_appN_const + (name : Name) (levels : List VLevel) : + ∀ args, CandidateTerminal (VExpr.appN (.const name levels) args) + | [] => trivial + | a :: args => candidateTerminal_appN_app (.const name levels) a args + +/-- Recursive worker for candidate spine extraction. + +`rawΔ` follows the contexts generated by the stored raw binders, while `Δ` +is the annotation-consumed context in which the candidate body was checked. +The explicit context equality transports each retained checker judgment back +to the raw side before it is added to the telescope certificate. -/ +private theorem CandidateExprRun.spineEvidenceAux + {env : VEnv} {Us : List Name} + {candidateContext : AddInductive.Context} {source : Expr} + {trace : AddInductive.CandidateExprTrace candidateContext source} + {Δ : VLCtx} {source' view' inferred' : VExpr} + (run : CandidateExprRun env Us trace Δ source' view' inferred') + (aligned : trace.storedSpine = true) + {rawΔ : VLCtx} {rawSource' : VExpr} + (contextEq : VLCtx.IsDefEq env Us.length rawΔ Δ) + (rawSource_tr : TrExprS env Us rawΔ source rawSource') : + ∃ rawBinders viewBinders rawResult viewResult resultType, + rawSource' = VExpr.forallN rawBinders rawResult ∧ + view' = VExpr.forallN viewBinders viewResult ∧ + TelResultDefEqEvidence env Us.length rawΔ.toCtx + rawBinders viewBinders rawResult viewResult resultType ∧ + rawBinders.length = trace.spineLength := by + induction run generalizing rawΔ rawSource' with + | terminal node => + have henv : VEnv.WF env := by + simpa only [node.check.venv_eq] using node.check.context.Ewf + have hRawΔ := contextEq.wf + have rawToSource : env.IsDefEqU Us.length rawΔ.toCtx + rawSource' _ := + rawSource_tr.uniq henv contextEq node.check.expr_tr + have sourceToView := + node.evidence.isDefEq.defeqDFC henv + (contextEq.symm henv).defeqCtx + have final := VEnv.IsDefEq.transU_r henv hRawΔ.toCtx + rawToSource sourceToView + exact ⟨[], [], rawSource', _, _, rfl, rfl, + .terminal (.ofDefEq final), rfl⟩ + | @forallE domain context name binderInfo Δ source inferred body + source' domain' body' inferred' domainView' domainInferred' + storedDomain' bodyΔ storedBody' bodyView' bodyInferred' u v fresh + checked normalized annotations annotationsEq domainCandidate + bodyCandidate node domainRun annotationsRun bodyRun domainType bodyType + bodySource bodyContext domainIH bodyIH => + simp only [AddInductive.CandidateExprTrace.storedSpine, + Bool.and_eq_true] at aligned + obtain ⟨sourceEq, bodyAligned⟩ := aligned + have alignedSource_tr : TrExprS env Us rawΔ + (.forallE name domain body binderInfo) rawSource' := + rawSource_tr.eqv sourceEq + let @TrExprS.forallE _ _ rawDomain rawBody _ _ _ _ _ + rawDomainType rawBodyType rawDomain_tr rawBody_tr := alignedSource_tr + have henv : VEnv.WF env := by + simpa only [node.check.venv_eq] using node.check.context.Ewf + have hΔ : VLCtx.WF env Us.length Δ := by + simpa only [node.check.venv_eq, node.check.lparams_eq, + node.check.vlctx_eq] using node.check.context.Δwf + have hRawΔ := contextEq.wf + have rawToDomainU := + rawDomain_tr.uniq henv contextEq domainRun.source_tr + have domainTypeRaw := + domainType.defeqDFC henv (contextEq.symm henv).defeqCtx + have rawToDomain := + rawToDomainU.of_r henv hRawΔ.toCtx domainTypeRaw + have domainToView := + domainRun.evidence.isDefEq.toU.of_l henv hΔ.toCtx domainType + have domainToViewRaw := + domainToView.defeqDFC henv (contextEq.symm henv).defeqCtx + have head : DefEqEvidence env Us.length rawΔ.toCtx + _ domainView' (.sort u) := + .ofDefEq (rawToDomain.trans domainToViewRaw) + have annotationDef := + annotationsRun.isDefEqU.of_l henv hΔ.toCtx domainType + have annotationDefRaw := + annotationDef.defeqDFC henv (contextEq.symm henv).defeqCtx + have rawToStored := rawToDomain.trans annotationDefRaw + have bodyWF := bodyRun.context_wf + rw [bodyContext] at bodyWF + have rawFresh : + ∀ fv deps, + some (context.freshFVarId, annotations.consumed.fvarsList) = + some (fv, deps) → + fv ∉ rawΔ.fvars ∧ deps ⊆ rawΔ.fvars := by + intro fv deps heq + cases heq + have hfresh := bodyWF.2.1 _ _ rfl + simpa only [contextEq.fvars] using hfresh + let rawBodyΔ : VLCtx := + (some (context.freshFVarId, annotations.consumed.fvarsList), + .vlam rawDomain) :: rawΔ + have bodyContextEqConcrete : VLCtx.IsDefEq env Us.length rawBodyΔ + ((some (context.freshFVarId, annotations.consumed.fvarsList), + .vlam storedDomain') :: Δ) := + .cons contextEq rawFresh (.vlam rawToStored) + have bodyContextEq : VLCtx.IsDefEq env Us.length rawBodyΔ bodyΔ := by + simpa only [bodyContext] using bodyContextEqConcrete + have rawBodyΔwf := bodyContextEq.wf + have rawBodyInst_tr : TrExprS env Us rawBodyΔ + (body.instantiate1 context.freshExpr) rawBody := by + simpa only [AddInductive.Context.freshExpr, + Expr.instantiate1_eq] using + rawBody_tr.inst_fvar henv.ordered rawBodyΔwf + obtain ⟨rawBinders, viewBinders, rawResult, viewResult, + resultType, rawBodyEq, viewBodyEq, tail, tailLength⟩ := + bodyIH bodyAligned bodyContextEq rawBodyInst_tr + refine ⟨rawDomain :: rawBinders, + domainView' :: viewBinders, rawResult, viewResult, resultType, + ?_, ?_, ?_, ?_⟩ + · simp only [VExpr.forallN, rawBodyEq] + · simp only [VExpr.forallN, viewBodyEq] + · exact .forallE head (by + simpa only [rawBodyΔ, VLCtx.toCtx] using tail) + · simpa only [List.length_cons, + AddInductive.CandidateExprTrace.spineLength] using + congrArg Nat.succ tailLength + +/-- Extract exact raw/view telescopes and terminal results from a recursive +candidate run whose WHNF traversal preserved the stored Pi spine. + +The binder count is computed from the source-indexed trace, and `telN`/ +`dropN` name the exact stored raw and reconstructed-view components. This +avoids recovering binder equality from whole-Pi definitional equality and so +does not use the unfinished forall-injectivity theorem. -/ +theorem CandidateExprRun.spineEvidence + {env : VEnv} {Us : List Name} + {candidateContext : AddInductive.Context} {source : Expr} + {trace : AddInductive.CandidateExprTrace candidateContext source} + {Δ : VLCtx} {source' view' inferred' : VExpr} + (run : CandidateExprRun env Us trace Δ source' view' inferred') + (aligned : trace.storedSpine = true) : + ∃ resultType, + TelResultDefEqEvidence env Us.length Δ.toCtx + (VExpr.telN trace.spineLength source') + (VExpr.telN trace.spineLength view') + (VExpr.dropN trace.spineLength source') + (VExpr.dropN trace.spineLength view') resultType := by + have henv : VEnv.WF env := by + cases run with + | terminal node => + simpa only [node.check.venv_eq] using node.check.context.Ewf + | forallE _ _ _ _ node => + simpa only [node.check.venv_eq] using node.check.context.Ewf + obtain ⟨rawBinders, viewBinders, rawResult, viewResult, + resultType, rawEq, viewEq, evidence, rawLength⟩ := + run.spineEvidenceAux aligned + (.refl henv run.context_wf) run.source_tr + have viewLength : viewBinders.length = trace.spineLength := + evidence.length_eq ▸ rawLength + have rawTel : VExpr.telN trace.spineLength source' = rawBinders := by + rw [rawEq, ← rawLength] + exact candidateTelN_forallN_length rawBinders rawResult + have viewTel : VExpr.telN trace.spineLength view' = viewBinders := by + rw [viewEq, ← viewLength] + exact candidateTelN_forallN_length viewBinders viewResult + have rawResultEq : + VExpr.dropN trace.spineLength source' = rawResult := by + rw [rawEq, ← rawLength] + exact candidateDropN_forallN_length rawBinders rawResult + have viewResultEq : + VExpr.dropN trace.spineLength view' = viewResult := by + rw [viewEq, ← viewLength] + exact candidateDropN_forallN_length viewBinders viewResult + simpa only [rawTel, viewTel, rawResultEq, viewResultEq] using + ⟨resultType, evidence⟩ + +/-- Replace only the terminal typing index of a combined certificate. The +telescope and both result endpoints remain definitionally unchanged. -/ +def TelResultDefEqEvidence.withResult + (run : TelResultDefEqEvidence env U Γ rawBinders viewBinders + rawResult viewResult resultType) + (result : DefEqEvidence env U (rawBinders.reverse ++ Γ) + rawResult viewResult resultType') : + TelResultDefEqEvidence env U Γ rawBinders viewBinders + rawResult viewResult resultType' := by + induction run with + | terminal _ => exact .terminal (by simpa using result) + | forallE domain tail ih => + exact .forallE domain (ih (by + simpa [List.reverse_cons, List.append_assoc] using result)) + +/-- Fix a candidate terminal equality at a known type of its right endpoint. +This is the bridge from the candidate's checker-inferred type to the precise +sort required by dependent inductive analysis. -/ +def TelResultDefEqEvidence.ofRightType + (henv : VEnv.WF env) (hΓ : OnCtx Γ (env.IsType U)) + (run : TelResultDefEqEvidence env U Γ rawBinders viewBinders + rawResult viewResult resultType) + (rightType : env.HasType U (rawBinders.reverse ++ Γ) + viewResult expectedType) : + TelResultDefEqEvidence env U Γ rawBinders viewBinders + rawResult viewResult expectedType := by + have hctx : OnCtx (rawBinders.reverse ++ Γ) (env.IsType U) := + (run.telescope.telDefEq.extendCtx (.refl hΓ)).isType + exact run.withResult (.ofDefEq + (run.result.isDefEq.toU.of_r henv hctx rightType)) + +theorem CandidateExprRun.env_wf + {env : VEnv} {Us : List Name} + {candidateContext : AddInductive.Context} {source : Expr} + {trace : AddInductive.CandidateExprTrace candidateContext source} + {Δ : VLCtx} {source' view' inferred' : VExpr} + (run : CandidateExprRun env Us trace Δ source' view' inferred') : + VEnv.WF env := by + cases run with + | terminal node => + simpa only [node.check.venv_eq] using node.check.context.Ewf + | forallE _ _ _ _ node => + simpa only [node.check.venv_eq] using node.check.context.Ewf + +/-- Interpret the terminal-sort fact retained by family validation. + +At a terminal node the verified WHNF result translates the exact kernel sort. +At a Pi node the recursively interpreted body is transported from the +annotation-consumed binder context to the candidate-view binder context. Thus +the complete checker-selected candidate view is a Theory type without using a +checked inductive declaration or a caller-supplied view-WF proof. -/ +theorem CandidateExprRun.view_isType_of_terminalSort + {env : VEnv} {Us : List Name} + {candidateContext : AddInductive.Context} {source : Expr} + {trace : AddInductive.CandidateExprTrace candidateContext source} + {Δ : VLCtx} {source' view' inferred' : VExpr} + (run : CandidateExprRun env Us trace Δ source' view' inferred') + (terminal : trace.terminalResult = .sort resultLevel) : + env.IsType Us.length Δ.toCtx view' := by + induction run with + | terminal node => + simp only [AddInductive.CandidateExprTrace.terminalResult] at terminal + have henv : VEnv.WF env := by + simpa only [node.check.venv_eq] using node.check.context.Ewf + obtain ⟨strict, strict_tr, strict_def⟩ := node.whnf.rhs_tr + rw [terminal] at strict_tr + cases strict_tr with + | sort level_tr => + exact VEnv.IsType.defeqU_l henv (by + simpa only [node.check.venv_eq, node.check.lparams_eq, + node.check.vlctx_eq] using node.check.context.Δwf.toCtx) + strict_def ⟨_, .sort (VLevel.WF.of_ofLevel level_tr)⟩ + | @forallE domain context name binderInfo Δ source inferred body + source' domain' body' inferred' domainView' domainInferred' + storedDomain' bodyΔ storedBody' bodyView' bodyInferred' u v fresh + checked normalized annotations annotationsEq domainCandidate + bodyCandidate node domainRun annotationsRun bodyRun domainType bodyType + bodySource bodyContext domainIH bodyIH => + simp only [AddInductive.CandidateExprTrace.terminalResult] at terminal + have henv : VEnv.WF env := by + simpa only [node.check.venv_eq] using node.check.context.Ewf + have hΔ : VLCtx.WF env Us.length Δ := by + simpa only [node.check.venv_eq, node.check.lparams_eq, + node.check.vlctx_eq] using node.check.context.Δwf + have domainDef : env.IsDefEq Us.length Δ.toCtx + domain' domainView' (.sort u) := + domainRun.evidence.isDefEq.toU.of_l henv hΔ.toCtx domainType + have domainViewType : env.IsType Us.length Δ.toCtx domainView' := + ⟨u, domainDef.hasType.2⟩ + have annotationDef : env.IsDefEq Us.length Δ.toCtx + domain' storedDomain' (.sort u) := + annotationsRun.isDefEqU.of_l henv hΔ.toCtx domainType + have storedToView : env.IsDefEq Us.length Δ.toCtx + storedDomain' domainView' (.sort u) := + annotationDef.symm.trans domainDef + have bodyContextEq : env.IsDefEqCtx Us.length [] + (storedDomain' :: Δ.toCtx) (domainView' :: Δ.toCtx) := + (VLCtx.IsDefEq.cons (.refl henv hΔ) (ofv := none) + (by nofun) (.vlam storedToView)).defeqCtx + have bodyViewTypeStored : env.IsType Us.length + (storedDomain' :: Δ.toCtx) bodyView' := by + simpa only [bodyContext, VLCtx.toCtx] using bodyIH terminal + have bodyViewType : env.IsType Us.length + (domainView' :: Δ.toCtx) bodyView' := by + exact bodyViewTypeStored.defeqDFC henv.ordered bodyContextEq + exact domainViewType.forallE bodyViewType + +/-- Family validation types the checker-selected view first; the retained +candidate equality then transports that fact back to the exact raw Theory +source. This is the declaration-WF fact needed before raw-family insertion. -/ +theorem CandidateExprSemanticRootRun.source_isType_of_terminalSort + {env : VEnv} {Us : List Name} {source : Expr} + {candidate : AddInductive.CandidateExpr source} {source' : VExpr} + (run : CandidateExprSemanticRootRun env Us candidate source') + (terminal : candidate.trace.terminalResult = .sort resultLevel) : + env.IsType Us.length [] source' := by + obtain ⟨_, recursive⟩ := run.recursive + have hview := recursive.view_isType_of_terminalSort terminal + have henv : VEnv.WF env := by + simpa only [run.venv_eq] using run.contextRun.context.Ewf + exact hview.defeqU_l henv trivial recursive.evidence.isDefEq.toU.symm + +/-- Candidate-view parameter binders selected by an exact singleton family +validation run. The split is computed from the retained candidate spine. -/ +def CandidateExprSemanticRootRun.viewParameters + {indType : InductiveType} + {candidate : AddInductive.CandidateExpr indType.type} + (run : CandidateExprSemanticRootRun env Us candidate source') + (validation : AddInductive.CandidateExprTrace.FamilyValidationRun + indType candidate.trace) : List VExpr := + (VExpr.telN candidate.trace.spineLength run.view).take + validation.nparams + +/-- Candidate-view index binders following the validator-selected parameter +prefix. -/ +def CandidateExprSemanticRootRun.viewIndices + {indType : InductiveType} + {candidate : AddInductive.CandidateExpr indType.type} + (run : CandidateExprSemanticRootRun env Us candidate source') + (validation : AddInductive.CandidateExprTrace.FamilyValidationRun + indType candidate.trace) : List VExpr := + (VExpr.telN candidate.trace.spineLength run.view).drop + validation.nparams + +/-- An exact recursive run whose executable main spine preserves the stored +binders. Unlike a whole-expression root equality, this package is strong +enough to expose generation's pointwise binder and terminal-result evidence. -/ +def CandidateExprSpineRun (env : VEnv) (Us : List Name) + {source : Expr} (candidate : AddInductive.CandidateExpr source) + (raw view : VExpr) : Prop := + candidate.trace.storedSpine = true ∧ + ∃ inferred, CandidateExprRun env Us candidate.trace [] raw view inferred + +/-- Retaining the recursive semantic root makes the generation spine a direct +projection once the executable structural gate has succeeded. -/ +def CandidateExprSemanticRootRun.spine + (run : CandidateExprSemanticRootRun env Us candidate source') + (storedSpine : candidate.trace.storedSpine = true) : + CandidateExprSpineRun env Us candidate source' run.view := + ⟨storedSpine, run.recursive⟩ + +/-- Turn an exact root translation and a recursive identity witness into the +generation-ready spine package. The root equalities transport the recursive +run out of the verifier's reconstructed context without choosing a different +semantic endpoint. -/ +def CandidateExprRootRun.spineOfIdentity + {env : VEnv} {Us : List Name} {source : Expr} + {candidate : AddInductive.CandidateExpr source} {source' : VExpr} + (run : CandidateExprRootRun env Us candidate source' source') + (identity : CandidateExprIdentity candidate.trace) : + CandidateExprSpineRun env Us candidate source' source' := by + refine ⟨identity.storedSpine, ?_⟩ + have source_tr : run.contextRun.context.TrExprS source source' := by + simpa only [VContext.TrExprS, run.venv_eq, run.lparams_eq, + run.vlctx_eq] using run.source_tr + obtain ⟨inferred', ⟨recursive⟩⟩ := + CandidateExprRun.exists_ofIdentity candidate.trace identity + run.contextRun source' source_tr run.whnfFuel run.whnfDepth + refine ⟨inferred', ?_⟩ + simpa only [run.venv_eq, run.lparams_eq, run.vlctx_eq] using recursive + +/-- Retain the exact recursive run selected by an identity-normalizing root. + +All data fields are inherited from the named root and its fixed Theory +endpoint. The existential inferred type remains proof-only, so this constructor +does not use classical choice and does not turn identity into an executable or +semantic oracle. -/ +def CandidateExprRootRun.semanticOfIdentity + {env : VEnv} {Us : List Name} {source : Expr} + {candidate : AddInductive.CandidateExpr source} {source' : VExpr} + (run : CandidateExprRootRun env Us candidate source' source') + (identity : CandidateExprIdentity candidate.trace) : + CandidateExprSemanticRootRun env Us candidate source' where + contextRun := run.contextRun + venv_eq := run.venv_eq + lparams_eq := run.lparams_eq + vlctx_eq := run.vlctx_eq + source_tr := run.source_tr + whnfFuel := run.whnfFuel + whnfDepth := run.whnfDepth + view := source' + recursive := by + have source_tr : run.contextRun.context.TrExprS source source' := by + simpa only [VContext.TrExprS, run.venv_eq, run.lparams_eq, + run.vlctx_eq] using run.source_tr + obtain ⟨inferred, ⟨recursive⟩⟩ := + CandidateExprRun.exists_ofIdentity candidate.trace identity + run.contextRun source' source_tr run.whnfFuel run.whnfDepth + refine ⟨inferred, ?_⟩ + simpa only [run.venv_eq, run.lparams_eq, run.vlctx_eq] using recursive + +theorem CandidateExprSpineRun.evidence + (run : CandidateExprSpineRun env Us candidate raw view) : + ∃ resultType, + TelResultDefEqEvidence env Us.length [] + (VExpr.telN candidate.trace.spineLength raw) + (VExpr.telN candidate.trace.spineLength view) + (VExpr.dropN candidate.trace.spineLength raw) + (VExpr.dropN candidate.trace.spineLength view) resultType := by + obtain ⟨aligned, _, recursive⟩ := run + exact recursive.spineEvidence aligned + +/-- Align extracted candidate components with named raw/view telescope and +result data, then fix the terminal type from a checked right-endpoint typing +judgment. All four alignment premises are syntactic equations. -/ +theorem CandidateExprSpineRun.evidenceAt + (run : CandidateExprSpineRun env Us candidate raw view) + (rawTel : VExpr.telN candidate.trace.spineLength raw = rawBinders) + (viewTel : VExpr.telN candidate.trace.spineLength view = viewBinders) + (rawResult_eq : + VExpr.dropN candidate.trace.spineLength raw = rawResult) + (viewResult_eq : + VExpr.dropN candidate.trace.spineLength view = viewResult) + (rightType : env.HasType Us.length rawBinders.reverse + viewResult expectedType) : + TelResultDefEqEvidence env Us.length [] rawBinders viewBinders + rawResult viewResult expectedType := by + obtain ⟨aligned, _, recursive⟩ := run + obtain ⟨resultType, evidence⟩ := recursive.spineEvidence aligned + have exactEvidence : TelResultDefEqEvidence env Us.length [] + rawBinders viewBinders rawResult viewResult resultType := by + simpa only [rawTel, viewTel, rawResult_eq, viewResult_eq, + VLCtx.toCtx] using evidence + exact exactEvidence.ofRightType recursive.env_wf trivial (by + simpa using rightType) + end TypeChecker namespace VInductDecl @@ -696,105 +2369,3465 @@ theorem NormalizationRun.wf have : some envT = some run.typeEnv := hadd.symm.trans run.addType exact Option.some.inj this subst envT - exact run.constructors.imp fun _ _ h => by + exact Lean4Lean.List.Forall₂.imp (h := run.constructors) fun _ _ h => by obtain ⟨_, hctor⟩ := h exact hctor.isDefEq.toU -/-- Checker-produced semantic evidence for one positional raw/view -constructor pair. This has the same four-way declared/emitted split as -`NormalizedCtor.WF`, but keeps every equality in compositional evidence form -until the final Theory boundary. -/ -structure NormalizedCtorRun {source : VInductDecl} - (block : NormalizedChecked source) (ctor : NormalizedCtor) - (env : VEnv) where - declaredTel : TypeChecker.TelDefEqEvidence env source.uvars [] - (ctor.declaredBinders source.nparams) (ctor.viewBinders block) - declaredResult : TypeChecker.DefEqEvidence env source.uvars - (ctor.declaredBinders source.nparams).reverse - (ctor.rawResult source.nparams) (ctor.resultTarget block) - (.sort block.checked.resultLevel) - emittedTel : TypeChecker.TelDefEqEvidence env source.uvars [] - (ctor.emittedBinders block) (ctor.viewBinders block) - emittedResult : TypeChecker.DefEqEvidence env source.uvars - (ctor.emittedBinders block).reverse - (ctor.rawResult source.nparams) (ctor.resultTarget block) - (.sort block.checked.resultLevel) +/-- One constructor candidate tied to the corresponding raw Theory constant. +Its expression payload may normalize, but its name, universe arity, and exact +source position remain fixed. -/ +structure CandidateConstructorRun (env : VEnv) (Us : List Name) + {source : Constructor} + (candidate : AddInductive.CandidateConstructor source) + (raw : VConstVal) where + name_eq : source.name = raw.name + uvars_eq : raw.uvars = Us.length + viewType : VExpr + typeRun : TypeChecker.CandidateExprRootRun env Us candidate.type + raw.type viewType -theorem NormalizedCtorRun.wf - (run : NormalizedCtorRun block ctor env) : +/-- Replace only the expression payload certified by the constructor run. -/ +def CandidateConstructorRun.view + (run : CandidateConstructorRun env Us candidate raw) : VConstVal := + { raw with type := run.viewType } + +/-- Exact positional certification for a source-indexed constructor list and +the raw Theory constructor list. Unlike `zip`, this type cannot truncate a +longer side or reuse evidence at a different source position. -/ +inductive CandidateConstructorListRun (env : VEnv) (Us : List Name) : + {sources : List Constructor} → + AddInductive.CandidateList AddInductive.CandidateConstructor sources → + List VConstVal → Type where + | nil : CandidateConstructorListRun env Us .nil [] + | cons + (head : CandidateConstructorRun env Us candidate raw) + (tail : CandidateConstructorListRun env Us candidates raws) : + CandidateConstructorListRun env Us + (.cons candidate candidates) (raw :: raws) + +/-- The exact normalized constructor list retained by a positional run. -/ +def CandidateConstructorListRun.views : + CandidateConstructorListRun env Us candidates raws → List VConstVal + | .nil => [] + | .cons head tail => head.view :: tail.views + +/-- Positional certification preserves every constructor header. -/ +theorem CandidateConstructorListRun.sameHeaders + (run : CandidateConstructorListRun env Us candidates raws) : + sameCtorHeaders raws run.views = true := by + induction run with + | nil => rfl + | cons head tail ih => + simp [CandidateConstructorListRun.views, + CandidateConstructorRun.view, sameCtorHeaders, ih] + +/-- Collect the exact checker-produced equality for every positional raw/view +constructor pair. -/ +theorem CandidateConstructorListRun.evidence + (run : CandidateConstructorListRun env Us candidates raws) : + List.Forall₂ + (fun raw view => ∃ A, + TypeChecker.DefEqEvidence env Us.length [] + raw.type view.type A) + raws run.views := by + induction run with + | nil => exact .nil + | cons head tail ih => + exact .cons head.typeRun.evidence ih + +/-- One family candidate certified in the input environment, together with +all of its constructors certified in the exact environment obtained by +inserting the raw family constant. -/ +structure CandidateFamilyRun (env : VEnv) (Us : List Name) + {source : InductiveType} + (candidate : AddInductive.CandidateFamily source) + (raw : VInductiveType) where + name_eq : source.name = raw.name + uvars_eq : raw.uvars = Us.length + viewType : VExpr + typeRun : TypeChecker.CandidateExprRootRun env Us + candidate.familyType.type raw.type viewType + typeEnv : VEnv + addType : env.addConst raw.name raw.toVConstant = some typeEnv + constructors : CandidateConstructorListRun typeEnv Us + candidate.constructors raw.ctors + +/-- Replace only the family and constructor expression payloads named by the +certified candidate runs. -/ +def CandidateFamilyRun.view + (run : CandidateFamilyRun env Us candidate raw) : VInductiveType := + { raw with + type := run.viewType + ctors := run.constructors.views } + +/-- Exact singleton candidate-list certification against one raw Theory +declaration. The singleton kernel-source index rules out partial selection of +a family candidate, and `raw_types_eq` rules out partial selection of a Theory +family. Mutual blocks remain an explicit later generalization. -/ +structure NormalizationCandidateRun (env : VEnv) (Us : List Name) + {source : InductiveType} + (candidate : AddInductive.NormalizationCandidate [source]) + (rawDecl : VInductDecl) where + raw : VInductiveType + raw_types_eq : rawDecl.types = [raw] + uvars_eq : rawDecl.uvars = Us.length + family : CandidateFamilyRun env Us candidate.families.singleton raw + +/-- The Theory declaration obtained from the exact singleton candidate. -/ +def NormalizationCandidateRun.viewDecl + (run : NormalizationCandidateRun env Us candidate rawDecl) : + VInductDecl := + { rawDecl with types := [run.family.view] } + +/-- Candidate-list shape evidence is sufficient to construct the Theory +normalization boundary without `head!`, unchecked `zip`, or an arbitrary view +declaration supplied separately from the candidate. -/ +def NormalizationCandidateRun.normalization + (run : NormalizationCandidateRun env Us candidate rawDecl) : + Normalization rawDecl where + view := run.viewDecl + shape_eq := by + simp only [normalizationShape, NormalizationCandidateRun.viewDecl, + run.raw_types_eq, beq_self_eq_true, Bool.true_and, sameTypeHeaders, + CandidateFamilyRun.view] + simp [run.family.constructors.sameHeaders] + +/-- Assemble the existing semantic normalization certificate from the exact +family and constructor candidate runs. -/ +def NormalizationCandidateRun.normalizationRun + (run : NormalizationCandidateRun env Us candidate rawDecl) : + NormalizationRun run.normalization env where + raw := run.raw + view := run.family.view + source_types_eq := run.raw_types_eq + view_types_eq := rfl + family := by + simpa only [run.uvars_eq, CandidateFamilyRun.view] using + run.family.typeRun.evidence + typeEnv := run.family.typeEnv + addType := run.family.addType + constructors := by + simpa only [run.uvars_eq, CandidateFamilyRun.view] using + run.family.constructors.evidence + +/-- One constructor whose exact recursive candidate semantics are retained, +rather than reconstructed separately for normalization and generation. + +The header remains indexed by the kernel source and raw Theory constant. The +semantic root owns the checker-selected view, its inferred type, and the +recursive run used by both downstream phases. -/ +structure CandidateConstructorSemanticRun (env : VEnv) (Us : List Name) + {source : Constructor} + (candidate : AddInductive.CandidateConstructor source) + (raw : VConstVal) where + name_eq : source.name = raw.name + uvars_eq : raw.uvars = Us.length + type : TypeChecker.CandidateExprSemanticRootRun env Us candidate.type + raw.type + +/-- Project the normalization-facing constructor root without losing its +source or position indices. -/ +def CandidateConstructorSemanticRun.root + (run : CandidateConstructorSemanticRun env Us candidate raw) : + CandidateConstructorRun env Us candidate raw where + name_eq := run.name_eq + uvars_eq := run.uvars_eq + viewType := run.type.view + typeRun := run.type.root + +/-- Exact positional semantic ownership for an arbitrary constructor list. +Every element retains the recursive run selected at that source position; the +list cannot truncate, reorder, or reuse a run for another constructor. -/ +inductive CandidateConstructorSemanticListRun + (env : VEnv) (Us : List Name) : + {sources : List Constructor} → + AddInductive.CandidateList AddInductive.CandidateConstructor sources → + List VConstVal → Type where + | nil : CandidateConstructorSemanticListRun env Us .nil [] + | cons + (head : CandidateConstructorSemanticRun env Us candidate raw) + (tail : CandidateConstructorSemanticListRun env Us candidates raws) : + CandidateConstructorSemanticListRun env Us + (.cons candidate candidates) (raw :: raws) + +/-- Forget only the retained recursive-run payload and recover the existing +normalization-facing positional list. -/ +def CandidateConstructorSemanticListRun.roots : + CandidateConstructorSemanticListRun env Us candidates raws → + CandidateConstructorListRun env Us candidates raws + | .nil => .nil + | .cons head tail => .cons head.root tail.roots + +/-- A singleton-family semantic hierarchy spanning the pre-family candidate, +the exact raw-family insertion, and every post-family constructor candidate. +The normalized expression payloads are selected by retained recursive checker +runs, not by a parallel caller-supplied declaration. -/ +structure CandidateFamilySemanticRun (env : VEnv) (Us : List Name) + {source : InductiveType} + (candidate : AddInductive.CandidateFamily source) + (raw : VInductiveType) where + name_eq : source.name = raw.name + uvars_eq : raw.uvars = Us.length + type : TypeChecker.CandidateExprSemanticRootRun env Us + candidate.familyType.type raw.type + typeEnv : VEnv + addType : env.addConst raw.name raw.toVConstant = some typeEnv + constructors : CandidateConstructorSemanticListRun typeEnv Us + candidate.constructors raw.ctors + +/-- Project the existing normalization-facing family run from the retained +semantic hierarchy. -/ +def CandidateFamilySemanticRun.root + (run : CandidateFamilySemanticRun env Us candidate raw) : + CandidateFamilyRun env Us candidate raw where + name_eq := run.name_eq + uvars_eq := run.uvars_eq + viewType := run.type.view + typeRun := run.type.root + typeEnv := run.typeEnv + addType := run.addType + constructors := run.constructors.roots + +/-- Complete retained semantic ownership for one source-indexed singleton +normalization candidate. This is the generic bridge from translated family and +constructor candidates to `NormalizationCandidateRun`; mutual blocks remain a +later indexed generalization. -/ +structure NormalizationCandidateSemanticRun (env : VEnv) (Us : List Name) + {source : InductiveType} + (candidate : AddInductive.NormalizationCandidate [source]) + (rawDecl : VInductDecl) where + raw : VInductiveType + raw_types_eq : rawDecl.types = [raw] + uvars_eq : rawDecl.uvars = Us.length + family : CandidateFamilySemanticRun env Us candidate.families.singleton raw + +/-- Recover the existing normalization candidate from the retained semantic +hierarchy. -/ +def NormalizationCandidateSemanticRun.root + (run : NormalizationCandidateSemanticRun env Us candidate rawDecl) : + NormalizationCandidateRun env Us candidate rawDecl where + raw := run.raw + raw_types_eq := run.raw_types_eq + uvars_eq := run.uvars_eq + family := run.family.root + +/-- Pre-run semantic evidence for one source-indexed constructor. Its header +is aligned with the raw Theory constant, while the expression input contains +only the verified context and strict source translation needed to let the +retained checker choose the view. -/ +structure CandidateConstructorSemanticInput (env : VEnv) (Us : List Name) + {source : Constructor} + (candidate : AddInductive.CandidateConstructor source) + (raw : VConstVal) where + name_eq : source.name = raw.name + uvars_eq : raw.uvars = Us.length + type : TypeChecker.CandidateExprSemanticRootInput env Us candidate.type + raw.type + +/-- Interpret one constructor input without selecting its view at the call +site. -/ +theorem CandidateConstructorSemanticInput.exists + (input : CandidateConstructorSemanticInput env Us candidate raw) : + Nonempty (CandidateConstructorSemanticRun env Us candidate raw) := by + obtain ⟨type⟩ := input.type.exists + exact ⟨{ + name_eq := input.name_eq + uvars_eq := input.uvars_eq + type := type }⟩ + +/-- Exact source-order semantic inputs for an arbitrary constructor list. +Unlike a pointwise predicate over erased lists, these indices prevent an input +from being reused at another constructor or from silently truncating either +side. -/ +inductive CandidateConstructorSemanticListInput + (env : VEnv) (Us : List Name) : + {sources : List Constructor} → + AddInductive.CandidateList AddInductive.CandidateConstructor sources → + List VConstVal → Type where + | nil : CandidateConstructorSemanticListInput env Us .nil [] + | cons + (head : CandidateConstructorSemanticInput env Us candidate raw) + (tail : CandidateConstructorSemanticListInput env Us candidates raws) : + CandidateConstructorSemanticListInput env Us + (.cons candidate candidates) (raw :: raws) + +/-- Recursively interpret every source-indexed constructor input. -/ +theorem CandidateConstructorSemanticListInput.exists + (input : CandidateConstructorSemanticListInput env Us candidates raws) : + Nonempty (CandidateConstructorSemanticListRun env Us candidates raws) := by + induction input with + | nil => exact ⟨.nil⟩ + | cons head tail ih => + obtain ⟨headRun⟩ := head.exists + obtain ⟨tailRun⟩ := ih + exact ⟨.cons headRun tailRun⟩ + +/-- One validated singleton family stage derived from a verified entry +candidate context and the exact kernel/Theory family insertion. + +The family validator selects the parameter/index split and terminal sort. The +retained candidate semantics then prove the raw family constant well formed; +that proof extends the entry `TrEnv` and constructs the post-family verifier +context. No independently verified post-family `VEnvs` is an input. -/ +structure CandidateFamilyStagedInput + (familyContext constructorContext : AddInductive.Context) + (env : VEnv) (Us : List Name) + {source : InductiveType} + (candidate : AddInductive.CandidateFamilyType source) + (raw : VInductiveType) + (preFamily : TypeChecker.CandidateSemanticStage familyContext env Us) + where + name_eq : source.name = raw.name + uvars_eq : raw.uvars = Us.length + type : TypeChecker.CandidateExprStagedInput preFamily + candidate.type raw.type + validation : AddInductive.CandidateExprTrace.FamilyValidationRun + source candidate.type.trace + typeEnv : VEnv + addInduct : AddInductConstant .induct familyContext.env.constants env + raw.toVConstVal constructorContext.env.constants typeEnv + family_lctx_eq : familyContext.lctx = {} + constructorContext_eq : constructorContext = + { familyContext with env := constructorContext.env } + quotInit_eq : constructorContext.env.quotInit = + familyContext.env.quotInit + name_not_reflected : raw.name ∉ TypeChecker.reflectedPrimitiveNames + name_not_primitive : + Environment.primitives.contains raw.name = false + +/-- Family validation plus retained candidate semantics prove the exact raw +Theory constant suitable for insertion. The semantic view remains hidden +under `Nonempty`; elimination is only into this proposition. -/ +theorem CandidateFamilyStagedInput.rawWF + (input : CandidateFamilyStagedInput familyContext constructorContext + env Us candidate raw preFamily) : + raw.toVConstant.WF env := by + obtain ⟨semantic⟩ := input.type.rootInput.exists + show env.IsType raw.uvars [] raw.type + simpa only [input.uvars_eq] using + semantic.source_isType_of_terminalSort input.validation.terminal_eq + +/-- The verifier context after inserting the validated raw family constant. +Primitive reflection and safety are preserved because the new family name is +not a kernel or reflected primitive. -/ +def CandidateFamilyStagedInput.postContext + (input : CandidateFamilyStagedInput familyContext constructorContext + env Us candidate raw preFamily) : TypeChecker.VContext where + env := constructorContext.env + lctx := constructorContext.lctx + lparams := constructorContext.lparams + safety := constructorContext.safety + fuel := constructorContext.fuel + venv := input.typeEnv + hasPrimitives := by + have H : env.HasPrimitives := by + simpa only [preFamily.venv_eq] using + preFamily.contextRun.context.hasPrimitives + exact TypeChecker.VEnv.HasPrimitives.addConst H + input.name_not_reflected input.addInduct.env_add + safePrimitives := by + intro n ci + have preMapWF : familyContext.env.constants.WF := by + simpa only [preFamily.contextRun.context_env] using + preFamily.contextRun.context.trenv.map_wf + exact TypeChecker.AddInductConstant.safePrimitives input.addInduct + (n := n) (ci := ci) preMapWF (fun hfind hprim => by + apply preFamily.contextRun.context.safePrimitives + · simpa only [preFamily.contextRun.context_env] using hfind + · exact hprim) + input.name_not_primitive + trenv := by + have preTr : TrEnv' familyContext.safety familyContext.env.constants + familyContext.env.quotInit env := by + simpa only [TrEnv, preFamily.contextRun.context_safety, + preFamily.contextRun.context_env, preFamily.venv_eq] using + preFamily.contextRun.context.trenv + have postTr := TrEnv'.inductStaging input.addInduct input.rawWF preTr + change TrEnv' constructorContext.safety constructorContext.env.constants + constructorContext.env.quotInit input.typeEnv + rw [show constructorContext.safety = familyContext.safety by + rw [input.constructorContext_eq]] + rw [input.quotInit_eq] + exact postTr + mlctx := .nil + mlctx_wf := trivial + lctx_eq := by + change ({} : LocalContext) = constructorContext.lctx + rw [input.constructorContext_eq, input.family_lctx_eq] + +/-- The exact post-family candidate context constructed from family +validation, rather than supplied by a second verifier setup. -/ +def CandidateFamilyStagedInput.postContextRun + (input : CandidateFamilyStagedInput familyContext constructorContext + env Us candidate raw preFamily) : + TypeChecker.CandidateContextRun constructorContext := + TypeChecker.CandidateContextRun.ofVContext constructorContext + input.postContext (by rfl) + (TypeChecker.VState.WF.empty_of_reserves input.postContext (by + intro fv hfv + change fv ∈ VLCtx.fvars ([] : VLCtx) at hfv + simp at hfv)) + (by + rw [input.constructorContext_eq] + exact preFamily.contextRun.namePrefix_ne) + +/-- Shared post-family semantic stage consumed by every constructor position. +Its implementation and Theory environments are fixed by the exact family +insertion above. -/ +def CandidateFamilyStagedInput.postFamily + (input : CandidateFamilyStagedInput familyContext constructorContext + env Us candidate raw preFamily) : + TypeChecker.CandidateSemanticStage constructorContext input.typeEnv Us where + contextRun := input.postContextRun + venv_eq := rfl + lparams_eq := by + rw [TypeChecker.CandidateContextRun.context_lparams] + calc + constructorContext.lparams = familyContext.lparams := by + rw [input.constructorContext_eq] + _ = preFamily.contextRun.context.lparams := + preFamily.contextRun.context_lparams.symm + _ = Us := preFamily.lparams_eq + vlctx_eq := rfl + +/-- One source-indexed constructor interpreted in the shared post-family +stage. Header equality and universe alignment stay attached to the exact raw +constructor position; the expression payload contains no independently +verified context and no caller-selected semantic view. -/ +structure CandidateConstructorStagedInput + {candidateContext : AddInductive.Context} {env : VEnv} {Us : List Name} + (stage : TypeChecker.CandidateSemanticStage candidateContext env Us) + {source : Constructor} + (candidate : AddInductive.CandidateConstructor source) + (raw : VConstVal) where + name_eq : source.name = raw.name + uvars_eq : raw.uvars = Us.length + type : TypeChecker.CandidateExprStagedInput stage candidate.type raw.type + +/-- Forget only the shared-stage presentation and recover the established +constructor semantic input. -/ +def CandidateConstructorStagedInput.semanticInput + {candidateContext : AddInductive.Context} {env : VEnv} {Us : List Name} + {source : Constructor} + {candidate : AddInductive.CandidateConstructor source} + {raw : VConstVal} + {stage : TypeChecker.CandidateSemanticStage candidateContext env Us} + (input : CandidateConstructorStagedInput stage candidate raw) : + CandidateConstructorSemanticInput env Us candidate raw where + name_eq := input.name_eq + uvars_eq := input.uvars_eq + type := input.type.rootInput + +/-- Exact source-order translations for every constructor in one shared +post-family stage. The dependent indices enforce length, order, source, raw +header, and candidate alignment without `zip` or list lookup. -/ +inductive CandidateConstructorStagedListInput + {candidateContext : AddInductive.Context} {env : VEnv} {Us : List Name} + (stage : TypeChecker.CandidateSemanticStage candidateContext env Us) : + {sources : List Constructor} → + AddInductive.CandidateList AddInductive.CandidateConstructor sources → + List VConstVal → Type where + | nil : CandidateConstructorStagedListInput stage .nil [] + | cons + (head : CandidateConstructorStagedInput stage candidate raw) + (tail : CandidateConstructorStagedListInput stage candidates raws) : + CandidateConstructorStagedListInput stage + (.cons candidate candidates) (raw :: raws) + +/-- Convert the staged, source-indexed constructor translations to the +existing recursive semantic-input representation. -/ +def CandidateConstructorStagedListInput.semanticInput + {candidateContext : AddInductive.Context} {env : VEnv} {Us : List Name} + {stage : TypeChecker.CandidateSemanticStage candidateContext env Us} + {sources : List Constructor} + {candidates : AddInductive.CandidateList + AddInductive.CandidateConstructor sources} + {raws : List VConstVal} + (input : CandidateConstructorStagedListInput stage candidates raws) : + CandidateConstructorSemanticListInput env Us candidates raws := + match input with + | .nil => CandidateConstructorSemanticListInput.nil + | .cons head tail => + CandidateConstructorSemanticListInput.cons + head.semanticInput tail.semanticInput + +/-- Pre-run semantic evidence for a complete singleton family position. The +family type is interpreted in the input environment and its constructor list +in the exact environment obtained by inserting the raw family constant. -/ +structure CandidateFamilySemanticInput (env : VEnv) (Us : List Name) + {source : InductiveType} + (candidate : AddInductive.CandidateFamily source) + (raw : VInductiveType) where + name_eq : source.name = raw.name + uvars_eq : raw.uvars = Us.length + type : TypeChecker.CandidateExprSemanticRootInput env Us + candidate.familyType.type raw.type + typeEnv : VEnv + addType : env.addConst raw.name raw.toVConstant = some typeEnv + constructors : CandidateConstructorSemanticListInput typeEnv Us + candidate.constructors raw.ctors + +/-- Interpret the family root and all post-insertion constructor roots from +their exact pre-run inputs. -/ +theorem CandidateFamilySemanticInput.exists + (input : CandidateFamilySemanticInput env Us candidate raw) : + Nonempty (CandidateFamilySemanticRun env Us candidate raw) := by + obtain ⟨type⟩ := input.type.exists + obtain ⟨constructors⟩ := input.constructors.exists + exact ⟨{ + name_eq := input.name_eq + uvars_eq := input.uvars_eq + type := type + typeEnv := input.typeEnv + addType := input.addType + constructors := constructors }⟩ + +/-- Pre-run semantic evidence for one source-indexed singleton normalization +candidate. The source declaration and candidate list indices rule out an +unrelated raw family or a partial constructor list. -/ +structure NormalizationCandidateSemanticInput (env : VEnv) (Us : List Name) + {source : InductiveType} + (candidate : AddInductive.NormalizationCandidate [source]) + (rawDecl : VInductDecl) where + raw : VInductiveType + raw_types_eq : rawDecl.types = [raw] + uvars_eq : rawDecl.uvars = Us.length + family : CandidateFamilySemanticInput env Us + candidate.families.singleton raw + +/-- Automatically interpret the complete singleton semantic hierarchy from +its verified, source-indexed inputs. -/ +theorem NormalizationCandidateSemanticInput.exists + (input : NormalizationCandidateSemanticInput env Us candidate rawDecl) : + Nonempty (NormalizationCandidateSemanticRun env Us candidate rawDecl) := by + obtain ⟨family⟩ := input.family.exists + exact ⟨{ + raw := input.raw + raw_types_eq := input.raw_types_eq + uvars_eq := input.uvars_eq + family := family }⟩ + +/-- The automatic semantic hierarchy paired with the exact executable +family-type and constructor-list traversals that selected the same dependent +candidate. The two producer contexts are explicit because family types are +checked before raw-family insertion and constructors after it. -/ +structure ProducedNormalizationCandidateSemanticRun + (familyContext constructorContext : AddInductive.Context) + (env : VEnv) (Us : List Name) + {source : InductiveType} + (candidate : AddInductive.NormalizationCandidate [source]) + (rawDecl : VInductDecl) where + semantic : NormalizationCandidateSemanticRun env Us candidate rawDecl + familyTypesProduced : AddInductive.CandidateFamilyTypeListProduced + familyContext + (.cons candidate.families.singleton.familyType .nil) + familiesProduced : AddInductive.CandidateFamilyListProduced + constructorContext + (.cons candidate.families.singleton.familyType .nil) + candidate.families + +/-- Combine exact arbitrary-length producer witnesses with verified semantic +inputs for the same source-indexed singleton candidate. Operational evidence +selects the candidate; only the retained checker interpreter supplies Theory +meaning. -/ +theorem NormalizationCandidateSemanticInput.exists_ofProduced + (input : NormalizationCandidateSemanticInput env Us candidate rawDecl) + (familyTypesProduced : AddInductive.CandidateFamilyTypeListProduced + familyContext + (.cons candidate.families.singleton.familyType .nil)) + (familiesProduced : AddInductive.CandidateFamilyListProduced + constructorContext + (.cons candidate.families.singleton.familyType .nil) + candidate.families) : + Nonempty (ProducedNormalizationCandidateSemanticRun + familyContext constructorContext env Us candidate rawDecl) := by + obtain ⟨semantic⟩ := input.exists + exact ⟨{ + semantic := semantic + familyTypesProduced := familyTypesProduced + familiesProduced := familiesProduced }⟩ + +/-- The complete family-validated semantic input for a produced singleton +candidate. + +Only the entry verifier alignment is supplied. The exact singleton family +validation and raw-family insertion derive the post-family verified stage; +constructor positions then supply strict translations and fuel equalities in +that derived stage. No normalized view, post-family `VEnvs.WF`, semantic run, +declaration-WF proof, or generation package is an input. -/ +structure StagedNormalizationCandidateSemanticInput + (familyContext constructorContext : AddInductive.Context) + (env : VEnv) (Us : List Name) + {source : InductiveType} + (candidate : AddInductive.NormalizationCandidate [source]) + (rawDecl : VInductDecl) where + raw : VInductiveType + raw_types_eq : rawDecl.types = [raw] + declaration_uvars_eq : rawDecl.uvars = Us.length + preFamily : TypeChecker.CandidateSemanticStage familyContext env Us + family : CandidateFamilyStagedInput familyContext constructorContext env Us + candidate.families.singleton.familyType raw preFamily + constructors : CandidateConstructorStagedListInput family.postFamily + candidate.families.singleton.constructors raw.ctors + familyTypesProduced : AddInductive.CandidateFamilyTypeListProduced + familyContext + (.cons candidate.families.singleton.familyType .nil) + familiesProduced : AddInductive.CandidateFamilyListProduced + constructorContext + (.cons candidate.families.singleton.familyType .nil) + candidate.families + +/-- Project the established semantic-input hierarchy from the consolidated +two-stage owner. This projection remains data-free with respect to checker +semantics: it only rearranges verified stage and translation evidence. -/ +def StagedNormalizationCandidateSemanticInput.semanticInput + {familyContext constructorContext : AddInductive.Context} + {env : VEnv} {Us : List Name} {source : InductiveType} + {candidate : AddInductive.NormalizationCandidate [source]} + {rawDecl : VInductDecl} + (input : StagedNormalizationCandidateSemanticInput familyContext + constructorContext env Us candidate rawDecl) : + NormalizationCandidateSemanticInput env Us candidate rawDecl where + raw := input.raw + raw_types_eq := input.raw_types_eq + uvars_eq := input.declaration_uvars_eq + family := { + name_eq := input.family.name_eq + uvars_eq := input.family.uvars_eq + type := input.family.type.rootInput + typeEnv := input.family.typeEnv + addType := input.family.addInduct.env_add + constructors := input.constructors.semanticInput } + +/-- Interpret a complete produced singleton candidate from its entry stage and +derived family-validation stage. The result stays in `Nonempty`; in particular, this theorem +does not use choice to expose a semantic run as executable data. -/ +theorem StagedNormalizationCandidateSemanticInput.exists + {familyContext constructorContext : AddInductive.Context} + {env : VEnv} {Us : List Name} {source : InductiveType} + {candidate : AddInductive.NormalizationCandidate [source]} + {rawDecl : VInductDecl} + (input : StagedNormalizationCandidateSemanticInput familyContext + constructorContext env Us candidate rawDecl) : + Nonempty (ProducedNormalizationCandidateSemanticRun + familyContext constructorContext env Us candidate rawDecl) := + input.semanticInput.exists_ofProduced input.familyTypesProduced + input.familiesProduced + +/-- Forget executable list provenance and expose the existing normalization +root selected by the automatic semantic hierarchy. -/ +def ProducedNormalizationCandidateSemanticRun.root + (run : ProducedNormalizationCandidateSemanticRun + familyContext constructorContext env Us candidate rawDecl) : + NormalizationCandidateRun env Us candidate rawDecl := + run.semantic.root + +/-- Checker-produced semantic evidence for one positional raw/view +constructor pair. This has the same four-way declared/emitted split as +`NormalizedCtor.WF`, but keeps every equality in compositional evidence form +until the final Theory boundary. -/ +structure NormalizedCtorRun {source : VInductDecl} + (block : NormalizedChecked source) (ctor : NormalizedCtor) + (env : VEnv) where + declaredTel : TypeChecker.TelDefEqEvidence env source.uvars [] + (ctor.declaredBinders source.nparams) (ctor.viewBinders block) + declaredResult : TypeChecker.DefEqEvidence env source.uvars + (ctor.declaredBinders source.nparams).reverse + (ctor.rawResult source.nparams) (ctor.resultTarget block) + (.sort block.checked.resultLevel) + emittedTel : TypeChecker.TelDefEqEvidence env source.uvars [] + (ctor.emittedBinders block) (ctor.viewBinders block) + emittedResult : TypeChecker.DefEqEvidence env source.uvars + (ctor.emittedBinders block).reverse + (ctor.rawResult source.nparams) (ctor.resultTarget block) + (.sort block.checked.resultLevel) + +theorem NormalizedCtorRun.wf + (run : NormalizedCtorRun block ctor env) : ctor.WF block env where declaredTel := run.declaredTel.telDefEq declaredResult := run.declaredResult.isDefEq emittedTel := run.emittedTel.telDefEq emittedResult := run.emittedResult.isDefEq -/-- Complete checker-side assembler for a generation-ready candidate. +/-- Complete checker-side assembler for a generation-ready candidate. + +The exact family insertion state is named once. This lets a producer check +constructor evidence in that state and lets `.wf` discharge the universally +quantified post-family environment in `GenerationChecked.WF` by equality, +without an oracle or an assumed transaction. -/ +structure GenerationRun {source : VInductDecl} + (generation : GenerationChecked source) (env : VEnv) where + normalization : NormalizationRun generation.block.normalization env + checked : generation.block.checked.WF env + familyTel : TypeChecker.TelDefEqEvidence env source.uvars [] + (generation.block.rawParams ++ generation.block.rawIndices) + (generation.block.checked.params ++ generation.block.checked.indices) + familyResult : TypeChecker.DefEqEvidence env source.uvars + (generation.block.rawParams ++ generation.block.rawIndices).reverse + generation.block.rawResult (.sort generation.block.checked.resultLevel) + (.sort (.succ generation.block.checked.resultLevel)) + typeEnv : VEnv + addType : env.addConst generation.block.sourceType.name + generation.block.sourceType.toVConstant = some typeEnv + constructors : + ∀ ctor ∈ generation.block.ctorPairs, + NormalizedCtorRun generation.block ctor typeEnv + +/-- Assemble the complete Theory generation certificate from exact +checker-produced normalization, telescope, result, and constructor evidence. -/ +theorem GenerationRun.wf + (run : GenerationRun generation env) : + generation.WF env := by + refine { + blockWF := ⟨run.normalization.wf, run.checked⟩ + familyTel := run.familyTel.telDefEq + familyResult := run.familyResult.isDefEq + ctors := ?_ } + intro envT hadd ctor hctor + have henv : envT = run.typeEnv := by + have : some envT = some run.typeEnv := hadd.symm.trans run.addType + exact Option.some.inj this + subst envT + exact (run.constructors ctor hctor).wf + +/-- Exact family-spine evidence extracted from the source-indexed singleton +normalization candidate and aligned with the components retained by dependent +inductive analysis. -/ +structure CandidateFamilyGenerationRun + {kernelSource : InductiveType} {source : VInductDecl} + {candidate : AddInductive.NormalizationCandidate [kernelSource]} + (normalization : NormalizationCandidateRun env Us candidate source) + (generation : GenerationChecked source) where + spine : TypeChecker.CandidateExprSpineRun env Us + candidate.families.singleton.familyType.type + normalization.raw.type normalization.family.viewType + rawTel : VExpr.telN + candidate.families.singleton.familyType.type.trace.spineLength + normalization.raw.type = + generation.block.rawParams ++ generation.block.rawIndices + rawResult : VExpr.dropN + candidate.families.singleton.familyType.type.trace.spineLength + normalization.raw.type = generation.block.rawResult + viewResult : VExpr.dropN + candidate.families.singleton.familyType.type.trace.spineLength + normalization.family.viewType = + .sort generation.block.checked.resultLevel + +/-- Extract the complete family telescope/result certificate at the exact +components consumed by `GenerationRun`. -/ +def CandidateFamilyGenerationRun.evidence + {env : VEnv} {Us : List Name} + {kernelSource : InductiveType} {source : VInductDecl} + {candidate : AddInductive.NormalizationCandidate [kernelSource]} + {normalization : NormalizationCandidateRun env Us candidate source} + {generation : GenerationChecked source} + (run : CandidateFamilyGenerationRun normalization generation) + (viewType_eq : normalization.family.viewType = + generation.block.checked.type.type) : + TypeChecker.TelResultDefEqEvidence env Us.length [] + (generation.block.rawParams ++ generation.block.rawIndices) + (generation.block.checked.params ++ generation.block.checked.indices) + generation.block.rawResult + (.sort generation.block.checked.resultLevel) + (.sort (.succ generation.block.checked.resultLevel)) := + run.spine.evidenceAt run.rawTel (by + rw [viewType_eq, generation.block.checked.type_eq, + ← VExpr.forallN_append] + apply TypeChecker.candidateTelN_of_dropN_terminal (B := + .sort generation.block.checked.resultLevel) trivial + simpa only [viewType_eq, generation.block.checked.type_eq, + ← VExpr.forallN_append] using run.viewResult) + run.rawResult run.viewResult (by + apply VEnv.HasType.sort + simpa only [← generation.block.uvars_eq, + normalization.uvars_eq] using + generation.block.checked.direct_anatomy.2.2.1) + +/-- Family generation alignment whose spine is projected directly from the +retained semantic hierarchy. Callers provide only the executable structural +gate and the component equations required by `GenerationChecked`; they cannot +substitute a second recursive run or a different normalized view. -/ +structure CandidateFamilySemanticGenerationRun + {kernelSource : InductiveType} {source : VInductDecl} + {candidate : AddInductive.NormalizationCandidate [kernelSource]} + (normalization : NormalizationCandidateSemanticRun env Us candidate source) + (generation : GenerationChecked source) where + storedSpine : + candidate.families.singleton.familyType.type.trace.storedSpine = true + rawTel : VExpr.telN + candidate.families.singleton.familyType.type.trace.spineLength + normalization.raw.type = + generation.block.rawParams ++ generation.block.rawIndices + rawResult : VExpr.dropN + candidate.families.singleton.familyType.type.trace.spineLength + normalization.raw.type = generation.block.rawResult + viewResult : VExpr.dropN + candidate.families.singleton.familyType.type.trace.spineLength + normalization.family.type.view = + .sort generation.block.checked.resultLevel + +/-- Minimal structural input for family generation. The retained semantic +root already owns the recursive checker run, while dependent analysis fixes +the raw and checked components. A caller therefore supplies only the +executable stored-spine gate and the total number of binders traversed by that +spine; all telescope and terminal equations are derived below. -/ +structure CandidateFamilySemanticGenerationShape + {kernelSource : InductiveType} {source : VInductDecl} + {candidate : AddInductive.NormalizationCandidate [kernelSource]} + (normalization : NormalizationCandidateSemanticRun env Us candidate source) + (generation : GenerationChecked source) where + storedSpine : + candidate.families.singleton.familyType.type.trace.storedSpine = true + spineLength_eq : + candidate.families.singleton.familyType.type.trace.spineLength = + (generation.block.rawParams ++ generation.block.rawIndices).length + +/-- Recover the existing family-generation run from the single retained +semantic owner. -/ +def CandidateFamilySemanticGenerationRun.run + (run : CandidateFamilySemanticGenerationRun normalization generation) : + CandidateFamilyGenerationRun normalization.root generation where + spine := normalization.family.type.spine run.storedSpine + rawTel := run.rawTel + rawResult := run.rawResult + viewResult := run.viewResult + +/-- One positional constructor candidate aligned with the raw/view +constructor pair retained by dependent analysis. + +The spine certificate covers the exact stored constructor type. Its declared +telescope will later be transformed into the mixed emitted telescope by +replacing only the constructor's parameter prefix. -/ +structure CandidateNormalizedCtorRun {source : VInductDecl} + (block : NormalizedChecked source) (env : VEnv) (Us : List Name) + {kernelSource : Constructor} + {candidate : AddInductive.CandidateConstructor kernelSource} + {raw : VConstVal} + (root : CandidateConstructorRun env Us candidate raw) + (ctor : NormalizedCtor) where + raw_eq : ctor.raw = raw + view_eq : ctor.view.value = root.view + spine : TypeChecker.CandidateExprSpineRun env Us candidate.type + raw.type root.viewType + rawTel : VExpr.telN candidate.type.trace.spineLength raw.type = + ctor.declaredBinders source.nparams + rawResult : VExpr.dropN candidate.type.trace.spineLength raw.type = + ctor.rawResult source.nparams + viewResult : VExpr.dropN candidate.type.trace.spineLength root.viewType = + ctor.resultTarget block + +/-- Constructor generation alignment owned by the same retained semantic root +used for normalization. The only spine premise is the Boolean structural gate +computed by the candidate trace; the recursive semantic run and view are +projected from `root`. -/ +structure CandidateSemanticNormalizedCtorRun {source : VInductDecl} + (block : NormalizedChecked source) (env : VEnv) (Us : List Name) + {kernelSource : Constructor} + {candidate : AddInductive.CandidateConstructor kernelSource} + {raw : VConstVal} + (root : CandidateConstructorSemanticRun env Us candidate raw) + (ctor : NormalizedCtor) where + raw_eq : ctor.raw = raw + view_eq : ctor.view.value = root.root.view + storedSpine : candidate.type.trace.storedSpine = true + rawTel : VExpr.telN candidate.type.trace.spineLength raw.type = + ctor.declaredBinders source.nparams + rawResult : VExpr.dropN candidate.type.trace.spineLength raw.type = + ctor.rawResult source.nparams + viewResult : VExpr.dropN candidate.type.trace.spineLength root.type.view = + ctor.resultTarget block + +/-- Minimal structural input for one retained constructor root. It is +independent of a caller-selected normalized pair: positional raw/view pairing +is recovered from the successful dependent analysis, and the full component +equations follow from this total stored-binder count. -/ +structure CandidateConstructorSemanticGenerationShape + {source : VInductDecl} (env : VEnv) (Us : List Name) + {kernelSource : Constructor} + {candidate : AddInductive.CandidateConstructor kernelSource} + {raw : VConstVal} + (root : CandidateConstructorSemanticRun env Us candidate raw) where + storedSpine : candidate.type.trace.storedSpine = true + spineLength_eq : candidate.type.trace.spineLength = + (VExpr.telN source.nparams raw.type ++ + ctorFields (VExpr.dropN source.nparams raw.type)).length + +/-- Project the compatibility constructor run without rebuilding or choosing +semantic evidence. -/ +def CandidateSemanticNormalizedCtorRun.run + (run : CandidateSemanticNormalizedCtorRun block env Us root ctor) : + CandidateNormalizedCtorRun block env Us root.root ctor where + raw_eq := run.raw_eq + view_eq := run.view_eq + spine := root.type.spine run.storedSpine + rawTel := run.rawTel + rawResult := run.rawResult + viewResult := run.viewResult + +/-- The terminal alignment and the analyzer's exact constructor shape force +the candidate trace to expose the entire checked binder telescope. -/ +theorem CandidateNormalizedCtorRun.viewTel_eq + {source : VInductDecl} {generation : GenerationChecked source} + {env : VEnv} {Us : List Name} + {kernelSource : Constructor} + {candidate : AddInductive.CandidateConstructor kernelSource} + {raw : VConstVal} + {root : CandidateConstructorRun env Us candidate raw} + {ctor : NormalizedCtor} + (run : CandidateNormalizedCtorRun generation.block env Us root ctor) + (hctor : ctor ∈ generation.block.ctorPairs) : + VExpr.telN candidate.type.trace.spineLength root.viewType = + ctor.viewBinders generation.block := by + have viewType_eq : root.viewType = ctor.view.value.type := by + simpa only [CandidateConstructorRun.view] using + (congrArg (fun value : VConstVal => value.type) run.view_eq).symm + have hterminal : + TypeChecker.CandidateTerminal (ctor.resultTarget generation.block) := by + exact TypeChecker.candidateTerminal_appN_const _ _ _ + rw [viewType_eq, generation.viewCtorType_eq hctor] + apply TypeChecker.candidateTelN_of_dropN_terminal hterminal + simpa only [viewType_eq, generation.viewCtorType_eq hctor] using + run.viewResult + +/-- Extract the stored constructor's declared telescope/result evidence. -/ +def CandidateNormalizedCtorRun.declaredEvidence + {source : VInductDecl} {generation : GenerationChecked source} + {env : VEnv} {Us : List Name} + {kernelSource : Constructor} + {candidate : AddInductive.CandidateConstructor kernelSource} + {raw : VConstVal} + {root : CandidateConstructorRun env Us candidate raw} + {ctor : NormalizedCtor} + (run : CandidateNormalizedCtorRun generation.block env Us root ctor) + (hctor : ctor ∈ generation.block.ctorPairs) + (rightType : env.HasType Us.length + (ctor.declaredBinders source.nparams).reverse + (ctor.resultTarget generation.block) + (.sort generation.block.checked.resultLevel)) : + TypeChecker.TelResultDefEqEvidence env Us.length [] + (ctor.declaredBinders source.nparams) + (ctor.viewBinders generation.block) + (ctor.rawResult source.nparams) (ctor.resultTarget generation.block) + (.sort generation.block.checked.resultLevel) := by + apply run.spine.evidenceAt run.rawTel (run.viewTel_eq hctor) + run.rawResult run.viewResult rightType + +/-- The checked result spine and the candidate-certified binder telescope +determine a constructor's terminal typing judgment. The family constant is +typed once for the whole block; individual constructor fixtures supply no +additional semantic result oracle. -/ +theorem CandidateNormalizedCtorRun.rightType_ofChecked + {source : VInductDecl} {generation : GenerationChecked source} + {env : VEnv} {Us : List Name} + {kernelSource : Constructor} + {candidate : AddInductive.CandidateConstructor kernelSource} + {raw : VConstVal} + {root : CandidateConstructorRun env Us candidate raw} + {ctor : NormalizedCtor} + (run : CandidateNormalizedCtorRun generation.block env Us root ctor) + (henv : VEnv.WF env) (uvars_eq : source.uvars = Us.length) + (checked : generation.block.checked.WF env) + (familyConst : env.HasType source.uvars [] + (.const generation.block.sourceType.name + (VLevel.params source.uvars)) + generation.block.checked.type.type) + (hctor : ctor ∈ generation.block.ctorPairs) : + env.HasType Us.length + (ctor.declaredBinders source.nparams).reverse + (ctor.resultTarget generation.block) + (.sort generation.block.checked.resultLevel) := by + obtain ⟨_, evidence⟩ := run.spine.evidence + have telescope : TypeChecker.TelDefEqEvidence env Us.length [] + (ctor.declaredBinders source.nparams) + (ctor.viewBinders generation.block) := by + simpa only [run.rawTel, run.viewTel_eq hctor] using evidence.telescope + have hview := generation.checkedResultTarget_hasType + henv.ordered checked familyConst hctor + have hview' : env.HasType Us.length + (ctor.viewBinders generation.block).reverse + (ctor.resultTarget generation.block) + (.sort generation.block.checked.resultLevel) := by + simpa only [uvars_eq] using hview + have hctx : env.IsDefEqCtx Us.length [] + (ctor.declaredBinders source.nparams).reverse + (ctor.viewBinders generation.block).reverse := by + simpa using telescope.telDefEq.ctx + exact hview'.defeqDFC henv.ordered (hctx.symm henv.ordered) + +/-- Produce both constructor paths required by `NormalizedCtorRun`. + +The declared path comes directly from the constructor candidate. The emitted +path replaces the stored constructor parameter prefix by the raw family +parameter prefix, transporting fields and result through the induced +definitionally equal context. -/ +def CandidateNormalizedCtorRun.normalizedCtorRun + {source : VInductDecl} {generation : GenerationChecked source} + {env : VEnv} {Us : List Name} + {kernelSource : Constructor} + {candidate : AddInductive.CandidateConstructor kernelSource} + {raw : VConstVal} + {root : CandidateConstructorRun env Us candidate raw} + {ctor : NormalizedCtor} + (run : CandidateNormalizedCtorRun generation.block env Us root ctor) + (henv : VEnv.WF env) (uvars_eq : source.uvars = Us.length) + (familyParams : TypeChecker.TelDefEqEvidence env Us.length [] + generation.block.rawParams generation.block.checked.params) + (prefixLength : + (VExpr.telN source.nparams ctor.raw.type).length = + generation.block.checked.params.length) + (hctor : ctor ∈ generation.block.ctorPairs) + (rightType : env.HasType Us.length + (ctor.declaredBinders source.nparams).reverse + (ctor.resultTarget generation.block) + (.sort generation.block.checked.resultLevel)) : + NormalizedCtorRun generation.block ctor env := by + have declared := run.declaredEvidence hctor rightType + have declaredSplit : TypeChecker.TelResultDefEqEvidence env Us.length [] + (VExpr.telN source.nparams ctor.raw.type ++ + ctor.rawFields source.nparams) + (generation.block.checked.params ++ ctor.view.fields) + (ctor.rawResult source.nparams) (ctor.resultTarget generation.block) + (.sort generation.block.checked.resultLevel) := by + simpa only [NormalizedCtor.declaredBinders, + NormalizedCtor.viewBinders] using declared + have emitted := declaredSplit.replacePrefix henv familyParams prefixLength + exact { + declaredTel := by + simpa only [uvars_eq] using declared.telescope + declaredResult := by + simpa only [uvars_eq, List.append_nil] using declared.result + emittedTel := by + simpa only [uvars_eq, NormalizedCtor.emittedBinders, + NormalizedCtor.viewBinders] using emitted.telescope + emittedResult := by + simpa only [uvars_eq, NormalizedCtor.emittedBinders, + List.append_nil] using emitted.result } + +/-- Dependent positional alignment between every constructor candidate run +and every normalized constructor pair. The indices make unequal lengths, +reordering, and evidence reuse at a different source position impossible. -/ +inductive CandidateNormalizedCtorListRun {source : VInductDecl} + (block : NormalizedChecked source) (env : VEnv) (Us : List Name) : + {kernelSources : List Constructor} → + {candidates : AddInductive.CandidateList + AddInductive.CandidateConstructor kernelSources} → + {raws : List VConstVal} → + (roots : CandidateConstructorListRun env Us candidates raws) → + List NormalizedCtor → Type where + | nil : CandidateNormalizedCtorListRun block env Us .nil [] + | cons + (head : CandidateNormalizedCtorRun block env Us root ctor) + (tail : CandidateNormalizedCtorListRun block env Us roots ctors) : + CandidateNormalizedCtorListRun block env Us + (.cons root roots) (ctor :: ctors) + +/-- Dependent positional generation alignment over the retained constructor +semantic list. Its projection below is definitionally tied to +`roots.roots`, so source order and the exact normalization views cannot drift +between phases. -/ +inductive CandidateSemanticNormalizedCtorListRun {source : VInductDecl} + (block : NormalizedChecked source) (env : VEnv) (Us : List Name) : + {kernelSources : List Constructor} → + {candidates : AddInductive.CandidateList + AddInductive.CandidateConstructor kernelSources} → + {raws : List VConstVal} → + (roots : CandidateConstructorSemanticListRun env Us candidates raws) → + List NormalizedCtor → Type where + | nil : CandidateSemanticNormalizedCtorListRun block env Us .nil [] + | cons + (head : CandidateSemanticNormalizedCtorRun block env Us root ctor) + (tail : CandidateSemanticNormalizedCtorListRun block env Us roots ctors) : + CandidateSemanticNormalizedCtorListRun block env Us + (.cons root roots) (ctor :: ctors) + +/-- Source-indexed structural generation inputs for every retained semantic +constructor root. No normalized constructor list occurs in this type, so a +caller cannot choose, reorder, truncate, or duplicate the analyzer's pairs. -/ +inductive CandidateConstructorSemanticGenerationShapeList + (source : VInductDecl) (env : VEnv) (Us : List Name) : + {kernelSources : List Constructor} → + {candidates : AddInductive.CandidateList + AddInductive.CandidateConstructor kernelSources} → + {raws : List VConstVal} → + (roots : CandidateConstructorSemanticListRun env Us candidates raws) → + Type where + | nil : CandidateConstructorSemanticGenerationShapeList source env Us .nil + | cons + (head : CandidateConstructorSemanticGenerationShape + (source := source) env Us root) + (tail : CandidateConstructorSemanticGenerationShapeList + source env Us roots) : + CandidateConstructorSemanticGenerationShapeList source env Us + (.cons root roots) + +/-- Executable generation-layout check for a complete source-indexed +constructor candidate list. + +The check is intentionally stated against the raw Theory constants retained +by the semantic hierarchy. It accepts exactly when every candidate WHNF trace +preserves the stored main Pi spine and traverses the complete raw constructor +telescope. List-length mismatches are rejected explicitly; no `zip` or +positional lookup can silently truncate either side. -/ +def candidateConstructorSemanticGenerationShape + (source : VInductDecl) : + {kernelSources : List Constructor} → + AddInductive.CandidateList AddInductive.CandidateConstructor + kernelSources → + List VConstVal → Bool + | _, .nil, [] => true + | _, .nil, _ :: _ => false + | _, .cons _ _, [] => false + | _, .cons candidate candidates, raw :: raws => + candidate.type.trace.storedSpine && + candidate.type.trace.spineLength == + (VExpr.telN source.nparams raw.type ++ + ctorFields (VExpr.dropN source.nparams raw.type)).length && + candidateConstructorSemanticGenerationShape source candidates raws + +/-- Executable generation-layout check for a complete singleton +normalization candidate and its raw Theory family. + +This definition is independent of semantic proofs. It checks only the +source-indexed candidate traces against the raw family/constructor telescope +layout that generation would emit. Verify's retained semantic hierarchy +later reindexes the same Boolean onto its exact raw family. -/ +def normalizationCandidateGenerationShape + {kernelSource : InductiveType} + (source : VInductDecl) (raw : VInductiveType) + (candidate : AddInductive.NormalizationCandidate [kernelSource]) : Bool := + let familyTrace := + candidate.families.singleton.familyType.type.trace + (familyTrace.storedSpine && + familyTrace.spineLength == + (VExpr.telN source.nparams raw.type ++ + ctorFields (VExpr.dropN source.nparams raw.type)).length) && + candidateConstructorSemanticGenerationShape source + candidate.families.singleton.constructors raw.ctors + +/-- One executable constructor-list shape check determines every dependent +per-position shape record required by semantic generation. -/ +def CandidateConstructorSemanticGenerationShapeList.ofCheck + {source : VInductDecl} {env : VEnv} {Us : List Name} + {kernelSources : List Constructor} + {candidates : AddInductive.CandidateList + AddInductive.CandidateConstructor kernelSources} + {raws : List VConstVal} + (roots : CandidateConstructorSemanticListRun env Us candidates raws) + (shape : candidateConstructorSemanticGenerationShape + source candidates raws = true) : + CandidateConstructorSemanticGenerationShapeList source env Us roots := + match roots with + | .nil => .nil + | .cons head tail => by + simp only [candidateConstructorSemanticGenerationShape, + Bool.and_eq_true, beq_iff_eq] at shape + exact .cons { + storedSpine := shape.1.1 + spineLength_eq := shape.1.2 } + (CandidateConstructorSemanticGenerationShapeList.ofCheck + tail shape.2) +termination_by sizeOf roots + +/-- Forget only retained semantic ownership and recover the existing +generation-facing positional list. -/ +def CandidateSemanticNormalizedCtorListRun.run : + (semantic : CandidateSemanticNormalizedCtorListRun + block env Us roots ctors) → + CandidateNormalizedCtorListRun block env Us roots.roots ctors + | .nil => .nil + | .cons head tail => .cons head.run tail.run + +/-- Assemble a `NormalizedCtorRun` for every constructor in an exact +dependent positional list. -/ +theorem CandidateNormalizedCtorListRun.normalizedCtorRuns + {source : VInductDecl} {generation : GenerationChecked source} + {env : VEnv} {Us : List Name} + {kernelSources : List Constructor} + {candidates : AddInductive.CandidateList + AddInductive.CandidateConstructor kernelSources} + {raws : List VConstVal} + {roots : CandidateConstructorListRun env Us candidates raws} + {ctors : List NormalizedCtor} + (run : CandidateNormalizedCtorListRun generation.block env Us roots ctors) + (henv : VEnv.WF env) (uvars_eq : source.uvars = Us.length) + (familyParams : TypeChecker.TelDefEqEvidence env Us.length [] + generation.block.rawParams generation.block.checked.params) + (checked : generation.block.checked.WF env) + (familyConst : env.HasType source.uvars [] + (.const generation.block.sourceType.name + (VLevel.params source.uvars)) + generation.block.checked.type.type) + (pairMembership : ∀ ctor ∈ ctors, + ctor ∈ generation.block.ctorPairs) + (prefixLengths : ∀ ctor ∈ ctors, + (VExpr.telN source.nparams ctor.raw.type).length = + generation.block.checked.params.length) : + ∀ ctor ∈ ctors, NormalizedCtorRun generation.block ctor env := by + induction run with + | nil => intro ctor hctor; simp at hctor + | cons head tail ih => + intro ctor hctor + simp only [List.mem_cons] at hctor + rcases hctor with rfl | hctor + · exact head.normalizedCtorRun henv uvars_eq familyParams + (prefixLengths _ (.head _)) + (pairMembership _ (.head _)) + (head.rightType_ofChecked henv uvars_eq checked familyConst + (pairMembership _ (.head _))) + · exact ih + (fun ctor hctor => pairMembership ctor (.tail _ hctor)) + (fun ctor hctor => prefixLengths ctor (.tail _ hctor)) + ctor hctor + +/-- Complete source-indexed candidate certificate for one generation-ready +singleton inductive declaration. + +`analysis` records that the candidate-derived normalization produced this exact +dependent generation result. `constructors` then aligns every post-family +candidate run with the corresponding dependent analyzer pair. -/ +structure GenerationCandidateRun + {kernelSource : InductiveType} {source : VInductDecl} + {candidate : AddInductive.NormalizationCandidate [kernelSource]} + (normalization : NormalizationCandidateRun env Us candidate source) + (generation : GenerationChecked source) where + analysis : normalization.normalization.generation? = some generation + checked : generation.block.checked.WF env + family : CandidateFamilyGenerationRun normalization generation + constructors : CandidateNormalizedCtorListRun generation.block + normalization.family.typeEnv Us normalization.family.constructors + generation.block.ctorPairs + +/-- Complete generation assembly owned by one retained semantic hierarchy. + +This is the no-parallel-run form of `GenerationCandidateRun`: family and +constructor spines are projections of `normalization`, while `analysis` retains +the exact dependent analyzer result consumed by Theory generation. -/ +structure GenerationCandidateSemanticRun + {kernelSource : InductiveType} {source : VInductDecl} + {candidate : AddInductive.NormalizationCandidate [kernelSource]} + (normalization : NormalizationCandidateSemanticRun env Us candidate source) + (generation : GenerationChecked source) where + analysis : normalization.root.normalization.generation? = some generation + checked : generation.block.checked.WF env + family : CandidateFamilySemanticGenerationRun normalization generation + constructors : CandidateSemanticNormalizedCtorListRun generation.block + normalization.family.typeEnv Us normalization.family.constructors + generation.block.ctorPairs + +/-- Complete semantic-generation input with all analyzer-determined component +equations erased. Compared with `GenerationCandidateSemanticRun`, this form +retains only checked semantics plus the executable stored-spine/length shape +for each source-indexed root. Its projection below reconstructs the exact +family and dependent constructor alignment from `analysis`. -/ +structure GenerationCandidateSemanticShapeRun + {kernelSource : InductiveType} {source : VInductDecl} + {candidate : AddInductive.NormalizationCandidate [kernelSource]} + (normalization : NormalizationCandidateSemanticRun env Us candidate source) + (generation : GenerationChecked source) where + analysis : normalization.root.normalization.generation? = some generation + checked : generation.block.checked.WF env + family : CandidateFamilySemanticGenerationShape normalization generation + constructors : CandidateConstructorSemanticGenerationShapeList source + normalization.family.typeEnv Us normalization.family.constructors + +/-- One executable structural gate for the complete retained singleton +candidate hierarchy. + +The family check uses the complete raw parameter/index telescope. The +constructor check traverses the source-indexed candidate and raw lists +dependently. This consolidates the former per-fixture family and constructor +proof records into one computation while remaining separate from semantic +authority and dependent analysis. -/ +def NormalizationCandidateSemanticRun.generationShape + {env : VEnv} {Us : List Name} + {kernelSource : InductiveType} {source : VInductDecl} + {candidate : AddInductive.NormalizationCandidate [kernelSource]} + (normalization : NormalizationCandidateSemanticRun env Us candidate source) : + Bool := + normalizationCandidateGenerationShape source normalization.raw candidate + +/-- One successful outer candidate together with the executable structural +gate required before mixed raw/view generation. + +The record carries the exact ordinary producer equation, so the shape check +cannot be reused for a different candidate. It remains operational evidence: +semantic authority is supplied only after Verify interprets the retained +checker executions. -/ +structure ProducedGenerationShapeCandidate + (source : VInductDecl) (raw : VInductiveType) + (kernelSource : InductiveType) (numNested : Nat) (isUnsafe : Bool) + (context : AddInductive.Context) where + candidate : AddInductive.NormalizationCandidate [kernelSource] + produced : + AddInductive.buildNormalizationCandidate source.nparams + [kernelSource] numNested isUnsafe context = .ok candidate + shape : normalizationCandidateGenerationShape source raw candidate = true + +/-- Run the ordinary outer producer and immediately reject candidates whose +retained traces cannot support mixed generation of the supplied raw Theory +family. The successful result retains both exact producer provenance and the +single complete shape proof. -/ +def produceGenerationShapeCandidate + (source : VInductDecl) (raw : VInductiveType) + (kernelSource : InductiveType) (numNested : Nat) (isUnsafe : Bool) + (context : AddInductive.Context) : + Except Exception (ProducedGenerationShapeCandidate source raw kernelSource + numNested isUnsafe context) := + match produced : AddInductive.buildNormalizationCandidate source.nparams + [kernelSource] numNested isUnsafe context with + | .error error => .error error + | .ok candidate => + if shape : normalizationCandidateGenerationShape source raw candidate then + .ok { candidate, produced, shape } + else + .error (.other + "normalization candidate does not preserve the generation spine") + +private theorem produceGenerationShapeCandidate_match_ok + {source : VInductDecl} {raw : VInductiveType} + {kernelSource : InductiveType} {numNested : Nat} {isUnsafe : Bool} + {context : AddInductive.Context} + (result : Except Exception + (AddInductive.NormalizationCandidate [kernelSource])) + (toProduced : ∀ actual, result = .ok actual → + AddInductive.buildNormalizationCandidate source.nparams + [kernelSource] numNested isUnsafe context = .ok actual) + {candidate : AddInductive.NormalizationCandidate [kernelSource]} + (result_ok : result = .ok candidate) + (shape : normalizationCandidateGenerationShape source raw candidate = true) : + (match result_eq : result with + | .error error => Except.error error + | .ok actual => + if actualShape : normalizationCandidateGenerationShape source raw actual then + Except.ok (show ProducedGenerationShapeCandidate source raw kernelSource + numNested isUnsafe context from { + candidate := actual + produced := toProduced actual result_eq + shape := actualShape }) + else + Except.error (.other + "normalization candidate does not preserve the generation spine")) = + Except.ok (show ProducedGenerationShapeCandidate source raw kernelSource + numNested isUnsafe context from { + candidate + produced := toProduced candidate result_ok + shape }) := by + subst result + simp [shape] + +/-- A successful ordinary producer equation and successful hierarchy-shape +check determine the exact successful result of the strengthened producer. + +Keeping this dependent-match elimination here avoids repeating proof-carrying +`Except` reasoning in clients. -/ +theorem produceGenerationShapeCandidate_eq_ok + {source : VInductDecl} {raw : VInductiveType} + {kernelSource : InductiveType} {numNested : Nat} {isUnsafe : Bool} + {context : AddInductive.Context} + {candidate : AddInductive.NormalizationCandidate [kernelSource]} + (produced : + AddInductive.buildNormalizationCandidate source.nparams + [kernelSource] numNested isUnsafe context = .ok candidate) + (shape : normalizationCandidateGenerationShape source raw candidate = true) : + produceGenerationShapeCandidate source raw kernelSource numNested isUnsafe + context = + .ok { candidate, produced, shape } := by + unfold produceGenerationShapeCandidate + exact produceGenerationShapeCandidate_match_ok + (result := AddInductive.buildNormalizationCandidate source.nparams + [kernelSource] numNested isUnsafe context) + (toProduced := fun _ result_eq => result_eq) produced shape + +/-- Project the established generation assembler. Every normalization root, +view, and recursive spine remains definitionally tied to the semantic owner. -/ +def GenerationCandidateSemanticRun.run + (run : GenerationCandidateSemanticRun normalization generation) : + GenerationCandidateRun normalization.root generation where + analysis := run.analysis + checked := run.checked + family := run.family.run + constructors := run.constructors.run + +/-- A retained analyzer result necessarily contains the normalization that was +analyzed. This is derived from `analysis`, rather than supplied by fixtures. -/ +theorem GenerationCandidateRun.normalization_eq + {env : VEnv} {Us : List Name} + {kernelSource : InductiveType} {source : VInductDecl} + {candidate : AddInductive.NormalizationCandidate [kernelSource]} + {normalization : NormalizationCandidateRun env Us candidate source} + {generation : GenerationChecked source} + (run : GenerationCandidateRun normalization generation) : + generation.block.normalization = normalization.normalization := + Normalization.generation?_normalization run.analysis + +/-- The source-indexed singleton declarations force the analyzer's raw family +to be the exact family retained by a normalization candidate. -/ +theorem NormalizationCandidateRun.sourceType_eq + {env : VEnv} {Us : List Name} + {kernelSource : InductiveType} {source : VInductDecl} + {candidate : AddInductive.NormalizationCandidate [kernelSource]} + (normalization : NormalizationCandidateRun env Us candidate source) + (generation : GenerationChecked source) : + generation.block.sourceType = normalization.raw := by + have h : [generation.block.sourceType] = [normalization.raw] := + generation.block.source_types_eq.symm.trans normalization.raw_types_eq + injection h + +/-- Exact dependent analysis selects the reconstructed family view, including +its constructor list, not merely an expression payload with the same type. -/ +theorem NormalizationCandidateRun.familyViewType_eq + {env : VEnv} {Us : List Name} + {kernelSource : InductiveType} {source : VInductDecl} + {candidate : AddInductive.NormalizationCandidate [kernelSource]} + {normalization : NormalizationCandidateRun env Us candidate source} + {generation : GenerationChecked source} + (analysis : normalization.normalization.generation? = some generation) : + generation.block.checked.type = normalization.family.view := by + have normalization_eq : generation.block.normalization = + normalization.normalization := + Normalization.generation?_normalization analysis + have hviews := congrArg (fun norm : Normalization source => norm.view.types) + normalization_eq + have htypes : [generation.block.checked.type] = + [normalization.family.view] := by + calc + [generation.block.checked.type] = + generation.block.normalization.view.types := + generation.block.checked.types_eq.symm + _ = normalization.normalization.view.types := hviews + _ = [normalization.family.view] := rfl + injection htypes + +/-- The retained dependent analysis necessarily checks the exact family view +selected by the normalization candidate. This equation is a consequence of +the two singleton declaration indices and `normalization_eq`, not a separate +fixture alignment premise. -/ +theorem GenerationCandidateRun.familyView_eq + {env : VEnv} {Us : List Name} + {kernelSource : InductiveType} {source : VInductDecl} + {candidate : AddInductive.NormalizationCandidate [kernelSource]} + {normalization : NormalizationCandidateRun env Us candidate source} + {generation : GenerationChecked source} + (run : GenerationCandidateRun normalization generation) : + normalization.family.viewType = generation.block.checked.type.type := by + exact (congrArg (fun ty : VInductiveType => ty.type) + (normalization.familyViewType_eq run.analysis)).symm + +/-- Taking the exact length of the complete stored telescope recovers both +its binder list and its non-forall result. This is the structural bridge from +one numeric trace invariant to generation's named raw components. -/ +private theorem generationTelNForallNLength : + ∀ (As : List VExpr) (B : VExpr), + VExpr.telN As.length (VExpr.forallN As B) = As + | [], _ => rfl + | _ :: As, B => by + simp only [List.length_cons, VExpr.forallN, VExpr.telN, + generationTelNForallNLength As B] + +private theorem generationDropNForallNLength : + ∀ (As : List VExpr) (B : VExpr), + VExpr.dropN As.length (VExpr.forallN As B) = B + | [], _ => rfl + | _ :: As, B => by + simp only [List.length_cons, VExpr.forallN, VExpr.dropN, + generationDropNForallNLength As B] + +private theorem candidateFullTelComponents (np n : Nat) (e : VExpr) + (h : n = + (VExpr.telN np e ++ ctorFields (VExpr.dropN np e)).length) : + VExpr.telN n e = + VExpr.telN np e ++ ctorFields (VExpr.dropN np e) ∧ + VExpr.dropN n e = VExpr.resultOf (VExpr.dropN np e) := by + let As := VExpr.telN np e ++ ctorFields (VExpr.dropN np e) + have he : + VExpr.forallN As (VExpr.resultOf (VExpr.dropN np e)) = e := by + simp only [As, VExpr.forallN_append, + forallN_ctorFields_resultOf, VExpr.forallN_telN_dropN] + let B := VExpr.resultOf (VExpr.dropN np e) + have hAs : n = As.length := h + change VExpr.telN n e = As ∧ VExpr.dropN n e = B + rw [hAs, ← he] + exact ⟨generationTelNForallNLength _ _, + generationDropNForallNLength _ _⟩ + +/-- Derive every family component equation from the minimal structural shape +and the exact dependent analyzer result. -/ +private def CandidateFamilySemanticGenerationShape.generationRun + {env : VEnv} {Us : List Name} + {kernelSource : InductiveType} {source : VInductDecl} + {candidate : AddInductive.NormalizationCandidate [kernelSource]} + {normalization : NormalizationCandidateSemanticRun env Us candidate source} + {generation : GenerationChecked source} + (input : CandidateFamilySemanticGenerationShape + normalization generation) + (analysis : normalization.root.normalization.generation? = + some generation) : + CandidateFamilySemanticGenerationRun normalization generation where + storedSpine := input.storedSpine + rawTel := by + have components := candidateFullTelComponents source.nparams + candidate.families.singleton.familyType.type.trace.spineLength + normalization.raw.type (by + simpa only [NormalizedChecked.rawParams, + NormalizedChecked.rawIndices, + NormalizationCandidateSemanticRun.root, + normalization.root.sourceType_eq generation] using + input.spineLength_eq) + simpa only [NormalizedChecked.rawParams, + NormalizedChecked.rawIndices, + NormalizationCandidateSemanticRun.root, + normalization.root.sourceType_eq generation] using components.1 + rawResult := by + have components := candidateFullTelComponents source.nparams + candidate.families.singleton.familyType.type.trace.spineLength + normalization.raw.type (by + simpa only [NormalizedChecked.rawParams, + NormalizedChecked.rawIndices, + NormalizationCandidateSemanticRun.root, + normalization.root.sourceType_eq generation] using + input.spineLength_eq) + simpa only [NormalizedChecked.rawResult, + NormalizationCandidateSemanticRun.root, + normalization.root.sourceType_eq generation] using components.2 + viewResult := by + let As := generation.block.checked.params ++ + generation.block.checked.indices + have hlength : + candidate.families.singleton.familyType.type.trace.spineLength = + As.length := by + rw [input.spineLength_eq] + simp only [As, List.length_append] + rw [generation.shape.2.1, generation.shape.2.2.1] + have hview : normalization.family.type.view = + generation.block.checked.type.type := by + simpa only [NormalizationCandidateSemanticRun.root, + CandidateFamilySemanticRun.root, CandidateFamilyRun.view] using + (congrArg (fun ty : VInductiveType => ty.type) + (normalization.root.familyViewType_eq analysis)).symm + rw [hview, generation.block.checked.type_eq, hlength] + simpa only [As, VExpr.forallN_append] using + generationDropNForallNLength As + (.sort generation.block.checked.resultLevel) + +/-- Derive one normalized constructor alignment after its positional raw/view +equalities have been recovered from the analyzer-owned pair list. -/ +private def CandidateConstructorSemanticGenerationShape.generationRun + {source : VInductDecl} {generation : GenerationChecked source} + {env : VEnv} {Us : List Name} + {kernelSource : Constructor} + {candidate : AddInductive.CandidateConstructor kernelSource} + {raw : VConstVal} + {root : CandidateConstructorSemanticRun env Us candidate raw} + {ctor : NormalizedCtor} + (input : CandidateConstructorSemanticGenerationShape + (source := source) env Us root) + (raw_eq : ctor.raw = raw) + (view_eq : ctor.view.value = root.root.view) + (hctor : ctor ∈ generation.block.ctorPairs) : + CandidateSemanticNormalizedCtorRun generation.block env Us root ctor where + raw_eq := raw_eq + view_eq := view_eq + storedSpine := input.storedSpine + rawTel := by + have components := candidateFullTelComponents source.nparams + candidate.type.trace.spineLength raw.type input.spineLength_eq + simpa only [NormalizedCtor.declaredBinders, + NormalizedCtor.rawFields, raw_eq] using components.1 + rawResult := by + have components := candidateFullTelComponents source.nparams + candidate.type.trace.spineLength raw.type input.spineLength_eq + simpa only [NormalizedCtor.rawResult, raw_eq] using components.2 + viewResult := by + let As := generation.block.checked.params ++ ctor.view.fields + have hlength : candidate.type.trace.spineLength = As.length := by + rw [input.spineLength_eq] + simp only [As, List.length_append] + rw [← raw_eq] + have hshape := generation.shape.2.2.2.2.2 ctor hctor + simp only [NormalizedCtor.rawFields] at hshape + rw [hshape.2.2.1, hshape.2.2.2, + generation.shape.1.symm.trans generation.shape.2.1] + have viewType_eq : root.type.view = ctor.view.value.type := by + exact (congrArg (fun value : VConstVal => value.type) view_eq).symm + rw [viewType_eq, generation.viewCtorType_eq hctor, hlength] + exact generationDropNForallNLength As _ + +/-- Recursively align structural constructor inputs with a pair list whose raw +and checked-value projections are already fixed. -/ +private def + CandidateConstructorSemanticGenerationShapeList.generationRuns + {source : VInductDecl} {generation : GenerationChecked source} + {env : VEnv} {Us : List Name} + {kernelSources : List Constructor} + {candidates : AddInductive.CandidateList + AddInductive.CandidateConstructor kernelSources} + {raws : List VConstVal} + {roots : CandidateConstructorSemanticListRun env Us candidates raws} : + (input : CandidateConstructorSemanticGenerationShapeList + source env Us roots) → + (ctors : List NormalizedCtor) → + (raws_eq : ctors.map (·.raw) = raws) → + (views_eq : ctors.map (fun ctor => ctor.view.value) = + roots.roots.views) → + (membership : ∀ ctor ∈ ctors, + ctor ∈ generation.block.ctorPairs) → + CandidateSemanticNormalizedCtorListRun generation.block env Us roots ctors + | .nil, [], _, _, _ => .nil + | .nil, _ :: _, raws_eq, _, _ => by simp at raws_eq + | .cons _ _, [], raws_eq, _, _ => by simp at raws_eq + | .cons head tail, ctor :: ctors, raws_eq, views_eq, membership => by + simp only [List.map_cons, List.cons.injEq] at raws_eq + simp only [List.map_cons, + CandidateConstructorSemanticListRun.roots, + CandidateConstructorListRun.views, List.cons.injEq] at views_eq + exact .cons + (head.generationRun raws_eq.1 views_eq.1 + (membership ctor (.head _))) + (tail.generationRuns ctors raws_eq.2 views_eq.2 + (fun ctor hctor => membership ctor (.tail _ hctor))) + +/-- Exact analysis determines the complete dependent normalized-constructor +list from source-indexed semantic roots and their minimal structural shapes. -/ +private def + CandidateConstructorSemanticGenerationShapeList.ofAnalysis + {env : VEnv} {Us : List Name} + {kernelSource : InductiveType} {source : VInductDecl} + {candidate : AddInductive.NormalizationCandidate [kernelSource]} + {normalization : NormalizationCandidateSemanticRun env Us candidate source} + {generation : GenerationChecked source} + (input : CandidateConstructorSemanticGenerationShapeList source + normalization.family.typeEnv Us normalization.family.constructors) + (analysis : normalization.root.normalization.generation? = + some generation) : + CandidateSemanticNormalizedCtorListRun generation.block + normalization.family.typeEnv Us normalization.family.constructors + generation.block.ctorPairs := by + apply input.generationRuns + · simpa only [NormalizationCandidateSemanticRun.root, + normalization.root.sourceType_eq generation] using + generation.rawCtors_eq + · have viewType_eq := normalization.root.familyViewType_eq analysis + calc + generation.block.ctorPairs.map (fun ctor => ctor.view.value) = + generation.block.checked.constructors.map (·.value) := by + simpa only [List.map_map, Function.comp_def] using + congrArg (List.map (·.value)) generation.viewCtors_eq + _ = generation.block.checked.type.ctors := by + rw [generation.block.checked.constructors_eq, List.map_map] + change generation.block.checked.type.ctors.map (fun c => c) = _ + exact List.map_id' generation.block.checked.type.ctors + _ = normalization.family.root.view.ctors := by + simpa only [NormalizationCandidateSemanticRun.root] using + congrArg (fun ty : VInductiveType => ty.ctors) viewType_eq + _ = normalization.family.constructors.roots.views := rfl + · exact fun _ hctor => hctor + +/-- Reconstruct the established semantic-generation run from the reduced +shape boundary. No raw/view pair or component equation is supplied here. -/ +def GenerationCandidateSemanticShapeRun.run + {env : VEnv} {Us : List Name} + {kernelSource : InductiveType} {source : VInductDecl} + {candidate : AddInductive.NormalizationCandidate [kernelSource]} + {normalization : NormalizationCandidateSemanticRun env Us candidate source} + {generation : GenerationChecked source} + (input : GenerationCandidateSemanticShapeRun normalization generation) : + GenerationCandidateSemanticRun normalization generation where + analysis := input.analysis + checked := input.checked + family := input.family.generationRun input.analysis + constructors := input.constructors.ofAnalysis input.analysis + +/-- Build the reduced semantic generation owner from exact dependent +analysis, semantic WF of the analyzer-owned view declaration, and the single +executable hierarchy shape check. + +`checked` is derived from the exact declaration analyzed by `generation?`; +callers no longer provide a parallel `Checked.WF` value. Likewise, the +family and all constructor shape records are projections of one complete +source-indexed Boolean gate. -/ +def GenerationCandidateSemanticRun.ofGenerationShape + {env : VEnv} {Us : List Name} + {kernelSource : InductiveType} {source : VInductDecl} + {candidate : AddInductive.NormalizationCandidate [kernelSource]} + (normalization : NormalizationCandidateSemanticRun env Us candidate source) + (generation : GenerationChecked source) + (analysis : normalization.root.normalization.generation? = + some generation) + (viewWF : normalization.root.viewDecl.WF env) + (shape : normalization.generationShape = true) : + GenerationCandidateSemanticRun normalization generation := by + simp only [NormalizationCandidateSemanticRun.generationShape, + normalizationCandidateGenerationShape, Bool.and_eq_true, + beq_iff_eq] at shape + have sourceType_eq : generation.block.sourceType = normalization.raw := by + simpa only [NormalizationCandidateSemanticRun.root] using + normalization.root.sourceType_eq generation + have normalization_eq : generation.block.normalization = + normalization.root.normalization := + Normalization.generation?_normalization analysis + have view_eq : generation.block.normalization.view = + normalization.root.viewDecl := by + simpa only [NormalizationCandidateRun.normalization] using + congrArg (fun norm : Normalization source => norm.view) + normalization_eq + have checked : generation.block.checked.WF env := + generation.block.checked.wf_of_decl (by + rw [view_eq] + exact viewWF) + apply GenerationCandidateSemanticShapeRun.run { + analysis := analysis + checked := checked + family := { + storedSpine := shape.1.1 + spineLength_eq := by + simpa only [NormalizedChecked.rawParams, + NormalizedChecked.rawIndices, sourceType_eq] using shape.1.2 } + constructors := + CandidateConstructorSemanticGenerationShapeList.ofCheck + normalization.family.constructors shape.2 } + +/-- Reconstruct well-formedness of the post-family environment from the +retained pre-family context, candidate raw/view equality, checked family view, +and exact raw-family insertion. Fixtures therefore do not supply this semantic +consequence independently. -/ +theorem GenerationCandidateRun.typeEnv_wf + {env : VEnv} {Us : List Name} + {kernelSource : InductiveType} {source : VInductDecl} + {candidate : AddInductive.NormalizationCandidate [kernelSource]} + {normalization : NormalizationCandidateRun env Us candidate source} + {generation : GenerationChecked source} + (run : GenerationCandidateRun normalization generation) : + VEnv.WF normalization.family.typeEnv := by + have henv : VEnv.WF env := by + simpa only [normalization.family.typeRun.venv_eq] using + normalization.family.typeRun.contextRun.context.Ewf + obtain ⟨_, hfamily⟩ := normalization.family.typeRun.evidence + have hview : env.IsType Us.length [] normalization.family.viewType := by + simpa only [← generation.block.uvars_eq, normalization.uvars_eq, + run.familyView_eq] using run.checked.family_isType + have hraw : env.IsType Us.length [] normalization.raw.type := + VEnv.IsType.defeqU_l henv trivial hfamily.isDefEq.toU.symm hview + have hrawWF : normalization.raw.toVConstant.WF env := by + show env.IsType normalization.raw.uvars [] normalization.raw.type + simpa only [normalization.family.uvars_eq] using hraw + obtain ⟨ds, hds⟩ := henv + exact ⟨.axiom normalization.raw.toVConstVal :: ds, + .decl (.axiom hrawWF normalization.family.addType) hds⟩ + +/-- Type the raw family constant at the analyzer-selected family view in the +post-family environment. The proof combines the exact raw insertion, the +candidate's whole-family equality, and checked family well-formedness once; +constructors can then share this result. -/ +theorem GenerationCandidateRun.familyConst_hasType + {env : VEnv} {Us : List Name} + {kernelSource : InductiveType} {source : VInductDecl} + {candidate : AddInductive.NormalizationCandidate [kernelSource]} + {normalization : NormalizationCandidateRun env Us candidate source} + {generation : GenerationChecked source} + (run : GenerationCandidateRun normalization generation) : + normalization.family.typeEnv.HasType source.uvars [] + (.const generation.block.sourceType.name + (VLevel.params source.uvars)) + generation.block.checked.type.type := by + have sourceType_eq : generation.block.sourceType = normalization.raw := by + have h : [generation.block.sourceType] = [normalization.raw] := + generation.block.source_types_eq.symm.trans normalization.raw_types_eq + injection h + have hlookup : normalization.family.typeEnv.constants + normalization.raw.name = some normalization.raw.toVConstant := + VEnv.addConst_self normalization.family.addType + have hconstRaw := VEnv.HasType.const0 hlookup + (run.typeEnv_wf.ordered.constWF hlookup) + have hconstRaw' : normalization.family.typeEnv.HasType Us.length [] + (.const normalization.raw.name (VLevel.params Us.length)) + normalization.raw.type := by + simpa only [normalization.family.uvars_eq] using hconstRaw + obtain ⟨_, hfamily⟩ := normalization.family.typeRun.evidence + have hchecked := run.checked.mono + (VEnv.addConst_le normalization.family.addType) + have hviewType : normalization.family.typeEnv.IsType Us.length [] + normalization.family.viewType := by + simpa only [← generation.block.uvars_eq, normalization.uvars_eq, + run.familyView_eq] using hchecked.family_isType + obtain ⟨_, hviewType⟩ := hviewType + have hfamilyExact := + (hfamily.isDefEq.toU.mono + (VEnv.addConst_le normalization.family.addType)).of_r + run.typeEnv_wf trivial hviewType + have hconstView : normalization.family.typeEnv.HasType Us.length [] + (.const normalization.raw.name (VLevel.params Us.length)) + normalization.family.viewType := + hfamilyExact.defeq hconstRaw' + simpa only [normalization.uvars_eq, sourceType_eq, + run.familyView_eq] using hconstView + +/-- Assemble the existing checker-side `GenerationRun` entirely from the +source-indexed normalization candidate and its exact spine certificates. -/ +def GenerationCandidateRun.generationRun + {env : VEnv} {Us : List Name} + {kernelSource : InductiveType} {source : VInductDecl} + {candidate : AddInductive.NormalizationCandidate [kernelSource]} + {normalization : NormalizationCandidateRun env Us candidate source} + {generation : GenerationChecked source} + (run : GenerationCandidateRun normalization generation) : + GenerationRun generation env := by + have familyEvidence := run.family.evidence run.familyView_eq + have familyParams : TypeChecker.TelDefEqEvidence env Us.length [] + generation.block.rawParams generation.block.checked.params := by + apply TypeChecker.TelDefEqEvidence.ofTelDefEq + simpa [generation.shape.2.1] using + familyEvidence.telescope.telDefEq.take + generation.block.rawParams.length + have familyParamsTypeEnv := familyParams.mono + (VEnv.addConst_le normalization.family.addType) + have sourceType_eq : generation.block.sourceType = normalization.raw := by + have h : [generation.block.sourceType] = [normalization.raw] := + generation.block.source_types_eq.symm.trans normalization.raw_types_eq + injection h + refine { + normalization := by + simpa only [run.normalization_eq] using + normalization.normalizationRun + checked := run.checked + familyTel := by + simpa only [normalization.uvars_eq] using familyEvidence.telescope + familyResult := by + simpa only [normalization.uvars_eq, List.append_nil] using + familyEvidence.result + typeEnv := normalization.family.typeEnv + addType := by + simpa only [sourceType_eq] using normalization.family.addType + constructors := ?_ } + apply run.constructors.normalizedCtorRuns run.typeEnv_wf + normalization.uvars_eq familyParamsTypeEnv + (run.checked.mono (VEnv.addConst_le normalization.family.addType)) + run.familyConst_hasType (fun _ hctor => hctor) + intro ctor hctor + exact (generation.shape.2.2.2.2.2 ctor hctor).2.2.1.trans + (generation.shape.1.symm.trans generation.shape.2.1) + +/-- Public Theory boundary for a complete source-indexed generation +candidate. -/ +theorem GenerationCandidateRun.wf + {env : VEnv} {Us : List Name} + {kernelSource : InductiveType} {source : VInductDecl} + {candidate : AddInductive.NormalizationCandidate [kernelSource]} + {normalization : NormalizationCandidateRun env Us candidate source} + {generation : GenerationChecked source} + (run : GenerationCandidateRun normalization generation) : + generation.WF env := + run.generationRun.wf + +/-- Complete dependent semantic package for one Verify-side singleton +candidate. + +`kernelSource` and `candidate` retain the exact implementation metadata and +source-indexed operational trace. `normalization` ties that trace to the raw +Theory declaration and its reconstructed view. `generation` is the successful +dependent analysis, and `run` proves that this exact candidate supplies every +semantic obligation consumed by mixed artifact generation. No independently +chosen view can be inserted into this package. -/ +structure GenerationCandidatePackage (env : VEnv) (Us : List Name) where + kernelSource : InductiveType + source : VInductDecl + candidate : AddInductive.NormalizationCandidate [kernelSource] + normalization : NormalizationCandidateRun env Us candidate source + generation : GenerationChecked source + run : GenerationCandidateRun normalization generation + +/-- Package an already assembled source-indexed candidate run without +repeating any of its dependent indices at a call site. -/ +def GenerationCandidateRun.package + {env : VEnv} {Us : List Name} + {kernelSource : InductiveType} {source : VInductDecl} + {candidate : AddInductive.NormalizationCandidate [kernelSource]} + {normalization : NormalizationCandidateRun env Us candidate source} + {generation : GenerationChecked source} + (run : GenerationCandidateRun normalization generation) : + GenerationCandidatePackage env Us where + kernelSource := kernelSource + source := source + candidate := candidate + normalization := normalization + generation := generation + run := run + +/-- Erase checker and candidate provenance at the consumer boundary. The +result contains only the Theory generation value and its ordinary semantic +certificate, which is the complete input of `VEnv.addInductCertified`. -/ +def GenerationCandidatePackage.certificate + (package : GenerationCandidatePackage env Us) : + package.source.GenerationCertificate env where + generation := package.generation + wf := package.run.wf + +/-- Build the general Verify metadata replay from a candidate package and the +ordinary implementation-to-Theory insertion witnesses. + +The generation value and its semantic proof are not independent inputs: both +are projected from `package`. The remaining arguments concern only constant +map alignment and the exact successful transaction states, so a caller cannot +pair metadata replay with an unrelated normalized view. -/ +def GenerationCandidatePackage.addInductTrace + (package : GenerationCandidatePackage env Us) + {m₁ m₂ : ConstMap} {env₂ : VEnv} + (typeMap : ConstMap) (typeEnv : VEnv) + (ctorMap : ConstMap) (ctorEnv recEnv : VEnv) + (addType : AddInductConstant .induct m₁ env + package.generation.block.sourceType.toVConstVal typeMap typeEnv) + (addCtors : AddInductConstants .ctor typeMap typeEnv + package.generation.block.sourceType.ctors ctorMap ctorEnv) + (addRec : AddInductConstant .recursor ctorMap ctorEnv + (inductGenerationRecVal package.generation) m₂ recEnv) + (addRules : AddDefEqs recEnv + package.generation.generatedRules env₂) : + AddInductTrace m₁ env package.source m₂ env₂ where + generation := package.generation + generation_wf := package.certificate.wf + typeMap := typeMap + typeEnv := typeEnv + ctorMap := ctorMap + ctorEnv := ctorEnv + recEnv := recEnv + addType := addType + addCtors := addCtors + addRec := addRec + addRules := addRules + +/-- Optional outer provenance for packages obtained by the executable +metadata pass itself. Keeping the exact producer equation separate from the +semantic package makes the trust boundary explicit: computation selects the +candidate, while `GenerationCandidateRun` alone grants it Theory meaning. -/ +structure ProducedGenerationCandidatePackage + (env : VEnv) (Us : List Name) where + package : GenerationCandidatePackage env Us + context : AddInductive.Context + nparams : Nat + numNested : Nat + isUnsafe : Bool + produced : + AddInductive.buildNormalizationCandidate nparams + [package.kernelSource] numNested isUnsafe context = + .ok package.candidate + +/-- Attach exact executable provenance to an already verified singleton +generation run. + +Both premises are indexed by the same kernel source and dependent candidate: +the executable equation therefore cannot be reused for a different semantic +run, reordered constructor list, or caller-selected view. Conversely, the +equation supplies no semantic authority by itself; all Theory meaning remains +in `run`. -/ +def GenerationCandidateRun.producedPackage + {env : VEnv} {Us : List Name} + {kernelSource : InductiveType} {source : VInductDecl} + {candidate : AddInductive.NormalizationCandidate [kernelSource]} + {normalization : NormalizationCandidateRun env Us candidate source} + {generation : GenerationChecked source} + (run : GenerationCandidateRun normalization generation) + (context : AddInductive.Context) + (nparams numNested : Nat) (isUnsafe : Bool) + (produced : + AddInductive.buildNormalizationCandidate nparams + [kernelSource] numNested isUnsafe context = .ok candidate) : + ProducedGenerationCandidatePackage env Us where + package := run.package + context := context + nparams := nparams + numNested := numNested + isUnsafe := isUnsafe + produced := produced + +/-- Package the no-parallel-run semantic assembler at the existing public +boundary. -/ +def GenerationCandidateSemanticRun.package + {env : VEnv} {Us : List Name} + {kernelSource : InductiveType} {source : VInductDecl} + {candidate : AddInductive.NormalizationCandidate [kernelSource]} + {normalization : NormalizationCandidateSemanticRun env Us candidate source} + {generation : GenerationChecked source} + (run : GenerationCandidateSemanticRun normalization generation) : + GenerationCandidatePackage env Us := + run.run.package + +/-- Attach the exact successful outer metadata call directly to a retained +semantic-generation owner. -/ +def GenerationCandidateSemanticRun.producedPackage + {env : VEnv} {Us : List Name} + {kernelSource : InductiveType} {source : VInductDecl} + {candidate : AddInductive.NormalizationCandidate [kernelSource]} + {normalization : NormalizationCandidateSemanticRun env Us candidate source} + {generation : GenerationChecked source} + (run : GenerationCandidateSemanticRun normalization generation) + (context : AddInductive.Context) + (nparams numNested : Nat) (isUnsafe : Bool) + (produced : + AddInductive.buildNormalizationCandidate nparams + [kernelSource] numNested isUnsafe context = .ok candidate) : + ProducedGenerationCandidatePackage env Us := + run.run.producedPackage context nparams numNested isUnsafe produced + +/-- Construct the complete produced package at the consolidated generation +shape boundary. + +The exact outer metadata equation selects the source-indexed candidate. The +retained semantic hierarchy, dependent analysis, analyzer-owned view WF, and +single executable shape check then determine the generation run used by the +package. In particular, callers do not separately provide checked WF or any +family/constructor shape record. -/ +def NormalizationCandidateSemanticRun.producedPackageOfGenerationShape + {env : VEnv} {Us : List Name} + {kernelSource : InductiveType} {source : VInductDecl} + {candidate : AddInductive.NormalizationCandidate [kernelSource]} + (normalization : NormalizationCandidateSemanticRun env Us candidate source) + (generation : GenerationChecked source) + (analysis : normalization.root.normalization.generation? = + some generation) + (viewWF : normalization.root.viewDecl.WF env) + (shape : normalization.generationShape = true) + (context : AddInductive.Context) + (nparams numNested : Nat) (isUnsafe : Bool) + (produced : + AddInductive.buildNormalizationCandidate nparams + [kernelSource] numNested isUnsafe context = .ok candidate) : + ProducedGenerationCandidatePackage env Us := + (GenerationCandidateSemanticRun.ofGenerationShape normalization generation + analysis viewWF shape).producedPackage context nparams numNested isUnsafe + produced + +/-- Interpret one successful executable shape-producing outer result as the +complete semantic package for the same dependent candidate. + +`raw_eq` only identifies the raw family carried by the semantic hierarchy +with the raw family passed to the executable shape gate. All other +provenance, including the candidate itself, the outer producer equation, and +the complete family/constructor shape check, is owned by `producedCandidate`. +-/ +def ProducedGenerationShapeCandidate.producedPackage + {env : VEnv} {Us : List Name} + {kernelSource : InductiveType} {source : VInductDecl} + {raw : VInductiveType} {numNested : Nat} {isUnsafe : Bool} + {context : AddInductive.Context} + (producedCandidate : ProducedGenerationShapeCandidate source raw + kernelSource numNested isUnsafe context) + (normalization : NormalizationCandidateSemanticRun env Us + producedCandidate.candidate source) + (raw_eq : raw = normalization.raw) + (generation : GenerationChecked source) + (analysis : normalization.root.normalization.generation? = + some generation) + (viewWF : normalization.root.viewDecl.WF env) : + ProducedGenerationCandidatePackage env Us := + normalization.producedPackageOfGenerationShape generation analysis viewWF + (by + simpa only [NormalizationCandidateSemanticRun.generationShape, + raw_eq] using producedCandidate.shape) + context source.nparams numNested isUnsafe producedCandidate.produced + +/- +The evidence types mention exact verifier executions, so these semantic +interpretation roots intentionally inherit the same transitional Verify +closure as `WhnfRun.isDefEq`. Exact guards ensure that the generic assembler +does not silently widen it. +-/ +/-- +info: 'Lean4Lean.TypeChecker.VEnv.HasPrimitives.addConst' depends on axioms: [propext, Classical.choice, Quot.sound] +-/ +#guard_msgs in +#print axioms TypeChecker.VEnv.HasPrimitives.addConst + +/-- +info: 'Lean4Lean.TypeChecker.VEnv.addConst_other' depends on axioms: [propext, Quot.sound] +-/ +#guard_msgs in +#print axioms TypeChecker.VEnv.addConst_other + +/-- +info: 'Lean4Lean.TypeChecker.AddInductConstant.safePrimitives' depends on axioms: [propext, + sorryAx, + Classical.choice, + Quot.sound, + PersistentHashMap.findAux_isSome, + PersistentHashMap.WF.find?_eq, + PersistentHashMap.WF.toList'_insert] +-/ +#guard_msgs in +#print axioms TypeChecker.AddInductConstant.safePrimitives + +/-- +info: 'Lean4Lean.TypeChecker.CandidateContextRun.context_env' depends on axioms: [propext, + sorryAx, + Classical.choice, + Quot.sound] +-/ +#guard_msgs in +#print axioms TypeChecker.CandidateContextRun.context_env + +/-- +info: 'Lean4Lean.TypeChecker.CandidateContextRun.context_lctx' depends on axioms: [propext, + sorryAx, + Classical.choice, + Quot.sound] +-/ +#guard_msgs in +#print axioms TypeChecker.CandidateContextRun.context_lctx + +/-- +info: 'Lean4Lean.TypeChecker.CandidateContextRun.context_safety' depends on axioms: [propext, + sorryAx, + Classical.choice, + Quot.sound] +-/ +#guard_msgs in +#print axioms TypeChecker.CandidateContextRun.context_safety + +/-- +info: 'Lean4Lean.TypeChecker.CandidateContextRun.context_lparams' depends on axioms: [propext, + sorryAx, + Classical.choice, + Quot.sound] +-/ +#guard_msgs in +#print axioms TypeChecker.CandidateContextRun.context_lparams + +/-- +info: 'Lean4Lean.TypeChecker.CandidateContextRun.context_fuel' depends on axioms: [propext, + sorryAx, + Classical.choice, + Quot.sound] +-/ +#guard_msgs in +#print axioms TypeChecker.CandidateContextRun.context_fuel + +/-- +info: 'Lean4Lean.TypeChecker.CandidateExprRun.view_isType_of_terminalSort' depends on axioms: [propext, + sorryAx, + Classical.choice, + ptrEqConstantInfo_eq, + ptrEqExpr_eq, + Quot.sound, + Expr.abstractRange_eq, + Expr.abstract_eq, + Expr.eqv_eq, + Expr.hasLooseBVar_eq, + Expr.instantiate1_eq, + Expr.instantiateRange_eq, + Expr.instantiateRevRange_eq, + Expr.instantiateRev_eq, + Expr.instantiate_eq, + Expr.looseBVarRange_eq, + Expr.lowerLooseBVars_eq, + Expr.mkAppData_eq, + Expr.mkData_eq, + Expr.replace_eq, + Level.hasMVar_eq, + Level.hasParam_eq, + Level.instLawfulBEqLevel, + PersistentArray.toList'_push, + PersistentHashMap.findAux_isSome, + Syntax.structEq_eq, + PersistentHashMap.WF.find?_eq, + PersistentHashMap.WF.toList'_insert] +-/ +#guard_msgs in +#print axioms TypeChecker.CandidateExprRun.view_isType_of_terminalSort + +/-- +info: 'Lean4Lean.TypeChecker.CandidateExprSemanticRootRun.source_isType_of_terminalSort' depends on axioms: [propext, + sorryAx, + Classical.choice, + ptrEqConstantInfo_eq, + ptrEqExpr_eq, + Quot.sound, + Expr.abstractRange_eq, + Expr.abstract_eq, + Expr.eqv_eq, + Expr.hasLooseBVar_eq, + Expr.instantiate1_eq, + Expr.instantiateRange_eq, + Expr.instantiateRevRange_eq, + Expr.instantiateRev_eq, + Expr.instantiate_eq, + Expr.looseBVarRange_eq, + Expr.lowerLooseBVars_eq, + Expr.mkAppData_eq, + Expr.mkData_eq, + Expr.replace_eq, + Level.hasMVar_eq, + Level.hasParam_eq, + Level.instLawfulBEqLevel, + PersistentArray.toList'_push, + PersistentHashMap.findAux_isSome, + Syntax.structEq_eq, + PersistentHashMap.WF.find?_eq, + PersistentHashMap.WF.toList'_insert] +-/ +#guard_msgs in +#print axioms TypeChecker.CandidateExprSemanticRootRun.source_isType_of_terminalSort + +/-- +info: 'Lean4Lean.TypeChecker.CandidateExprSemanticRootRun.viewParameters' depends on axioms: [propext, + sorryAx, + Classical.choice, + Quot.sound] +-/ +#guard_msgs in +#print axioms TypeChecker.CandidateExprSemanticRootRun.viewParameters + +/-- +info: 'Lean4Lean.TypeChecker.CandidateExprSemanticRootRun.viewIndices' depends on axioms: [propext, + sorryAx, + Classical.choice, + Quot.sound] +-/ +#guard_msgs in +#print axioms TypeChecker.CandidateExprSemanticRootRun.viewIndices + +/-- +info: 'Lean4Lean.VInductDecl.CandidateFamilyStagedInput' depends on axioms: [propext, sorryAx, Classical.choice, Quot.sound] +-/ +#guard_msgs in +#print axioms CandidateFamilyStagedInput + +/-- +info: 'Lean4Lean.VInductDecl.CandidateFamilyStagedInput.rawWF' depends on axioms: [propext, + sorryAx, + Classical.choice, + ptrEqConstantInfo_eq, + ptrEqExpr_eq, + Quot.sound, + Expr.abstractRange_eq, + Expr.abstract_eq, + Expr.eqv_eq, + Expr.hasLooseBVar_eq, + Expr.instantiate1_eq, + Expr.instantiateRange_eq, + Expr.instantiateRevRange_eq, + Expr.instantiateRev_eq, + Expr.instantiate_eq, + Expr.looseBVarRange_eq, + Expr.lowerLooseBVars_eq, + Expr.mkAppData_eq, + Expr.mkData_eq, + Expr.replace_eq, + Level.hasMVar_eq, + Level.hasParam_eq, + Level.instLawfulBEqLevel, + PersistentArray.toList'_push, + PersistentHashMap.findAux_isSome, + Syntax.structEq_eq, + PersistentHashMap.WF.find?_eq, + PersistentHashMap.WF.toList'_insert] +-/ +#guard_msgs in +#print axioms CandidateFamilyStagedInput.rawWF + +/-- +info: 'Lean4Lean.VInductDecl.CandidateFamilyStagedInput.postContext' depends on axioms: [propext, + sorryAx, + Classical.choice, + ptrEqConstantInfo_eq, + ptrEqExpr_eq, + Quot.sound, + Expr.abstractRange_eq, + Expr.abstract_eq, + Expr.eqv_eq, + Expr.hasLooseBVar_eq, + Expr.instantiate1_eq, + Expr.instantiateRange_eq, + Expr.instantiateRevRange_eq, + Expr.instantiateRev_eq, + Expr.instantiate_eq, + Expr.looseBVarRange_eq, + Expr.lowerLooseBVars_eq, + Expr.mkAppData_eq, + Expr.mkData_eq, + Expr.replace_eq, + Level.hasMVar_eq, + Level.hasParam_eq, + Level.instLawfulBEqLevel, + PersistentArray.toList'_push, + PersistentHashMap.findAux_isSome, + Syntax.structEq_eq, + PersistentHashMap.WF.find?_eq, + PersistentHashMap.WF.toList'_insert] +-/ +#guard_msgs in +#print axioms CandidateFamilyStagedInput.postContext + +/-- +info: 'Lean4Lean.VInductDecl.CandidateFamilyStagedInput.postContextRun' depends on axioms: [propext, + sorryAx, + Classical.choice, + ptrEqConstantInfo_eq, + ptrEqExpr_eq, + Quot.sound, + Expr.abstractRange_eq, + Expr.abstract_eq, + Expr.eqv_eq, + Expr.hasLooseBVar_eq, + Expr.instantiate1_eq, + Expr.instantiateRange_eq, + Expr.instantiateRevRange_eq, + Expr.instantiateRev_eq, + Expr.instantiate_eq, + Expr.looseBVarRange_eq, + Expr.lowerLooseBVars_eq, + Expr.mkAppData_eq, + Expr.mkData_eq, + Expr.replace_eq, + Level.hasMVar_eq, + Level.hasParam_eq, + Level.instLawfulBEqLevel, + PersistentArray.toList'_push, + PersistentHashMap.findAux_isSome, + Syntax.structEq_eq, + PersistentHashMap.WF.find?_eq, + PersistentHashMap.WF.toList'_insert] +-/ +#guard_msgs in +#print axioms CandidateFamilyStagedInput.postContextRun + +/-- +info: 'Lean4Lean.VInductDecl.CandidateFamilyStagedInput.postFamily' depends on axioms: [propext, + sorryAx, + Classical.choice, + ptrEqConstantInfo_eq, + ptrEqExpr_eq, + Quot.sound, + Expr.abstractRange_eq, + Expr.abstract_eq, + Expr.eqv_eq, + Expr.hasLooseBVar_eq, + Expr.instantiate1_eq, + Expr.instantiateRange_eq, + Expr.instantiateRevRange_eq, + Expr.instantiateRev_eq, + Expr.instantiate_eq, + Expr.looseBVarRange_eq, + Expr.lowerLooseBVars_eq, + Expr.mkAppData_eq, + Expr.mkData_eq, + Expr.replace_eq, + Level.hasMVar_eq, + Level.hasParam_eq, + Level.instLawfulBEqLevel, + PersistentArray.toList'_push, + PersistentHashMap.findAux_isSome, + Syntax.structEq_eq, + PersistentHashMap.WF.find?_eq, + PersistentHashMap.WF.toList'_insert] +-/ +#guard_msgs in +#print axioms CandidateFamilyStagedInput.postFamily + + +/-- +info: 'Lean4Lean.TypeChecker.CandidateExprSemanticRootInput.exists' depends on axioms: [propext, + sorryAx, + Classical.choice, + ptrEqConstantInfo_eq, + ptrEqExpr_eq, + Quot.sound, + Expr.abstractRange_eq, + Expr.abstract_eq, + Expr.eqv_eq, + Expr.hasLooseBVar_eq, + Expr.instantiate1_eq, + Expr.instantiateRange_eq, + Expr.instantiateRevRange_eq, + Expr.instantiateRev_eq, + Expr.instantiate_eq, + Expr.looseBVarRange_eq, + Expr.lowerLooseBVars_eq, + Expr.mkAppData_eq, + Expr.mkData_eq, + Expr.replace_eq, + Level.hasMVar_eq, + Level.hasParam_eq, + Level.instLawfulBEqLevel, + PersistentArray.toList'_push, + PersistentHashMap.findAux_isSome, + Syntax.structEq_eq, + PersistentHashMap.WF.find?_eq, + PersistentHashMap.WF.toList'_insert] +-/ +#guard_msgs in +#print axioms TypeChecker.CandidateExprSemanticRootInput.exists + +/-- +info: 'Lean4Lean.VInductDecl.CandidateConstructorSemanticListInput.exists' depends on axioms: [propext, + sorryAx, + Classical.choice, + ptrEqConstantInfo_eq, + ptrEqExpr_eq, + Quot.sound, + Expr.abstractRange_eq, + Expr.abstract_eq, + Expr.eqv_eq, + Expr.hasLooseBVar_eq, + Expr.instantiate1_eq, + Expr.instantiateRange_eq, + Expr.instantiateRevRange_eq, + Expr.instantiateRev_eq, + Expr.instantiate_eq, + Expr.looseBVarRange_eq, + Expr.lowerLooseBVars_eq, + Expr.mkAppData_eq, + Expr.mkData_eq, + Expr.replace_eq, + Level.hasMVar_eq, + Level.hasParam_eq, + Level.instLawfulBEqLevel, + PersistentArray.toList'_push, + PersistentHashMap.findAux_isSome, + Syntax.structEq_eq, + PersistentHashMap.WF.find?_eq, + PersistentHashMap.WF.toList'_insert] +-/ +#guard_msgs in +#print axioms CandidateConstructorSemanticListInput.exists + +/-- +info: 'Lean4Lean.VInductDecl.NormalizationCandidateSemanticInput.exists_ofProduced' depends on axioms: [propext, + sorryAx, + Classical.choice, + ptrEqConstantInfo_eq, + ptrEqExpr_eq, + Quot.sound, + Expr.abstractRange_eq, + Expr.abstract_eq, + Expr.eqv_eq, + Expr.hasLooseBVar_eq, + Expr.instantiate1_eq, + Expr.instantiateRange_eq, + Expr.instantiateRevRange_eq, + Expr.instantiateRev_eq, + Expr.instantiate_eq, + Expr.looseBVarRange_eq, + Expr.lowerLooseBVars_eq, + Expr.mkAppData_eq, + Expr.mkData_eq, + Expr.replace_eq, + Level.hasMVar_eq, + Level.hasParam_eq, + Level.instLawfulBEqLevel, + PersistentArray.toList'_push, + PersistentHashMap.findAux_isSome, + Syntax.structEq_eq, + PersistentHashMap.WF.find?_eq, + PersistentHashMap.WF.toList'_insert] +-/ +#guard_msgs in +#print axioms NormalizationCandidateSemanticInput.exists_ofProduced + +/-- +info: 'Lean4Lean.VInductDecl.StagedNormalizationCandidateSemanticInput.exists' depends on axioms: [propext, + sorryAx, + Classical.choice, + ptrEqConstantInfo_eq, + ptrEqExpr_eq, + Quot.sound, + Expr.abstractRange_eq, + Expr.abstract_eq, + Expr.eqv_eq, + Expr.hasLooseBVar_eq, + Expr.instantiate1_eq, + Expr.instantiateRange_eq, + Expr.instantiateRevRange_eq, + Expr.instantiateRev_eq, + Expr.instantiate_eq, + Expr.looseBVarRange_eq, + Expr.lowerLooseBVars_eq, + Expr.mkAppData_eq, + Expr.mkData_eq, + Expr.replace_eq, + Level.hasMVar_eq, + Level.hasParam_eq, + Level.instLawfulBEqLevel, + PersistentArray.toList'_push, + PersistentHashMap.findAux_isSome, + Syntax.structEq_eq, + PersistentHashMap.WF.find?_eq, + PersistentHashMap.WF.toList'_insert] +-/ +#guard_msgs in +#print axioms StagedNormalizationCandidateSemanticInput.exists + +/-- +info: 'Lean4Lean.VInductDecl.CandidateFamilySemanticGenerationRun.run' depends on axioms: [propext, + sorryAx, + Classical.choice, + ptrEqConstantInfo_eq, + ptrEqExpr_eq, + Quot.sound, + Expr.abstractRange_eq, + Expr.abstract_eq, + Expr.eqv_eq, + Expr.hasLooseBVar_eq, + Expr.instantiate1_eq, + Expr.instantiateRange_eq, + Expr.instantiateRevRange_eq, + Expr.instantiateRev_eq, + Expr.instantiate_eq, + Expr.looseBVarRange_eq, + Expr.lowerLooseBVars_eq, + Expr.mkAppData_eq, + Expr.mkData_eq, + Expr.replace_eq, + Level.hasMVar_eq, + Level.hasParam_eq, + Level.instLawfulBEqLevel, + PersistentArray.toList'_push, + PersistentHashMap.findAux_isSome, + Syntax.structEq_eq, + PersistentHashMap.WF.find?_eq, + PersistentHashMap.WF.toList'_insert] +-/ +#guard_msgs in +#print axioms CandidateFamilySemanticGenerationRun.run + +/-- +info: 'Lean4Lean.VInductDecl.CandidateSemanticNormalizedCtorListRun.run' depends on axioms: [propext, + sorryAx, + Classical.choice, + ptrEqConstantInfo_eq, + ptrEqExpr_eq, + Quot.sound, + Expr.abstractRange_eq, + Expr.abstract_eq, + Expr.eqv_eq, + Expr.hasLooseBVar_eq, + Expr.instantiate1_eq, + Expr.instantiateRange_eq, + Expr.instantiateRevRange_eq, + Expr.instantiateRev_eq, + Expr.instantiate_eq, + Expr.looseBVarRange_eq, + Expr.lowerLooseBVars_eq, + Expr.mkAppData_eq, + Expr.mkData_eq, + Expr.replace_eq, + Level.hasMVar_eq, + Level.hasParam_eq, + Level.instLawfulBEqLevel, + PersistentArray.toList'_push, + PersistentHashMap.findAux_isSome, + Syntax.structEq_eq, + PersistentHashMap.WF.find?_eq, + PersistentHashMap.WF.toList'_insert] +-/ +#guard_msgs in +#print axioms CandidateSemanticNormalizedCtorListRun.run + +/-- +info: 'Lean4Lean.VInductDecl.GenerationCandidateSemanticRun.run' depends on axioms: [propext, + sorryAx, + Classical.choice, + ptrEqConstantInfo_eq, + ptrEqExpr_eq, + Quot.sound, + Expr.abstractRange_eq, + Expr.abstract_eq, + Expr.eqv_eq, + Expr.hasLooseBVar_eq, + Expr.instantiate1_eq, + Expr.instantiateRange_eq, + Expr.instantiateRevRange_eq, + Expr.instantiateRev_eq, + Expr.instantiate_eq, + Expr.looseBVarRange_eq, + Expr.lowerLooseBVars_eq, + Expr.mkAppData_eq, + Expr.mkData_eq, + Expr.replace_eq, + Level.hasMVar_eq, + Level.hasParam_eq, + Level.instLawfulBEqLevel, + PersistentArray.toList'_push, + PersistentHashMap.findAux_isSome, + Syntax.structEq_eq, + PersistentHashMap.WF.find?_eq, + PersistentHashMap.WF.toList'_insert] +-/ +#guard_msgs in +#print axioms GenerationCandidateSemanticRun.run + +/-- +info: 'Lean4Lean.VInductDecl.GenerationCandidateSemanticShapeRun.run' depends on axioms: [propext, + sorryAx, + Classical.choice, + ptrEqConstantInfo_eq, + ptrEqExpr_eq, + Quot.sound, + Expr.abstractRange_eq, + Expr.abstract_eq, + Expr.eqv_eq, + Expr.hasLooseBVar_eq, + Expr.instantiate1_eq, + Expr.instantiateRange_eq, + Expr.instantiateRevRange_eq, + Expr.instantiateRev_eq, + Expr.instantiate_eq, + Expr.looseBVarRange_eq, + Expr.lowerLooseBVars_eq, + Expr.mkAppData_eq, + Expr.mkData_eq, + Expr.replace_eq, + Level.hasMVar_eq, + Level.hasParam_eq, + Level.instLawfulBEqLevel, + PersistentArray.toList'_push, + PersistentHashMap.findAux_isSome, + Syntax.structEq_eq, + PersistentHashMap.WF.find?_eq, + PersistentHashMap.WF.toList'_insert] +-/ +#guard_msgs in +#print axioms GenerationCandidateSemanticShapeRun.run + +/-- +info: 'Lean4Lean.VInductDecl.candidateConstructorSemanticGenerationShape' depends on axioms: [propext, + Classical.choice, + Quot.sound] +-/ +#guard_msgs in +#print axioms candidateConstructorSemanticGenerationShape + +/-- +info: 'Lean4Lean.VInductDecl.normalizationCandidateGenerationShape' depends on axioms: [propext, Classical.choice, Quot.sound] +-/ +#guard_msgs in +#print axioms normalizationCandidateGenerationShape + +/-- +info: 'Lean4Lean.VInductDecl.CandidateConstructorSemanticGenerationShapeList.ofCheck' depends on axioms: [propext, + sorryAx, + Classical.choice, + Quot.sound] +-/ +#guard_msgs in +#print axioms CandidateConstructorSemanticGenerationShapeList.ofCheck + +/-- +info: 'Lean4Lean.VInductDecl.NormalizationCandidateSemanticRun.generationShape' depends on axioms: [propext, + sorryAx, + Classical.choice, + Quot.sound] +-/ +#guard_msgs in +#print axioms NormalizationCandidateSemanticRun.generationShape + +/-- +info: 'Lean4Lean.VInductDecl.produceGenerationShapeCandidate' depends on axioms: [propext, Classical.choice, Quot.sound] +-/ +#guard_msgs in +#print axioms produceGenerationShapeCandidate + +/-- +info: 'Lean4Lean.VInductDecl.produceGenerationShapeCandidate_eq_ok' depends on axioms: [propext, Classical.choice, Quot.sound] +-/ +#guard_msgs in +#print axioms produceGenerationShapeCandidate_eq_ok + +/-- +info: 'Lean4Lean.VInductDecl.GenerationCandidateSemanticRun.ofGenerationShape' depends on axioms: [propext, + sorryAx, + Classical.choice, + ptrEqConstantInfo_eq, + ptrEqExpr_eq, + Quot.sound, + Expr.abstractRange_eq, + Expr.abstract_eq, + Expr.eqv_eq, + Expr.hasLooseBVar_eq, + Expr.instantiate1_eq, + Expr.instantiateRange_eq, + Expr.instantiateRevRange_eq, + Expr.instantiateRev_eq, + Expr.instantiate_eq, + Expr.looseBVarRange_eq, + Expr.lowerLooseBVars_eq, + Expr.mkAppData_eq, + Expr.mkData_eq, + Expr.replace_eq, + Level.hasMVar_eq, + Level.hasParam_eq, + Level.instLawfulBEqLevel, + PersistentArray.toList'_push, + PersistentHashMap.findAux_isSome, + Syntax.structEq_eq, + PersistentHashMap.WF.find?_eq, + PersistentHashMap.WF.toList'_insert] +-/ +#guard_msgs in +#print axioms GenerationCandidateSemanticRun.ofGenerationShape + +/-- +info: 'Lean4Lean.VInductDecl.NormalizationCandidateSemanticRun.producedPackageOfGenerationShape' depends on axioms: [propext, + sorryAx, + Classical.choice, + ptrEqConstantInfo_eq, + ptrEqExpr_eq, + Quot.sound, + Expr.abstractRange_eq, + Expr.abstract_eq, + Expr.eqv_eq, + Expr.hasLooseBVar_eq, + Expr.instantiate1_eq, + Expr.instantiateRange_eq, + Expr.instantiateRevRange_eq, + Expr.instantiateRev_eq, + Expr.instantiate_eq, + Expr.looseBVarRange_eq, + Expr.lowerLooseBVars_eq, + Expr.mkAppData_eq, + Expr.mkData_eq, + Expr.replace_eq, + Level.hasMVar_eq, + Level.hasParam_eq, + Level.instLawfulBEqLevel, + PersistentArray.toList'_push, + PersistentHashMap.findAux_isSome, + Syntax.structEq_eq, + PersistentHashMap.WF.find?_eq, + PersistentHashMap.WF.toList'_insert] +-/ +#guard_msgs in +#print axioms NormalizationCandidateSemanticRun.producedPackageOfGenerationShape + +/-- +info: 'Lean4Lean.VInductDecl.ProducedGenerationShapeCandidate.producedPackage' depends on axioms: [propext, + sorryAx, + Classical.choice, + ptrEqConstantInfo_eq, + ptrEqExpr_eq, + Quot.sound, + Expr.abstractRange_eq, + Expr.abstract_eq, + Expr.eqv_eq, + Expr.hasLooseBVar_eq, + Expr.instantiate1_eq, + Expr.instantiateRange_eq, + Expr.instantiateRevRange_eq, + Expr.instantiateRev_eq, + Expr.instantiate_eq, + Expr.looseBVarRange_eq, + Expr.lowerLooseBVars_eq, + Expr.mkAppData_eq, + Expr.mkData_eq, + Expr.replace_eq, + Level.hasMVar_eq, + Level.hasParam_eq, + Level.instLawfulBEqLevel, + PersistentArray.toList'_push, + PersistentHashMap.findAux_isSome, + Syntax.structEq_eq, + PersistentHashMap.WF.find?_eq, + PersistentHashMap.WF.toList'_insert] +-/ +#guard_msgs in +#print axioms ProducedGenerationShapeCandidate.producedPackage + +/-- +info: 'Lean4Lean.VInductDecl.GenerationCandidateSemanticRun.package' depends on axioms: [propext, + sorryAx, + Classical.choice, + ptrEqConstantInfo_eq, + ptrEqExpr_eq, + Quot.sound, + Expr.abstractRange_eq, + Expr.abstract_eq, + Expr.eqv_eq, + Expr.hasLooseBVar_eq, + Expr.instantiate1_eq, + Expr.instantiateRange_eq, + Expr.instantiateRevRange_eq, + Expr.instantiateRev_eq, + Expr.instantiate_eq, + Expr.looseBVarRange_eq, + Expr.lowerLooseBVars_eq, + Expr.mkAppData_eq, + Expr.mkData_eq, + Expr.replace_eq, + Level.hasMVar_eq, + Level.hasParam_eq, + Level.instLawfulBEqLevel, + PersistentArray.toList'_push, + PersistentHashMap.findAux_isSome, + Syntax.structEq_eq, + PersistentHashMap.WF.find?_eq, + PersistentHashMap.WF.toList'_insert] +-/ +#guard_msgs in +#print axioms GenerationCandidateSemanticRun.package + +/-- +info: 'Lean4Lean.VInductDecl.GenerationCandidateSemanticRun.producedPackage' depends on axioms: [propext, + sorryAx, + Classical.choice, + ptrEqConstantInfo_eq, + ptrEqExpr_eq, + Quot.sound, + Expr.abstractRange_eq, + Expr.abstract_eq, + Expr.eqv_eq, + Expr.hasLooseBVar_eq, + Expr.instantiate1_eq, + Expr.instantiateRange_eq, + Expr.instantiateRevRange_eq, + Expr.instantiateRev_eq, + Expr.instantiate_eq, + Expr.looseBVarRange_eq, + Expr.lowerLooseBVars_eq, + Expr.mkAppData_eq, + Expr.mkData_eq, + Expr.replace_eq, + Level.hasMVar_eq, + Level.hasParam_eq, + Level.instLawfulBEqLevel, + PersistentArray.toList'_push, + PersistentHashMap.findAux_isSome, + Syntax.structEq_eq, + PersistentHashMap.WF.find?_eq, + PersistentHashMap.WF.toList'_insert] +-/ +#guard_msgs in +#print axioms GenerationCandidateSemanticRun.producedPackage + +/-- +info: 'Lean4Lean.TypeChecker.VState.WF.empty_of_reserves' depends on axioms: [propext, + sorryAx, + Classical.choice, + Quot.sound, + Expr.eqv_eq, + Level.instLawfulBEqLevel, + PersistentArray.toList'_push, + Syntax.structEq_eq, + PersistentHashMap.WF.find?_eq, + PersistentHashMap.WF.toList'_insert] +-/ +#guard_msgs in +#print axioms TypeChecker.VState.WF.empty_of_reserves + +/-- +info: 'Lean4Lean.TypeChecker.candidateFreshFVarId_reserved' depends on axioms: [propext, Classical.choice, Quot.sound] +-/ +#guard_msgs in +#print axioms TypeChecker.candidateFreshFVarId_reserved + +/-- +info: 'Lean4Lean.TypeChecker.CandidateContextRun.root' depends on axioms: [propext, + sorryAx, + Classical.choice, + Quot.sound, + Expr.eqv_eq, + Level.instLawfulBEqLevel, + Syntax.structEq_eq] +-/ +#guard_msgs in +#print axioms TypeChecker.CandidateContextRun.root + +/-- +info: 'Lean4Lean.TypeChecker.CandidateContextRun.pushLocalDecl' depends on axioms: [propext, + sorryAx, + Classical.choice, + Quot.sound, + Expr.eqv_eq, + Level.instLawfulBEqLevel, + PersistentArray.toList'_push, + Syntax.structEq_eq, + PersistentHashMap.WF.find?_eq, + PersistentHashMap.WF.toList'_insert] +-/ +#guard_msgs in +#print axioms TypeChecker.CandidateContextRun.pushLocalDecl + +/-- +info: 'Lean4Lean.TypeChecker.candidateCheckTypeStep_exists_translation' depends on axioms: [propext, + sorryAx, + Classical.choice, + ptrEqConstantInfo_eq, + ptrEqExpr_eq, + Quot.sound, + Expr.abstractRange_eq, + Expr.abstract_eq, + Expr.eqv_eq, + Expr.hasLooseBVar_eq, + Expr.instantiate1_eq, + Expr.instantiateRange_eq, + Expr.instantiateRevRange_eq, + Expr.instantiateRev_eq, + Expr.instantiate_eq, + Expr.looseBVarRange_eq, + Expr.lowerLooseBVars_eq, + Expr.mkAppData_eq, + Expr.mkData_eq, + Expr.replace_eq, + Level.hasMVar_eq, + Level.hasParam_eq, + Level.instLawfulBEqLevel, + PersistentArray.toList'_push, + PersistentHashMap.findAux_isSome, + Syntax.structEq_eq, + PersistentHashMap.WF.find?_eq, + PersistentHashMap.WF.toList'_insert] +-/ +#guard_msgs in +#print axioms TypeChecker.candidateCheckTypeStep_exists_translation + +/-- +info: 'Lean4Lean.TypeChecker.IsDefEqRun.ofCandidateStep' depends on axioms: [propext, sorryAx, Classical.choice, Quot.sound] +-/ +#guard_msgs in +#print axioms TypeChecker.IsDefEqRun.ofCandidateStep + +/-- +info: 'Lean4Lean.TypeChecker.IsDefEqRun.isDefEqU' depends on axioms: [propext, + sorryAx, + Classical.choice, + ptrEqConstantInfo_eq, + ptrEqExpr_eq, + Quot.sound, + Expr.abstractRange_eq, + Expr.abstract_eq, + Expr.eqv_eq, + Expr.hasLooseBVar_eq, + Expr.instantiate1_eq, + Expr.instantiateRange_eq, + Expr.instantiateRevRange_eq, + Expr.instantiateRev_eq, + Expr.instantiate_eq, + Expr.looseBVarRange_eq, + Expr.lowerLooseBVars_eq, + Expr.mkAppData_eq, + Expr.mkData_eq, + Expr.replace_eq, + Level.hasMVar_eq, + Level.hasParam_eq, + Level.instLawfulBEqLevel, + PersistentArray.toList'_push, + PersistentHashMap.findAux_isSome, + Syntax.structEq_eq, + PersistentHashMap.WF.find?_eq, + PersistentHashMap.WF.toList'_insert] +-/ +#guard_msgs in +#print axioms TypeChecker.IsDefEqRun.isDefEqU + +/-- +info: 'Lean4Lean.TypeChecker.candidateTypeAnnotation_fvarsIn' does not depend on any axioms +-/ +#guard_msgs in +#print axioms TypeChecker.candidateTypeAnnotation_fvarsIn + +/-- +info: 'Lean4Lean.TypeChecker.candidateTypeAnnotation_exists_translation' depends on axioms: [propext, + sorryAx, + Classical.choice, + Quot.sound] +-/ +#guard_msgs in +#print axioms TypeChecker.candidateTypeAnnotation_exists_translation + +/-- +info: 'Lean4Lean.TypeChecker.CandidateExprRun.exists_ofCandidate' depends on axioms: [propext, + sorryAx, + Classical.choice, + ptrEqConstantInfo_eq, + ptrEqExpr_eq, + Quot.sound, + Expr.abstractRange_eq, + Expr.abstract_eq, + Expr.eqv_eq, + Expr.hasLooseBVar_eq, + Expr.instantiate1_eq, + Expr.instantiateRange_eq, + Expr.instantiateRevRange_eq, + Expr.instantiateRev_eq, + Expr.instantiate_eq, + Expr.looseBVarRange_eq, + Expr.lowerLooseBVars_eq, + Expr.mkAppData_eq, + Expr.mkData_eq, + Expr.replace_eq, + Level.hasMVar_eq, + Level.hasParam_eq, + Level.instLawfulBEqLevel, + PersistentArray.toList'_push, + PersistentHashMap.findAux_isSome, + Syntax.structEq_eq, + PersistentHashMap.WF.find?_eq, + PersistentHashMap.WF.toList'_insert] +-/ +#guard_msgs in +#print axioms TypeChecker.CandidateExprRun.exists_ofCandidate + +/-- +info: 'Lean4Lean.TypeChecker.CandidateExprRun.exists_ofCandidateFVars' depends on axioms: [propext, + sorryAx, + Classical.choice, + ptrEqConstantInfo_eq, + ptrEqExpr_eq, + Quot.sound, + Expr.abstractRange_eq, + Expr.abstract_eq, + Expr.eqv_eq, + Expr.hasLooseBVar_eq, + Expr.instantiate1_eq, + Expr.instantiateRange_eq, + Expr.instantiateRevRange_eq, + Expr.instantiateRev_eq, + Expr.instantiate_eq, + Expr.looseBVarRange_eq, + Expr.lowerLooseBVars_eq, + Expr.mkAppData_eq, + Expr.mkData_eq, + Expr.replace_eq, + Level.hasMVar_eq, + Level.hasParam_eq, + Level.instLawfulBEqLevel, + PersistentArray.toList'_push, + PersistentHashMap.findAux_isSome, + Syntax.structEq_eq, + PersistentHashMap.WF.find?_eq, + PersistentHashMap.WF.toList'_insert] +-/ +#guard_msgs in +#print axioms TypeChecker.CandidateExprRun.exists_ofCandidateFVars + +/-- +info: 'Lean4Lean.TypeChecker.WhnfRun.ofCandidateStep' depends on axioms: [propext, sorryAx, Classical.choice, Quot.sound] +-/ +#guard_msgs in +#print axioms TypeChecker.WhnfRun.ofCandidateStep + +/-- +info: 'Lean4Lean.TypeChecker.CheckTypeRun.ofCandidateStep' depends on axioms: [propext, sorryAx, Classical.choice, Quot.sound] +-/ +#guard_msgs in +#print axioms TypeChecker.CheckTypeRun.ofCandidateStep + +/-- +info: 'Lean4Lean.TypeChecker.CandidateNodeRun.ofCandidate' depends on axioms: [propext, sorryAx, Classical.choice, Quot.sound] +-/ +#guard_msgs in +#print axioms TypeChecker.CandidateNodeRun.ofCandidate + +/-- +info: 'Lean4Lean.TypeChecker.CandidateNodeRun.exists_ofCandidate' depends on axioms: [propext, + sorryAx, + Classical.choice, + ptrEqConstantInfo_eq, + ptrEqExpr_eq, + Quot.sound, + Expr.abstractRange_eq, + Expr.abstract_eq, + Expr.eqv_eq, + Expr.hasLooseBVar_eq, + Expr.instantiate1_eq, + Expr.instantiateRange_eq, + Expr.instantiateRevRange_eq, + Expr.instantiateRev_eq, + Expr.instantiate_eq, + Expr.looseBVarRange_eq, + Expr.lowerLooseBVars_eq, + Expr.mkAppData_eq, + Expr.mkData_eq, + Expr.replace_eq, + Level.hasMVar_eq, + Level.hasParam_eq, + Level.instLawfulBEqLevel, + PersistentArray.toList'_push, + PersistentHashMap.findAux_isSome, + Syntax.structEq_eq, + PersistentHashMap.WF.find?_eq, + PersistentHashMap.WF.toList'_insert] +-/ +#guard_msgs in +#print axioms TypeChecker.CandidateNodeRun.exists_ofCandidate + +/-- +info: 'Lean4Lean.TypeChecker.CandidateNodeRun.evidence' depends on axioms: [propext, + sorryAx, + Classical.choice, + ptrEqConstantInfo_eq, + ptrEqExpr_eq, + Quot.sound, + Expr.abstractRange_eq, + Expr.abstract_eq, + Expr.eqv_eq, + Expr.hasLooseBVar_eq, + Expr.instantiate1_eq, + Expr.instantiateRange_eq, + Expr.instantiateRevRange_eq, + Expr.instantiateRev_eq, + Expr.instantiate_eq, + Expr.looseBVarRange_eq, + Expr.lowerLooseBVars_eq, + Expr.mkAppData_eq, + Expr.mkData_eq, + Expr.replace_eq, + Level.hasMVar_eq, + Level.hasParam_eq, + Level.instLawfulBEqLevel, + PersistentArray.toList'_push, + PersistentHashMap.findAux_isSome, + Syntax.structEq_eq, + PersistentHashMap.WF.find?_eq, + PersistentHashMap.WF.toList'_insert] +-/ +#guard_msgs in +#print axioms TypeChecker.CandidateNodeRun.evidence + +/-- +info: 'Lean4Lean.TypeChecker.CandidateExprRun.evidence' depends on axioms: [propext, + sorryAx, + Classical.choice, + ptrEqConstantInfo_eq, + ptrEqExpr_eq, + Quot.sound, + Expr.abstractRange_eq, + Expr.abstract_eq, + Expr.eqv_eq, + Expr.hasLooseBVar_eq, + Expr.instantiate1_eq, + Expr.instantiateRange_eq, + Expr.instantiateRevRange_eq, + Expr.instantiateRev_eq, + Expr.instantiate_eq, + Expr.looseBVarRange_eq, + Expr.lowerLooseBVars_eq, + Expr.mkAppData_eq, + Expr.mkData_eq, + Expr.replace_eq, + Level.hasMVar_eq, + Level.hasParam_eq, + Level.instLawfulBEqLevel, + PersistentArray.toList'_push, + PersistentHashMap.findAux_isSome, + Syntax.structEq_eq, + PersistentHashMap.WF.find?_eq, + PersistentHashMap.WF.toList'_insert] +-/ +#guard_msgs in +#print axioms TypeChecker.CandidateExprRun.evidence + +/-- +info: 'Lean4Lean.TypeChecker.CandidateExprRun.source_tr' depends on axioms: [propext, sorryAx, Classical.choice, Quot.sound] +-/ +#guard_msgs in +#print axioms TypeChecker.CandidateExprRun.source_tr + +/-- +info: 'Lean4Lean.TypeChecker.CandidateExprRun.view_tr' depends on axioms: [propext, + sorryAx, + Classical.choice, + ptrEqConstantInfo_eq, + ptrEqExpr_eq, + Quot.sound, + Expr.abstractRange_eq, + Expr.abstract_eq, + Expr.eqv_eq, + Expr.hasLooseBVar_eq, + Expr.instantiate1_eq, + Expr.instantiateRange_eq, + Expr.instantiateRevRange_eq, + Expr.instantiateRev_eq, + Expr.instantiate_eq, + Expr.looseBVarRange_eq, + Expr.lowerLooseBVars_eq, + Expr.mkAppData_eq, + Expr.mkData_eq, + Expr.replace_eq, + Level.hasMVar_eq, + Level.hasParam_eq, + Level.instLawfulBEqLevel, + PersistentArray.toList'_push, + PersistentHashMap.findAux_isSome, + Syntax.structEq_eq, + PersistentHashMap.WF.find?_eq, + PersistentHashMap.WF.toList'_insert] +-/ +#guard_msgs in +#print axioms TypeChecker.CandidateExprRun.view_tr + +/-- +info: 'Lean4Lean.TypeChecker.CandidateExprRootRun.evidence' depends on axioms: [propext, + sorryAx, + Classical.choice, + ptrEqConstantInfo_eq, + ptrEqExpr_eq, + Quot.sound, + Expr.abstractRange_eq, + Expr.abstract_eq, + Expr.eqv_eq, + Expr.hasLooseBVar_eq, + Expr.instantiate1_eq, + Expr.instantiateRange_eq, + Expr.instantiateRevRange_eq, + Expr.instantiateRev_eq, + Expr.instantiate_eq, + Expr.looseBVarRange_eq, + Expr.lowerLooseBVars_eq, + Expr.mkAppData_eq, + Expr.mkData_eq, + Expr.replace_eq, + Level.hasMVar_eq, + Level.hasParam_eq, + Level.instLawfulBEqLevel, + PersistentArray.toList'_push, + PersistentHashMap.findAux_isSome, + Syntax.structEq_eq, + PersistentHashMap.WF.find?_eq, + PersistentHashMap.WF.toList'_insert] +-/ +#guard_msgs in +#print axioms TypeChecker.CandidateExprRootRun.evidence + +/-- +info: 'Lean4Lean.TypeChecker.TelDefEqEvidence.telDefEq' depends on axioms: [propext, + sorryAx, + Classical.choice, + ptrEqConstantInfo_eq, + ptrEqExpr_eq, + Quot.sound, + Expr.abstractRange_eq, + Expr.abstract_eq, + Expr.eqv_eq, + Expr.hasLooseBVar_eq, + Expr.instantiate1_eq, + Expr.instantiateRange_eq, + Expr.instantiateRevRange_eq, + Expr.instantiateRev_eq, + Expr.instantiate_eq, + Expr.looseBVarRange_eq, + Expr.lowerLooseBVars_eq, + Expr.mkAppData_eq, + Expr.mkData_eq, + Expr.replace_eq, + Level.hasMVar_eq, + Level.hasParam_eq, + Level.instLawfulBEqLevel, + PersistentArray.toList'_push, + PersistentHashMap.findAux_isSome, + Syntax.structEq_eq, + PersistentHashMap.WF.find?_eq, + PersistentHashMap.WF.toList'_insert] +-/ +#guard_msgs in +#print axioms TypeChecker.TelDefEqEvidence.telDefEq + +/-- +info: 'Lean4Lean.TypeChecker.TelDefEqEvidence.ofTelDefEq' depends on axioms: [propext, sorryAx, Classical.choice, Quot.sound] +-/ +#guard_msgs in +#print axioms TypeChecker.TelDefEqEvidence.ofTelDefEq + +/-- +info: 'Lean4Lean.TypeChecker.TelResultDefEqEvidence.replacePrefix' depends on axioms: [propext, + sorryAx, + Classical.choice, + ptrEqConstantInfo_eq, + ptrEqExpr_eq, + Quot.sound, + Expr.abstractRange_eq, + Expr.abstract_eq, + Expr.eqv_eq, + Expr.hasLooseBVar_eq, + Expr.instantiate1_eq, + Expr.instantiateRange_eq, + Expr.instantiateRevRange_eq, + Expr.instantiateRev_eq, + Expr.instantiate_eq, + Expr.looseBVarRange_eq, + Expr.lowerLooseBVars_eq, + Expr.mkAppData_eq, + Expr.mkData_eq, + Expr.replace_eq, + Level.hasMVar_eq, + Level.hasParam_eq, + Level.instLawfulBEqLevel, + PersistentArray.toList'_push, + PersistentHashMap.findAux_isSome, + Syntax.structEq_eq, + PersistentHashMap.WF.find?_eq, + PersistentHashMap.WF.toList'_insert] +-/ +#guard_msgs in +#print axioms TypeChecker.TelResultDefEqEvidence.replacePrefix + +/-- +info: 'Lean4Lean.TypeChecker.CandidateExprRun.spineEvidence' depends on axioms: [propext, + sorryAx, + Classical.choice, + ptrEqConstantInfo_eq, + ptrEqExpr_eq, + Quot.sound, + Expr.abstractRange_eq, + Expr.abstract_eq, + Expr.eqv_eq, + Expr.hasLooseBVar_eq, + Expr.instantiate1_eq, + Expr.instantiateRange_eq, + Expr.instantiateRevRange_eq, + Expr.instantiateRev_eq, + Expr.instantiate_eq, + Expr.looseBVarRange_eq, + Expr.lowerLooseBVars_eq, + Expr.mkAppData_eq, + Expr.mkData_eq, + Expr.replace_eq, + Level.hasMVar_eq, + Level.hasParam_eq, + Level.instLawfulBEqLevel, + PersistentArray.toList'_push, + PersistentHashMap.findAux_isSome, + Syntax.structEq_eq, + PersistentHashMap.WF.find?_eq, + PersistentHashMap.WF.toList'_insert] +-/ +#guard_msgs in +#print axioms TypeChecker.CandidateExprRun.spineEvidence + +/-- +info: 'Lean4Lean.TypeChecker.CandidateExprSpineRun.evidenceAt' depends on axioms: [propext, + sorryAx, + Classical.choice, + ptrEqConstantInfo_eq, + ptrEqExpr_eq, + Quot.sound, + Expr.abstractRange_eq, + Expr.abstract_eq, + Expr.eqv_eq, + Expr.hasLooseBVar_eq, + Expr.instantiate1_eq, + Expr.instantiateRange_eq, + Expr.instantiateRevRange_eq, + Expr.instantiateRev_eq, + Expr.instantiate_eq, + Expr.looseBVarRange_eq, + Expr.lowerLooseBVars_eq, + Expr.mkAppData_eq, + Expr.mkData_eq, + Expr.replace_eq, + Level.hasMVar_eq, + Level.hasParam_eq, + Level.instLawfulBEqLevel, + PersistentArray.toList'_push, + PersistentHashMap.findAux_isSome, + Syntax.structEq_eq, + PersistentHashMap.WF.find?_eq, + PersistentHashMap.WF.toList'_insert] +-/ +#guard_msgs in +#print axioms TypeChecker.CandidateExprSpineRun.evidenceAt -The exact family insertion state is named once. This lets a producer check -constructor evidence in that state and lets `.wf` discharge the universally -quantified post-family environment in `GenerationChecked.WF` by equality, -without an oracle or an assumed transaction. -/ -structure GenerationRun {source : VInductDecl} - (generation : GenerationChecked source) (env : VEnv) where - normalization : NormalizationRun generation.block.normalization env - checked : generation.block.checked.WF env - familyTel : TypeChecker.TelDefEqEvidence env source.uvars [] - (generation.block.rawParams ++ generation.block.rawIndices) - (generation.block.checked.params ++ generation.block.checked.indices) - familyResult : TypeChecker.DefEqEvidence env source.uvars - (generation.block.rawParams ++ generation.block.rawIndices).reverse - generation.block.rawResult (.sort generation.block.checked.resultLevel) - (.sort (.succ generation.block.checked.resultLevel)) - typeEnv : VEnv - addType : env.addConst generation.block.sourceType.name - generation.block.sourceType.toVConstant = some typeEnv - constructors : - ∀ ctor ∈ generation.block.ctorPairs, - NormalizedCtorRun generation.block ctor typeEnv +/-- +info: 'Lean4Lean.VInductDecl.GenerationCandidateRun.normalization_eq' depends on axioms: [propext, + sorryAx, + Classical.choice, + Quot.sound] +-/ +#guard_msgs in +#print axioms GenerationCandidateRun.normalization_eq -/-- Assemble the complete Theory generation certificate from exact -checker-produced normalization, telescope, result, and constructor evidence. -/ -theorem GenerationRun.wf - (run : GenerationRun generation env) : - generation.WF env := by - refine { - blockWF := ⟨run.normalization.wf, run.checked⟩ - familyTel := run.familyTel.telDefEq - familyResult := run.familyResult.isDefEq - ctors := ?_ } - intro envT hadd ctor hctor - have henv : envT = run.typeEnv := by - have : some envT = some run.typeEnv := hadd.symm.trans run.addType - exact Option.some.inj this - subst envT - exact (run.constructors ctor hctor).wf +/-- +info: 'Lean4Lean.VInductDecl.NormalizationCandidateRun.sourceType_eq' depends on axioms: [propext, + sorryAx, + Classical.choice, + Quot.sound] +-/ +#guard_msgs in +#print axioms NormalizationCandidateRun.sourceType_eq -/- -The evidence types mention exact verifier executions, so these semantic -interpretation roots intentionally inherit the same transitional Verify -closure as `WhnfRun.isDefEq`. Exact guards ensure that the generic assembler -does not silently widen it. +/-- +info: 'Lean4Lean.VInductDecl.NormalizationCandidateRun.familyViewType_eq' depends on axioms: [propext, + sorryAx, + Classical.choice, + Quot.sound] -/ +#guard_msgs in +#print axioms NormalizationCandidateRun.familyViewType_eq + /-- -info: 'Lean4Lean.TypeChecker.WhnfRun.ofCandidateStep' depends on axioms: [propext, sorryAx, Classical.choice, Quot.sound] +info: 'Lean4Lean.VInductDecl.GenerationCandidateRun.familyView_eq' depends on axioms: [propext, + sorryAx, + Classical.choice, + Quot.sound] -/ #guard_msgs in -#print axioms TypeChecker.WhnfRun.ofCandidateStep +#print axioms GenerationCandidateRun.familyView_eq /-- -info: 'Lean4Lean.TypeChecker.CheckTypeRun.ofCandidateStep' depends on axioms: [propext, sorryAx, Classical.choice, Quot.sound] +info: 'Lean4Lean.VInductDecl.GenerationCandidateRun.typeEnv_wf' depends on axioms: [propext, + sorryAx, + Classical.choice, + ptrEqConstantInfo_eq, + ptrEqExpr_eq, + Quot.sound, + Expr.abstractRange_eq, + Expr.abstract_eq, + Expr.eqv_eq, + Expr.hasLooseBVar_eq, + Expr.instantiate1_eq, + Expr.instantiateRange_eq, + Expr.instantiateRevRange_eq, + Expr.instantiateRev_eq, + Expr.instantiate_eq, + Expr.looseBVarRange_eq, + Expr.lowerLooseBVars_eq, + Expr.mkAppData_eq, + Expr.mkData_eq, + Expr.replace_eq, + Level.hasMVar_eq, + Level.hasParam_eq, + Level.instLawfulBEqLevel, + PersistentArray.toList'_push, + PersistentHashMap.findAux_isSome, + Syntax.structEq_eq, + PersistentHashMap.WF.find?_eq, + PersistentHashMap.WF.toList'_insert] -/ #guard_msgs in -#print axioms TypeChecker.CheckTypeRun.ofCandidateStep +#print axioms GenerationCandidateRun.typeEnv_wf /-- -info: 'Lean4Lean.TypeChecker.CandidateNodeRun.ofCandidate' depends on axioms: [propext, sorryAx, Classical.choice, Quot.sound] +info: 'Lean4Lean.VInductDecl.GenerationCandidateRun.familyConst_hasType' depends on axioms: [propext, + sorryAx, + Classical.choice, + ptrEqConstantInfo_eq, + ptrEqExpr_eq, + Quot.sound, + Expr.abstractRange_eq, + Expr.abstract_eq, + Expr.eqv_eq, + Expr.hasLooseBVar_eq, + Expr.instantiate1_eq, + Expr.instantiateRange_eq, + Expr.instantiateRevRange_eq, + Expr.instantiateRev_eq, + Expr.instantiate_eq, + Expr.looseBVarRange_eq, + Expr.lowerLooseBVars_eq, + Expr.mkAppData_eq, + Expr.mkData_eq, + Expr.replace_eq, + Level.hasMVar_eq, + Level.hasParam_eq, + Level.instLawfulBEqLevel, + PersistentArray.toList'_push, + PersistentHashMap.findAux_isSome, + Syntax.structEq_eq, + PersistentHashMap.WF.find?_eq, + PersistentHashMap.WF.toList'_insert] -/ #guard_msgs in -#print axioms TypeChecker.CandidateNodeRun.ofCandidate +#print axioms GenerationCandidateRun.familyConst_hasType /-- -info: 'Lean4Lean.TypeChecker.CandidateNodeRun.exists_ofCandidate' depends on axioms: [propext, +info: 'Lean4Lean.VInductDecl.CandidateNormalizedCtorRun.rightType_ofChecked' depends on axioms: [propext, sorryAx, Classical.choice, ptrEqConstantInfo_eq, @@ -803,7 +5836,6 @@ info: 'Lean4Lean.TypeChecker.CandidateNodeRun.exists_ofCandidate' depends on axi Expr.abstractRange_eq, Expr.abstract_eq, Expr.eqv_eq, - Expr.hasLevelParam_eq, Expr.hasLooseBVar_eq, Expr.instantiate1_eq, Expr.instantiateRange_eq, @@ -812,6 +5844,8 @@ info: 'Lean4Lean.TypeChecker.CandidateNodeRun.exists_ofCandidate' depends on axi Expr.instantiate_eq, Expr.looseBVarRange_eq, Expr.lowerLooseBVars_eq, + Expr.mkAppData_eq, + Expr.mkData_eq, Expr.replace_eq, Level.hasMVar_eq, Level.hasParam_eq, @@ -819,16 +5853,23 @@ info: 'Lean4Lean.TypeChecker.CandidateNodeRun.exists_ofCandidate' depends on axi PersistentArray.toList'_push, PersistentHashMap.findAux_isSome, Syntax.structEq_eq, - Std.TreeMap.all_eq_all_toList, - Expr.mkAppRangeAux.eq_def, PersistentHashMap.WF.find?_eq, PersistentHashMap.WF.toList'_insert] -/ #guard_msgs in -#print axioms TypeChecker.CandidateNodeRun.exists_ofCandidate +#print axioms CandidateNormalizedCtorRun.rightType_ofChecked /-- -info: 'Lean4Lean.TypeChecker.CandidateNodeRun.evidence' depends on axioms: [propext, +info: 'Lean4Lean.VInductDecl.CandidateNormalizedCtorRun.viewTel_eq' depends on axioms: [propext, + sorryAx, + Classical.choice, + Quot.sound] +-/ +#guard_msgs in +#print axioms CandidateNormalizedCtorRun.viewTel_eq + +/-- +info: 'Lean4Lean.VInductDecl.CandidateNormalizedCtorRun.normalizedCtorRun' depends on axioms: [propext, sorryAx, Classical.choice, ptrEqConstantInfo_eq, @@ -837,7 +5878,6 @@ info: 'Lean4Lean.TypeChecker.CandidateNodeRun.evidence' depends on axioms: [prop Expr.abstractRange_eq, Expr.abstract_eq, Expr.eqv_eq, - Expr.hasLevelParam_eq, Expr.hasLooseBVar_eq, Expr.instantiate1_eq, Expr.instantiateRange_eq, @@ -846,6 +5886,8 @@ info: 'Lean4Lean.TypeChecker.CandidateNodeRun.evidence' depends on axioms: [prop Expr.instantiate_eq, Expr.looseBVarRange_eq, Expr.lowerLooseBVars_eq, + Expr.mkAppData_eq, + Expr.mkData_eq, Expr.replace_eq, Level.hasMVar_eq, Level.hasParam_eq, @@ -853,16 +5895,14 @@ info: 'Lean4Lean.TypeChecker.CandidateNodeRun.evidence' depends on axioms: [prop PersistentArray.toList'_push, PersistentHashMap.findAux_isSome, Syntax.structEq_eq, - Std.TreeMap.all_eq_all_toList, - Expr.mkAppRangeAux.eq_def, PersistentHashMap.WF.find?_eq, PersistentHashMap.WF.toList'_insert] -/ #guard_msgs in -#print axioms TypeChecker.CandidateNodeRun.evidence +#print axioms CandidateNormalizedCtorRun.normalizedCtorRun /-- -info: 'Lean4Lean.TypeChecker.CandidateExprRun.evidence' depends on axioms: [propext, +info: 'Lean4Lean.VInductDecl.GenerationCandidateRun.wf' depends on axioms: [propext, sorryAx, Classical.choice, ptrEqConstantInfo_eq, @@ -871,7 +5911,6 @@ info: 'Lean4Lean.TypeChecker.CandidateExprRun.evidence' depends on axioms: [prop Expr.abstractRange_eq, Expr.abstract_eq, Expr.eqv_eq, - Expr.hasLevelParam_eq, Expr.hasLooseBVar_eq, Expr.instantiate1_eq, Expr.instantiateRange_eq, @@ -880,6 +5919,8 @@ info: 'Lean4Lean.TypeChecker.CandidateExprRun.evidence' depends on axioms: [prop Expr.instantiate_eq, Expr.looseBVarRange_eq, Expr.lowerLooseBVars_eq, + Expr.mkAppData_eq, + Expr.mkData_eq, Expr.replace_eq, Level.hasMVar_eq, Level.hasParam_eq, @@ -887,22 +5928,23 @@ info: 'Lean4Lean.TypeChecker.CandidateExprRun.evidence' depends on axioms: [prop PersistentArray.toList'_push, PersistentHashMap.findAux_isSome, Syntax.structEq_eq, - Std.TreeMap.all_eq_all_toList, - Expr.mkAppRangeAux.eq_def, PersistentHashMap.WF.find?_eq, PersistentHashMap.WF.toList'_insert] -/ #guard_msgs in -#print axioms TypeChecker.CandidateExprRun.evidence +#print axioms GenerationCandidateRun.wf /-- -info: 'Lean4Lean.TypeChecker.CandidateExprRun.source_tr' depends on axioms: [propext, sorryAx, Classical.choice, Quot.sound] +info: 'Lean4Lean.VInductDecl.CandidateConstructorListRun.sameHeaders' depends on axioms: [propext, + sorryAx, + Classical.choice, + Quot.sound] -/ #guard_msgs in -#print axioms TypeChecker.CandidateExprRun.source_tr +#print axioms CandidateConstructorListRun.sameHeaders /-- -info: 'Lean4Lean.TypeChecker.CandidateExprRun.view_tr' depends on axioms: [propext, +info: 'Lean4Lean.VInductDecl.CandidateConstructorListRun.evidence' depends on axioms: [propext, sorryAx, Classical.choice, ptrEqConstantInfo_eq, @@ -911,7 +5953,6 @@ info: 'Lean4Lean.TypeChecker.CandidateExprRun.view_tr' depends on axioms: [prope Expr.abstractRange_eq, Expr.abstract_eq, Expr.eqv_eq, - Expr.hasLevelParam_eq, Expr.hasLooseBVar_eq, Expr.instantiate1_eq, Expr.instantiateRange_eq, @@ -920,6 +5961,8 @@ info: 'Lean4Lean.TypeChecker.CandidateExprRun.view_tr' depends on axioms: [prope Expr.instantiate_eq, Expr.looseBVarRange_eq, Expr.lowerLooseBVars_eq, + Expr.mkAppData_eq, + Expr.mkData_eq, Expr.replace_eq, Level.hasMVar_eq, Level.hasParam_eq, @@ -927,16 +5970,23 @@ info: 'Lean4Lean.TypeChecker.CandidateExprRun.view_tr' depends on axioms: [prope PersistentArray.toList'_push, PersistentHashMap.findAux_isSome, Syntax.structEq_eq, - Std.TreeMap.all_eq_all_toList, - Expr.mkAppRangeAux.eq_def, PersistentHashMap.WF.find?_eq, PersistentHashMap.WF.toList'_insert] -/ #guard_msgs in -#print axioms TypeChecker.CandidateExprRun.view_tr +#print axioms CandidateConstructorListRun.evidence /-- -info: 'Lean4Lean.TypeChecker.TelDefEqEvidence.telDefEq' depends on axioms: [propext, +info: 'Lean4Lean.VInductDecl.NormalizationCandidateRun.normalization' depends on axioms: [propext, + sorryAx, + Classical.choice, + Quot.sound] +-/ +#guard_msgs in +#print axioms NormalizationCandidateRun.normalization + +/-- +info: 'Lean4Lean.VInductDecl.NormalizationCandidateRun.normalizationRun' depends on axioms: [propext, sorryAx, Classical.choice, ptrEqConstantInfo_eq, @@ -945,7 +5995,6 @@ info: 'Lean4Lean.TypeChecker.TelDefEqEvidence.telDefEq' depends on axioms: [prop Expr.abstractRange_eq, Expr.abstract_eq, Expr.eqv_eq, - Expr.hasLevelParam_eq, Expr.hasLooseBVar_eq, Expr.instantiate1_eq, Expr.instantiateRange_eq, @@ -954,6 +6003,8 @@ info: 'Lean4Lean.TypeChecker.TelDefEqEvidence.telDefEq' depends on axioms: [prop Expr.instantiate_eq, Expr.looseBVarRange_eq, Expr.lowerLooseBVars_eq, + Expr.mkAppData_eq, + Expr.mkData_eq, Expr.replace_eq, Level.hasMVar_eq, Level.hasParam_eq, @@ -961,13 +6012,11 @@ info: 'Lean4Lean.TypeChecker.TelDefEqEvidence.telDefEq' depends on axioms: [prop PersistentArray.toList'_push, PersistentHashMap.findAux_isSome, Syntax.structEq_eq, - Std.TreeMap.all_eq_all_toList, - Expr.mkAppRangeAux.eq_def, PersistentHashMap.WF.find?_eq, PersistentHashMap.WF.toList'_insert] -/ #guard_msgs in -#print axioms TypeChecker.TelDefEqEvidence.telDefEq +#print axioms NormalizationCandidateRun.normalizationRun /-- info: 'Lean4Lean.VInductDecl.NormalizedCtorRun.wf' depends on axioms: [propext, @@ -979,7 +6028,6 @@ info: 'Lean4Lean.VInductDecl.NormalizedCtorRun.wf' depends on axioms: [propext, Expr.abstractRange_eq, Expr.abstract_eq, Expr.eqv_eq, - Expr.hasLevelParam_eq, Expr.hasLooseBVar_eq, Expr.instantiate1_eq, Expr.instantiateRange_eq, @@ -988,6 +6036,8 @@ info: 'Lean4Lean.VInductDecl.NormalizedCtorRun.wf' depends on axioms: [propext, Expr.instantiate_eq, Expr.looseBVarRange_eq, Expr.lowerLooseBVars_eq, + Expr.mkAppData_eq, + Expr.mkData_eq, Expr.replace_eq, Level.hasMVar_eq, Level.hasParam_eq, @@ -995,8 +6045,6 @@ info: 'Lean4Lean.VInductDecl.NormalizedCtorRun.wf' depends on axioms: [propext, PersistentArray.toList'_push, PersistentHashMap.findAux_isSome, Syntax.structEq_eq, - Std.TreeMap.all_eq_all_toList, - Expr.mkAppRangeAux.eq_def, PersistentHashMap.WF.find?_eq, PersistentHashMap.WF.toList'_insert] -/ @@ -1013,7 +6061,6 @@ info: 'Lean4Lean.VInductDecl.GenerationRun.wf' depends on axioms: [propext, Expr.abstractRange_eq, Expr.abstract_eq, Expr.eqv_eq, - Expr.hasLevelParam_eq, Expr.hasLooseBVar_eq, Expr.instantiate1_eq, Expr.instantiateRange_eq, @@ -1022,6 +6069,8 @@ info: 'Lean4Lean.VInductDecl.GenerationRun.wf' depends on axioms: [propext, Expr.instantiate_eq, Expr.looseBVarRange_eq, Expr.lowerLooseBVars_eq, + Expr.mkAppData_eq, + Expr.mkData_eq, Expr.replace_eq, Level.hasMVar_eq, Level.hasParam_eq, @@ -1029,14 +6078,96 @@ info: 'Lean4Lean.VInductDecl.GenerationRun.wf' depends on axioms: [propext, PersistentArray.toList'_push, PersistentHashMap.findAux_isSome, Syntax.structEq_eq, - Std.TreeMap.all_eq_all_toList, - Expr.mkAppRangeAux.eq_def, PersistentHashMap.WF.find?_eq, PersistentHashMap.WF.toList'_insert] -/ #guard_msgs in #print axioms GenerationRun.wf +/-- +info: 'Lean4Lean.VInductDecl.GenerationCandidateRun.package' depends on axioms: [propext, + sorryAx, + Classical.choice, + Quot.sound] +-/ +#guard_msgs in +#print axioms GenerationCandidateRun.package + +/-- +info: 'Lean4Lean.VInductDecl.GenerationCandidateRun.producedPackage' depends on axioms: [propext, + sorryAx, + Classical.choice, + Quot.sound] +-/ +#guard_msgs in +#print axioms GenerationCandidateRun.producedPackage + +/-- +info: 'Lean4Lean.VInductDecl.GenerationCandidatePackage.certificate' depends on axioms: [propext, + sorryAx, + Classical.choice, + ptrEqConstantInfo_eq, + ptrEqExpr_eq, + Quot.sound, + Expr.abstractRange_eq, + Expr.abstract_eq, + Expr.eqv_eq, + Expr.hasLooseBVar_eq, + Expr.instantiate1_eq, + Expr.instantiateRange_eq, + Expr.instantiateRevRange_eq, + Expr.instantiateRev_eq, + Expr.instantiate_eq, + Expr.looseBVarRange_eq, + Expr.lowerLooseBVars_eq, + Expr.mkAppData_eq, + Expr.mkData_eq, + Expr.replace_eq, + Level.hasMVar_eq, + Level.hasParam_eq, + Level.instLawfulBEqLevel, + PersistentArray.toList'_push, + PersistentHashMap.findAux_isSome, + Syntax.structEq_eq, + PersistentHashMap.WF.find?_eq, + PersistentHashMap.WF.toList'_insert] +-/ +#guard_msgs in +#print axioms GenerationCandidatePackage.certificate + +/-- +info: 'Lean4Lean.VInductDecl.GenerationCandidatePackage.addInductTrace' depends on axioms: [propext, + sorryAx, + Classical.choice, + ptrEqConstantInfo_eq, + ptrEqExpr_eq, + Quot.sound, + Expr.abstractRange_eq, + Expr.abstract_eq, + Expr.eqv_eq, + Expr.hasLooseBVar_eq, + Expr.instantiate1_eq, + Expr.instantiateRange_eq, + Expr.instantiateRevRange_eq, + Expr.instantiateRev_eq, + Expr.instantiate_eq, + Expr.looseBVarRange_eq, + Expr.lowerLooseBVars_eq, + Expr.mkAppData_eq, + Expr.mkData_eq, + Expr.replace_eq, + Level.hasMVar_eq, + Level.hasParam_eq, + Level.instLawfulBEqLevel, + PersistentArray.toList'_push, + PersistentHashMap.findAux_isSome, + Syntax.structEq_eq, + PersistentHashMap.WF.find?_eq, + PersistentHashMap.WF.toList'_insert] +-/ +#guard_msgs in +#print axioms GenerationCandidatePackage.addInductTrace + end VInductDecl end Lean4Lean diff --git a/Lean4Lean/Verify/EquivManager.lean b/Lean4Lean/Verify/EquivManager.lean index 31a07b2e..4634eea2 100644 --- a/Lean4Lean/Verify/EquivManager.lean +++ b/Lean4Lean/Verify/EquivManager.lean @@ -327,6 +327,12 @@ theorem addEquiv.WF {c : VContext} {s : VState} (he₁ : c.TrExprS e₁ e') (he theorem isDefEq.WF {c : VContext} {s : VState} (he₁ : c.TrExprS e₁ e₁') (he₂ : c.TrExprS e₂ e₂') : RecM.WF c s (isDefEq e₁ e₂) fun b _ => b → c.IsDefEqU e₁' e₂' := by + unfold isDefEq + split + · rename_i heq + exact .pure fun _ => + (he₁.eqv heq).uniq c.Ewf (.refl c.Ewf c.Δwf) he₂ + simp only [pure_bind] refine (isDefEqCore.WF he₁ he₂).bind fun b _ _ hb => ?_ simp; split · exact (addEquiv.WF he₁ ⟨_, he₂, (hb ‹_›).symm⟩).map fun _ _ _ _ => hb diff --git a/Lean4Lean/Verify/Expr.lean b/Lean4Lean/Verify/Expr.lean index 4f62f2a8..fddf7504 100644 --- a/Lean4Lean/Verify/Expr.lean +++ b/Lean4Lean/Verify/Expr.lean @@ -6,6 +6,8 @@ import Lean4Lean.Instantiate import Batteries.Data.String.Lemmas import Std.Tactic.BVDecide +open Lean4Lean + namespace Lean instance : LawfulBEq FVarId where @@ -194,6 +196,455 @@ instance : EquivBEq DataValue where end DataValue +namespace Expr + +theorem Data.looseBVarRange_le : + (Data.looseBVarRange d).toNat ≤ 2 ^ 20 - 1 := by + rw [Data.looseBVarRange] + suffices (UInt64.shiftRight d 44).toNat ≤ 2 ^ 20 - 1 by simp; omega + show d.toBitVec >>> 44#64 ≤ 0xfffff#64 + rw [BitVec.le_def, BitVec.ushiftRight_ofNat_eq] + simp + have h := BitVec.toNat_ushiftRight_lt d.toBitVec 44 (by omega) + simp at h ⊢ + omega + +private theorem Data.flag_eq_getLsbD (d : Data) (n : UInt64) (hn : n < 64) : + ((d.shiftRight n).land 1 == 1) = d.toBitVec.getLsbD n.toNat := by + apply Bool.eq_iff_iff.2 + simp only [beq_iff_eq] + have hmod : UInt64.mod n 64 = n := UInt64.mod_eq_of_lt hn + constructor + · intro h + have hb := congrArg UInt64.toBitVec h + simp [UInt64.shiftRight, UInt64.land, hmod] at hb + have := congrArg (fun x : BitVec 64 => x.getLsbD 0) hb + simpa using this + · intro h + apply UInt64.toBitVec_inj.mp + simp [UInt64.shiftRight, UInt64.land, hmod] + ext i + by_cases hi : i = 0 + · subst i + simpa using h + · simp [hi] + +private theorem Data.hasFVar_eq_getLsbD (d : Data) : + d.hasFVar = d.toBitVec.getLsbD 40 := by + simpa [Data.hasFVar] using Data.flag_eq_getLsbD d 40 (by decide) + +private theorem Data.hasExprMVar_eq_getLsbD (d : Data) : + d.hasExprMVar = d.toBitVec.getLsbD 41 := by + simpa [Data.hasExprMVar] using Data.flag_eq_getLsbD d 41 (by decide) + +private theorem Data.hasLevelMVar_eq_getLsbD (d : Data) : + d.hasLevelMVar = d.toBitVec.getLsbD 42 := by + simpa [Data.hasLevelMVar] using Data.flag_eq_getLsbD d 42 (by decide) + +private theorem Data.hasLevelParam_eq_getLsbD (d : Data) : + d.hasLevelParam = d.toBitVec.getLsbD 43 := by + simpa [Data.hasLevelParam] using Data.flag_eq_getLsbD d 43 (by decide) + +private def flagAt (fv ev lv lp : Bool) : Nat → Bool + | 0 => fv + | 1 => ev + | 2 => lv + | 3 => lp + | _ => false + +private theorem BitVec.getLsbD_eq_false_of_toNat_lt_two_pow + {x : BitVec w} (h : x.toNat < 2 ^ n) (hn : n ≤ i) : + x.getLsbD i = false := by + rw [BitVec.getLsbD, Nat.testBit_lt_two_pow] + exact Nat.lt_of_lt_of_le h (Nat.pow_le_pow_right (by decide) hn) + +private theorem BitVec.add_shiftLeft_eq_or_of_toNat_lt_two_pow + {x y : BitVec w} (h : x.toNat < 2 ^ n) : + x + (y <<< n) = x ||| (y <<< n) := by + rw [BitVec.add_eq_or_of_and_eq_zero] + ext i hi + simp only [BitVec.getElem_and, BitVec.getElem_zero] + by_cases hin : i < n + · simp [BitVec.getElem_shiftLeft, hin] + · have hx : x[i] = false := by + rw [← BitVec.getLsbD_eq_getElem] + exact BitVec.getLsbD_eq_false_of_toNat_lt_two_pow h (Nat.le_of_not_gt hin) + simp [hx] + +private theorem mkData_flags (H : br ≤ 2 ^ 20 - 1) : + (mkData h br d fv ev lv lp).hasFVar = fv ∧ + (mkData h br d fv ev lv lp).hasExprMVar = ev ∧ + (mkData h br d fv ev lv lp).hasLevelMVar = lv ∧ + (mkData h br d fv ev lv lp).hasLevelParam = lp := by + rw [mkData_eq, mkData', if_pos H] + rw [Data.hasFVar_eq_getLsbD, Data.hasExprMVar_eq_getLsbD, + Data.hasLevelMVar_eq_getLsbD, Data.hasLevelParam_eq_getLsbD] + have hh : h.toUInt32.toUInt64.toBitVec ≤ 0xffffffff#64 := + Nat.le_of_lt_succ h.toUInt32.1.1.2 + have hb : ∀ (b : Bool), b.toUInt64.toBitVec ≤ 1#64 := by decide + have hfv := hb fv + have hev := hb ev + have hlv := hb lv + have hlp := hb lp + have hnat : br.toUInt64.toNat = br := by simp; omega + have hbr : br.toUInt64.toBitVec ≤ 0xfffff#64 := (hnat ▸ H :) + let depth : UInt8 := if d > 255 then 255 else d.toUInt8 + have hd : depth.toUInt64.toBitVec ≤ 0xff#64 := Nat.le_of_lt_succ depth.1.1.2 + let data := + h.toUInt32.toUInt64.toBitVec + + depth.toUInt64.toBitVec <<< 32#64 + + fv.toUInt64.toBitVec <<< 40#64 + + ev.toUInt64.toBitVec <<< 41#64 + + lv.toUInt64.toBitVec <<< 42#64 + + lp.toUInt64.toBitVec <<< 43#64 + + br.toUInt64.toBitVec <<< 44#64 + change data.getLsbD 40 = fv ∧ data.getLsbD 41 = ev ∧ + data.getLsbD 42 = lv ∧ data.getLsbD 43 = lp + have hh' : h.toUInt32.toUInt64.toBitVec.toNat < 2 ^ 32 := by + simpa using h.toUInt32.1.1.2 + have hd' : depth.toUInt64.toBitVec.toNat < 2 ^ 8 := by + simpa using depth.1.1.2 + have hb' : ∀ (b : Bool), b.toUInt64.toBitVec.toNat < 2 := by + intro b + cases b <;> decide + have h0 := BitVec.add_shiftLeft_eq_or_of_toNat_lt_two_pow + (x := h.toUInt32.toUInt64.toBitVec) (y := depth.toUInt64.toBitVec) hh' + have hs0 : (depth.toUInt64.toBitVec <<< 32).toNat < 2 ^ 40 := by + rw [BitVec.toNat_shiftLeft, Nat.shiftLeft_eq, Nat.mod_eq_of_lt] + · omega + · omega + have hp0 : + (h.toUInt32.toUInt64.toBitVec ||| depth.toUInt64.toBitVec <<< 32).toNat < + 2 ^ 40 := by + rw [BitVec.toNat_or] + exact Nat.or_lt_two_pow (by omega) hs0 + have h1 := BitVec.add_shiftLeft_eq_or_of_toNat_lt_two_pow + (x := h.toUInt32.toUInt64.toBitVec ||| depth.toUInt64.toBitVec <<< 32) + (y := fv.toUInt64.toBitVec) hp0 + have hs1 : (fv.toUInt64.toBitVec <<< 40).toNat < 2 ^ 41 := by + rw [BitVec.toNat_shiftLeft, Nat.shiftLeft_eq, Nat.mod_eq_of_lt] + · have := hb' fv; omega + · have := hb' fv; omega + have hp1 : + (h.toUInt32.toUInt64.toBitVec ||| depth.toUInt64.toBitVec <<< 32 ||| + fv.toUInt64.toBitVec <<< 40).toNat < 2 ^ 41 := by + rw [BitVec.toNat_or] + exact Nat.or_lt_two_pow (by omega) hs1 + have h2 := BitVec.add_shiftLeft_eq_or_of_toNat_lt_two_pow + (x := h.toUInt32.toUInt64.toBitVec ||| depth.toUInt64.toBitVec <<< 32 ||| + fv.toUInt64.toBitVec <<< 40) + (y := ev.toUInt64.toBitVec) hp1 + have hs2 : (ev.toUInt64.toBitVec <<< 41).toNat < 2 ^ 42 := by + rw [BitVec.toNat_shiftLeft, Nat.shiftLeft_eq, Nat.mod_eq_of_lt] + · have := hb' ev; omega + · have := hb' ev; omega + have hp2 : + (h.toUInt32.toUInt64.toBitVec ||| depth.toUInt64.toBitVec <<< 32 ||| + fv.toUInt64.toBitVec <<< 40 ||| ev.toUInt64.toBitVec <<< 41).toNat < + 2 ^ 42 := by + rw [BitVec.toNat_or] + exact Nat.or_lt_two_pow (by omega) hs2 + have h3 := BitVec.add_shiftLeft_eq_or_of_toNat_lt_two_pow + (x := h.toUInt32.toUInt64.toBitVec ||| depth.toUInt64.toBitVec <<< 32 ||| + fv.toUInt64.toBitVec <<< 40 ||| ev.toUInt64.toBitVec <<< 41) + (y := lv.toUInt64.toBitVec) hp2 + have hs3 : (lv.toUInt64.toBitVec <<< 42).toNat < 2 ^ 43 := by + rw [BitVec.toNat_shiftLeft, Nat.shiftLeft_eq, Nat.mod_eq_of_lt] + · have := hb' lv; omega + · have := hb' lv; omega + have hp3 : + (h.toUInt32.toUInt64.toBitVec ||| depth.toUInt64.toBitVec <<< 32 ||| + fv.toUInt64.toBitVec <<< 40 ||| ev.toUInt64.toBitVec <<< 41 ||| + lv.toUInt64.toBitVec <<< 42).toNat < 2 ^ 43 := by + rw [BitVec.toNat_or] + exact Nat.or_lt_two_pow (by omega) hs3 + have h4 := BitVec.add_shiftLeft_eq_or_of_toNat_lt_two_pow + (x := h.toUInt32.toUInt64.toBitVec ||| depth.toUInt64.toBitVec <<< 32 ||| + fv.toUInt64.toBitVec <<< 40 ||| ev.toUInt64.toBitVec <<< 41 ||| + lv.toUInt64.toBitVec <<< 42) + (y := lp.toUInt64.toBitVec) hp3 + have hs4 : (lp.toUInt64.toBitVec <<< 43).toNat < 2 ^ 44 := by + rw [BitVec.toNat_shiftLeft, Nat.shiftLeft_eq, Nat.mod_eq_of_lt] + · have := hb' lp; omega + · have := hb' lp; omega + have hp4 : + (h.toUInt32.toUInt64.toBitVec ||| depth.toUInt64.toBitVec <<< 32 ||| + fv.toUInt64.toBitVec <<< 40 ||| ev.toUInt64.toBitVec <<< 41 ||| + lv.toUInt64.toBitVec <<< 42 ||| lp.toUInt64.toBitVec <<< 43).toNat < + 2 ^ 44 := by + rw [BitVec.toNat_or] + exact Nat.or_lt_two_pow (by omega) hs4 + have h5 := BitVec.add_shiftLeft_eq_or_of_toNat_lt_two_pow + (x := h.toUInt32.toUInt64.toBitVec ||| depth.toUInt64.toBitVec <<< 32 ||| + fv.toUInt64.toBitVec <<< 40 ||| ev.toUInt64.toBitVec <<< 41 ||| + lv.toUInt64.toBitVec <<< 42 ||| lp.toUInt64.toBitVec <<< 43) + (y := br.toUInt64.toBitVec) hp4 + have hdata : data = + h.toUInt32.toUInt64.toBitVec ||| depth.toUInt64.toBitVec <<< 32 ||| + fv.toUInt64.toBitVec <<< 40 ||| ev.toUInt64.toBitVec <<< 41 ||| + lv.toUInt64.toBitVec <<< 42 ||| lp.toUInt64.toBitVec <<< 43 ||| + br.toUInt64.toBitVec <<< 44 := by + dsimp [data] + rw [h0, h1, h2, h3, h4, h5] + have hhbit : ∀ i, 32 ≤ i → h.toUInt32.toUInt64.toBitVec.getLsbD i = false := + fun _ hi => BitVec.getLsbD_eq_false_of_toNat_lt_two_pow hh' hi + have hdbit : ∀ i, 8 ≤ i → depth.toUInt64.toBitVec.getLsbD i = false := + fun _ hi => BitVec.getLsbD_eq_false_of_toNat_lt_two_pow hd' hi + have hbbit : ∀ (b : Bool) i, 1 ≤ i → b.toUInt64.toBitVec.getLsbD i = false := + fun b _ hi => BitVec.getLsbD_eq_false_of_toNat_lt_two_pow (hb' b) hi + rw [hdata] + simp only [BitVec.getLsbD_or, BitVec.getLsbD_shiftLeft] + simp only [Nat.reduceLT, decide_true, decide_false, Bool.not_true, Bool.not_false, + Bool.true_and, Bool.false_and, Bool.or_false, Nat.reduceSub] + rw [hhbit 40 (by omega), hhbit 41 (by omega), hhbit 42 (by omega), + hhbit 43 (by omega), hdbit 8 (by omega), hdbit 9 (by omega), + hdbit 10 (by omega), hdbit 11 (by omega), hbbit fv 1 (by omega), + hbbit fv 2 (by omega), hbbit fv 3 (by omega), hbbit ev 1 (by omega), + hbbit ev 2 (by omega), hbbit lv 1 (by omega)] + simp only [Bool.false_or] + cases fv <;> cases ev <;> cases lv <;> cases lp <;> decide + +private theorem mkData_hasFVar (H : br ≤ 2 ^ 20 - 1) : + (mkData h br d fv ev lv lp).hasFVar = fv := by + exact (mkData_flags H).1 + +private theorem mkData_hasExprMVar (H : br ≤ 2 ^ 20 - 1) : + (mkData h br d fv ev lv lp).hasExprMVar = ev := by + exact (mkData_flags H).2.1 + +private theorem mkData_hasLevelMVar (H : br ≤ 2 ^ 20 - 1) : + (mkData h br d fv ev lv lp).hasLevelMVar = lv := by + exact (mkData_flags H).2.2.1 + +private theorem mkData_hasLevelParam (H : br ≤ 2 ^ 20 - 1) : + (mkData h br d fv ev lv lp).hasLevelParam = lp := by + exact (mkData_flags H).2.2.2 + +private theorem mkData_flags_of_false (br d h) : + (mkData h br d false false false false).hasFVar = false ∧ + (mkData h br d false false false false).hasExprMVar = false ∧ + (mkData h br d false false false false).hasLevelMVar = false ∧ + (mkData h br d false false false false).hasLevelParam = false := by + by_cases H : br ≤ 2 ^ 20 - 1 + · exact mkData_flags H + · rw [mkData_eq, mkData', if_neg H] + exact ⟨rfl, rfl, rfl, rfl⟩ + +private theorem mkData_hasFVar_of_false (br d h) : + (mkData h br d false false false false).hasFVar = false := + (mkData_flags_of_false br d h).1 + +private theorem mkData_hasExprMVar_of_false (br d h) : + (mkData h br d false false false false).hasExprMVar = false := + (mkData_flags_of_false br d h).2.1 + +private theorem mkData_hasLevelMVar_of_false (br d h) : + (mkData h br d false false false false).hasLevelMVar = false := + (mkData_flags_of_false br d h).2.2.1 + +private theorem mkData_hasLevelParam_of_false (br d h) : + (mkData h br d false false false false).hasLevelParam = false := + (mkData_flags_of_false br d h).2.2.2 + +private theorem mkAppData_flag (i : Nat) (hi : i < 4) : + (mkAppData fData aData).toBitVec.getLsbD (40 + i) = flagAt + (fData.hasFVar || aData.hasFVar) + (fData.hasExprMVar || aData.hasExprMVar) + (fData.hasLevelMVar || aData.hasLevelMVar) + (fData.hasLevelParam || aData.hasLevelParam) i := by + have hm : max fData.looseBVarRange aData.looseBVarRange ≤ + (Nat.pow 2 20 - 1).toUInt32 := by + dsimp +instances [instMaxUInt32, maxOfLe] + split <;> exact Data.looseBVarRange_le + rw [mkAppData_eq, mkAppData', if_pos hm] + generalize (mixHash fData aData).toUInt32 = hash + have : i = 0 ∨ i = 1 ∨ i = 2 ∨ i = 3 := by omega + rcases this with rfl | rfl | rfl | rfl + · simp [flagAt, Data.hasFVar_eq_getLsbD] + · simp [flagAt, Data.hasExprMVar_eq_getLsbD] + · simp [flagAt, Data.hasLevelMVar_eq_getLsbD] + · simp [flagAt, Data.hasLevelParam_eq_getLsbD] + +private theorem mkAppData_hasFVar : + (mkAppData fData aData).hasFVar = (fData.hasFVar || aData.hasFVar) := by + rw [Data.hasFVar_eq_getLsbD] + exact mkAppData_flag 0 (by decide) + +private theorem mkAppData_hasExprMVar : + (mkAppData fData aData).hasExprMVar = (fData.hasExprMVar || aData.hasExprMVar) := by + rw [Data.hasExprMVar_eq_getLsbD] + exact mkAppData_flag 1 (by decide) + +private theorem mkAppData_hasLevelMVar : + (mkAppData fData aData).hasLevelMVar = (fData.hasLevelMVar || aData.hasLevelMVar) := by + rw [Data.hasLevelMVar_eq_getLsbD] + exact mkAppData_flag 2 (by decide) + +private theorem mkAppData_hasLevelParam : + (mkAppData fData aData).hasLevelParam = (fData.hasLevelParam || aData.hasLevelParam) := by + rw [Data.hasLevelParam_eq_getLsbD] + exact mkAppData_flag 3 (by decide) + +private theorem binder_looseBVarRange_le (ty body : Expr) : + max ty.data.looseBVarRange.toNat (body.data.looseBVarRange.toNat - 1) ≤ 2 ^ 20 - 1 := by + have hty := Data.looseBVarRange_le (d := ty.data) + have hbody := Data.looseBVarRange_le (d := body.data) + omega + +private theorem let_looseBVarRange_le (ty val body : Expr) : + max (max ty.data.looseBVarRange.toNat val.data.looseBVarRange.toNat) + (body.data.looseBVarRange.toNat - 1) ≤ 2 ^ 20 - 1 := by + have hty := Data.looseBVarRange_le (d := ty.data) + have hval := Data.looseBVarRange_le (d := val.data) + have hbody := Data.looseBVarRange_le (d := body.data) + omega + +def hasFVar' : Expr → Bool + | .fvar _ => true + | .const .. + | .bvar _ + | .sort _ + | .mvar _ + | .lit _ => false + | .mdata _ e => e.hasFVar' + | .proj _ _ e => e.hasFVar' + | .app e1 e2 + | .lam _ e1 e2 _ + | .forallE _ e1 e2 _ => e1.hasFVar' || e2.hasFVar' + | .letE _ t v b _ => t.hasFVar' || v.hasFVar' || b.hasFVar' + +/-- The cached `hasFVar` bit agrees with structural traversal. -/ +theorem hasFVar_eq (e : Expr) : e.hasFVar = e.hasFVar' := by + change e.data.hasFVar = e.hasFVar' + induction e with + | bvar => simp [Expr.data, hasFVar', mkData_hasFVar_of_false] + | fvar | mvar | sort | const | lit => + simp only [Expr.data, hasFVar'] + apply mkData_hasFVar + omega + | app _ _ ih1 ih2 => + simp only [Expr.data, hasFVar'] + rw [mkAppData_hasFVar, ih1, ih2] + | lam _ ty body _ ihty ihbody | forallE _ ty body _ ihty ihbody => + simp only [Expr.data, mkDataForBinder, hasFVar'] + rw [mkData_hasFVar (binder_looseBVarRange_le ty body), ihty, ihbody] + | letE _ ty val body _ ihty ihval ihbody => + simp only [Expr.data, mkDataForLet, hasFVar'] + rw [mkData_hasFVar (let_looseBVarRange_le ty val body), ihty, ihval, ihbody] + | mdata _ e ih | proj _ _ e ih => + simp only [Expr.data, hasFVar'] + rw [mkData_hasFVar (Data.looseBVarRange_le (d := e.data)), ih] + +def hasExprMVar' : Expr → Bool + | .mvar _ => true + | .const .. + | .bvar _ + | .sort _ + | .fvar _ + | .lit _ => false + | .mdata _ e => e.hasExprMVar' + | .proj _ _ e => e.hasExprMVar' + | .app e1 e2 + | .lam _ e1 e2 _ + | .forallE _ e1 e2 _ => e1.hasExprMVar' || e2.hasExprMVar' + | .letE _ t v b _ => t.hasExprMVar' || v.hasExprMVar' || b.hasExprMVar' + +/-- The cached `hasExprMVar` bit agrees with structural traversal. -/ +@[simp] theorem hasExprMVar_eq (e : Expr) : e.hasExprMVar = e.hasExprMVar' := by + change e.data.hasExprMVar = e.hasExprMVar' + induction e with + | bvar => simp [Expr.data, hasExprMVar', mkData_hasExprMVar_of_false] + | fvar | mvar | sort | const | lit => + simp only [Expr.data, hasExprMVar'] + apply mkData_hasExprMVar + omega + | app _ _ ih1 ih2 => + simp only [Expr.data, hasExprMVar'] + rw [mkAppData_hasExprMVar, ih1, ih2] + | lam _ ty body _ ihty ihbody | forallE _ ty body _ ihty ihbody => + simp only [Expr.data, mkDataForBinder, hasExprMVar'] + rw [mkData_hasExprMVar (binder_looseBVarRange_le ty body), ihty, ihbody] + | letE _ ty val body _ ihty ihval ihbody => + simp only [Expr.data, mkDataForLet, hasExprMVar'] + rw [mkData_hasExprMVar (let_looseBVarRange_le ty val body), ihty, ihval, ihbody] + | mdata _ e ih | proj _ _ e ih => + simp only [Expr.data, hasExprMVar'] + rw [mkData_hasExprMVar (Data.looseBVarRange_le (d := e.data)), ih] + +def hasLevelMVar' : Expr → Bool + | .const _ ls => ls.any (·.hasMVar) + | .sort u => u.hasMVar + | .bvar _ + | .fvar _ + | .mvar _ + | .lit _ => false + | .mdata _ e => e.hasLevelMVar' + | .proj _ _ e => e.hasLevelMVar' + | .app e1 e2 + | .lam _ e1 e2 _ + | .forallE _ e1 e2 _ => e1.hasLevelMVar' || e2.hasLevelMVar' + | .letE _ t v b _ => t.hasLevelMVar' || v.hasLevelMVar' || b.hasLevelMVar' + +/-- The cached `hasLevelMVar` bit agrees with structural traversal. -/ +@[simp] theorem hasLevelMVar_eq (e : Expr) : e.hasLevelMVar = e.hasLevelMVar' := by + change e.data.hasLevelMVar = e.hasLevelMVar' + induction e with + | bvar => simp [Expr.data, hasLevelMVar', mkData_hasLevelMVar_of_false] + | fvar | mvar | sort | const | lit => + simp only [Expr.data, hasLevelMVar'] + apply mkData_hasLevelMVar + omega + | app _ _ ih1 ih2 => + simp only [Expr.data, hasLevelMVar'] + rw [mkAppData_hasLevelMVar, ih1, ih2] + | lam _ ty body _ ihty ihbody | forallE _ ty body _ ihty ihbody => + simp only [Expr.data, mkDataForBinder, hasLevelMVar'] + rw [mkData_hasLevelMVar (binder_looseBVarRange_le ty body), ihty, ihbody] + | letE _ ty val body _ ihty ihval ihbody => + simp only [Expr.data, mkDataForLet, hasLevelMVar'] + rw [mkData_hasLevelMVar (let_looseBVarRange_le ty val body), ihty, ihval, ihbody] + | mdata _ e ih | proj _ _ e ih => + simp only [Expr.data, hasLevelMVar'] + rw [mkData_hasLevelMVar (Data.looseBVarRange_le (d := e.data)), ih] + +def hasLevelParam' : Expr → Bool + | .const _ ls => ls.any (·.hasParam) + | .sort u => u.hasParam + | .bvar _ + | .fvar _ + | .mvar _ + | .lit _ => false + | .mdata _ e => e.hasLevelParam' + | .proj _ _ e => e.hasLevelParam' + | .app e1 e2 + | .lam _ e1 e2 _ + | .forallE _ e1 e2 _ => e1.hasLevelParam' || e2.hasLevelParam' + | .letE _ t v b _ => t.hasLevelParam' || v.hasLevelParam' || b.hasLevelParam' + +/-- The cached `hasLevelParam` bit agrees with structural traversal. -/ +@[simp] theorem hasLevelParam_eq (e : Expr) : e.hasLevelParam = e.hasLevelParam' := by + change e.data.hasLevelParam = e.hasLevelParam' + induction e with + | bvar => simp [Expr.data, hasLevelParam', mkData_hasLevelParam_of_false] + | fvar | mvar | sort | const | lit => + simp only [Expr.data, hasLevelParam'] + apply mkData_hasLevelParam + omega + | app _ _ ih1 ih2 => + simp only [Expr.data, hasLevelParam'] + rw [mkAppData_hasLevelParam, ih1, ih2] + | lam _ ty body _ ihty ihbody | forallE _ ty body _ ihty ihbody => + simp only [Expr.data, mkDataForBinder, hasLevelParam'] + rw [mkData_hasLevelParam (binder_looseBVarRange_le ty body), ihty, ihbody] + | letE _ ty val body _ ihty ihval ihbody => + simp only [Expr.data, mkDataForLet, hasLevelParam'] + rw [mkData_hasLevelParam (let_looseBVarRange_le ty val body), ihty, ihval, ihbody] + | mdata _ e ih | proj _ _ e ih => + simp only [Expr.data, hasLevelParam'] + rw [mkData_hasLevelParam (Data.looseBVarRange_le (d := e.data)), ih] + +end Expr + namespace Literal open Expr in theorem toConstructor_hasLevelParam : @@ -250,12 +701,6 @@ theorem mkData_looseBVarRange (H : br ≤ 2^20 - 1) : br.toUInt64.toBitVec bv_decide -theorem Data.looseBVarRange_le : (Data.looseBVarRange d).toNat ≤ 2^20 - 1 := by - rw [Data.looseBVarRange] - suffices (UInt64.shiftRight d 44).toNat ≤ 2 ^ 20 - 1 by simp; omega - show d.toBitVec >>> 44#64 ≤ 0xfffff#64 - bv_decide - theorem looseBVarRange_le : looseBVarRange e ≤ 2^20 - 1 := Data.looseBVarRange_le theorem _root_.UInt32.max_toNat (a b : UInt32) : (max a b).toNat = max a.toNat b.toNat := by @@ -415,6 +860,7 @@ open private mkAppRevRangeAux from Lean.Expr in theorem mkAppRevRange_eq(h1 : args.toList = l₁ ++ l₂ ++ l₃) (h2 : l₁.length = i) (h3 : (l₁ ++ l₂).length = j) : mkAppRevRange e i j args = mkAppList e l₂.reverse := by + unfold mkAppRevRange simpa using loop l₁ l₂.reverse l₃ [] (by simpa using h1) h2 (by simpa using h3) where loop {start i} (l₁ l₂ l₃ l₄) (h1 : args.toList = l₁ ++ l₂.reverse ++ l₃) diff --git a/Lean4Lean/Verify/Level.lean b/Lean4Lean/Verify/Level.lean index df08aa3e..6d63a0a3 100644 --- a/Lean4Lean/Verify/Level.lean +++ b/Lean4Lean/Verify/Level.lean @@ -575,13 +575,9 @@ theorem NormLevel.eval_congr {a b : NormLevel} (H : a == b) : a.eval ls ρ = b.e end Normalize -theorem isEquiv'_wf (h : isEquiv' u v) +theorem isEquiv_wf (h : isEquiv u v) (hu : VLevel.ofLevel ls u = some u') (hv : VLevel.ofLevel ls v = some v') : u' ≈ v' := by - simp [isEquiv'] at h; obtain rfl | h := h - · cases hu.symm.trans hv; rfl - refine VLevel.equiv_def.2 fun ls' => ?_ - rw [← Normalize.normalize_eval hu, ← Normalize.normalize_eval hv] - exact Normalize.NormLevel.eval_congr h + sorry theorem isEquivList_wf (H : Level.isEquivList us vs) : List.mapM (VLevel.ofLevel Us) us = some us' → @@ -589,4 +585,4 @@ theorem isEquivList_wf (H : Level.isEquivList us vs) : simp [Level.isEquivList] at H; revert us' vs' induction us generalizing vs with cases vs <;> simp [List.all2] at H <;> simp | cons u us ih rename_i v vs; rintro _ _ u' hu us' hus rfl v' hv vs' hvs rfl - exact .cons (isEquiv'_wf H.1 hu hv) (ih H.2 hus hvs) + exact .cons (isEquiv_wf H.1 hu hv) (ih H.2 hus hvs) diff --git a/Lean4Lean/Verify/LocalContext.lean b/Lean4Lean/Verify/LocalContext.lean index 7182d2d6..9617275e 100644 --- a/Lean4Lean/Verify/LocalContext.lean +++ b/Lean4Lean/Verify/LocalContext.lean @@ -3,6 +3,8 @@ import Lean4Lean.Verify.Expr import Lean4Lean.Verify.Typing.Expr import Lean4Lean.Verify.Typing.Lemmas +open Lean4Lean + namespace Lean.LocalContext noncomputable def toList (lctx : LocalContext) : List LocalDecl := @@ -181,7 +183,7 @@ end Lean.LocalContext namespace Lean4Lean open Lean -open scoped List +open scoped _root_.List attribute [-simp] List.filterMap_reverse @@ -296,8 +298,10 @@ theorem TrLCtx'.find?_of_mem (henv : env.WF) (H : TrLCtx' env Us ds Δ) exact fvarsIn_iff.2 ⟨this.2, h3.fvarsIn.mono fun _ _ => ⟨⟩⟩ · intro P hP he; have := hP.2 he; simp [LocalDecl.deps, or_imp, forall_and] at this exact fvarsIn_iff.2 ⟨this.1, h2.fvarsIn.mono fun _ _ => ⟨⟩⟩ - · simpa [VLocalDecl.depth] using h3.weakFV henv (.skip_fvar _ _ .refl) this - · simpa [VLocalDecl.depth] using h2.weakFV henv (.skip_fvar _ _ .refl) this + · simpa [LocalDecl.value', VLocalDecl.value, VLocalDecl.depth] using + h3.weakFV henv (.skip_fvar _ _ .refl) this + · simpa [LocalDecl.type, VLocalDecl.type, VLocalDecl.depth] using + h2.weakFV henv (.skip_fvar _ _ .refl) this · simp at nd; rw [if_neg (by simpa using Ne.symm (nd.1 _ hm))]; simp have ⟨_, _, h1, h2, h3, h4, h5⟩ := h1.find?_of_mem henv nd.2 hm refine ⟨_, _, ⟨_, _, h1, rfl, rfl⟩, fun _ h => h2 _ h.1, fun _ h => h3 _ h.1, ?_, ?_⟩ diff --git a/Lean4Lean/Verify/TypeChecker/Basic.lean b/Lean4Lean/Verify/TypeChecker/Basic.lean index 011d403a..6252d896 100644 --- a/Lean4Lean/Verify/TypeChecker/Basic.lean +++ b/Lean4Lean/Verify/TypeChecker/Basic.lean @@ -37,9 +37,10 @@ theorem WF.pureBind {f : β → Except ε α} {Q} end Except namespace Lean4Lean +open Lean4Lean open Lean hiding Environment Exception open Kernel -open scoped List +open scoped _root_.List namespace EquivManager @@ -239,7 +240,7 @@ theorem WHNFCache.WF.empty : WHNFCache.WF c s {} := fun _ => by simp def UnfoldCache.WF (c : VContext) (m : ExprMap Expr) : Prop := ∀ ⦃e e' : Expr⦄, m[e]? = some e' → ∃ n ls ci, e = .const n ls ∧ - c.env.find? n = some ci ∧ e' = ci.instantiateValueLevelParams! ls + c.env.find? n = some ci ∧ e' = Inner.instantiateDeltaValue ci ls class VState.WF (c : VContext) (s : VState) where trctx : c.TrLCtx @@ -883,15 +884,15 @@ theorem whnfCore.WF {c : VContext} {s : VState} (he : c.TrExprS e e') : fun _ wf => wf.whnfCore he theorem isDelta_is_some : isDelta env e = some ci ↔ - ∃ n, env.find? n = some ci ∧ (∃ v, ci.value? = some v) ∧ ∃ ls, e.getAppFn = .const n ls := by - simp [isDelta] + ∃ n, env.find? n = some ci ∧ (∃ v, ci.deltaValue? = some v) ∧ + ∃ ls, e.getAppFn = .const n ls ∧ ls.length = ci.numLevelParams := by + simp only [isDelta] split <;> [split <;> [split; skip]; skip] <;> - simp_all [ConstantInfo.hasValue_eq, Option.isSome_iff_exists] <;> - rintro rfl <;> assumption + simp_all [Option.isSome_iff_exists] <;> grind def UnfoldDefinition.WF (c : VContext) (e e₀ : Expr) (e' : VExpr) : Option Expr → Prop | some e₁ => c.FVarsBelow e e₁ ∧ c.TrExpr e₁ e' - | none => ∀ {{n ci v ls}}, c.env.find? n = some ci → ci.value? = some v → + | none => ∀ {{n ci v ls}}, c.env.find? n = some ci → ci.deltaValue? = some v → e₀ = .const n ls → ls.length = ci.numLevelParams → False theorem unfoldDefinitionCore.WF {c : VContext} {s : VState} (he : c.TrExprS e e') : @@ -899,17 +900,15 @@ theorem unfoldDefinitionCore.WF {c : VContext} {s : VState} (he : c.TrExprS e e' dsimp [unfoldDefinitionCore] split <;> [refine .getEnv ?_; (rename_i H; exact .pure fun _ _ _ _ _ _ h => nomatch H _ _ h)] split; rotate_left - · rename_i H; refine .pure ?_; rintro _ _ _ _ h1 h2 ⟨⟩ - cases H _ (isDelta_is_some.2 ⟨_, h1, ⟨_, h2⟩, _, rfl⟩) + · rename_i H; refine .pure ?_; rintro _ _ _ _ h1 h2 ⟨⟩ hlen + cases H _ (isDelta_is_some.2 ⟨_, h1, ⟨_, h2⟩, _, rfl, hlen⟩) rename_i n ls oci ci h1 - obtain ⟨_, h3, ⟨_, h4⟩, _, ⟨⟩⟩ := isDelta_is_some.1 h1 - split <;> rename_i h2 <;> [refine .pureBind ?_; refine .pure ?_]; rotate_left - · simp at h2; rintro _ _ _ _ h1 _ ⟨⟩; cases h1 ▸ h3; exact h2 + obtain ⟨_, h3, ⟨_, h4⟩, _, ⟨⟩, hlen⟩ := isDelta_is_some.1 h1 have : UnfoldDefinition.WF c (.const n ls) (.const n ls) e' - (some (ci.instantiateValueLevelParams! ls)) := by + (some (instantiateDeltaValue ci ls)) := by let .const a1 a2 a3 := he have ⟨rfl, b1, b2, b3⟩ := c.trenv.find?_uniq h3 a1 - simp [ConstantInfo.instantiateValueLevelParams!, ConstantInfo.value!_eq, h4] + simp [instantiateDeltaValue, h4] have c1 := c.trenv.of_value h3 b1 h4 |>.instL c.Ewf (by trivial) a2 (b2.trans a3.symm) have := c1.weakFV c.Ewf (.from_nil c.mlctx.noBV) c.Δwf rw [c1.wf.closedN c.Ewf trivial |>.liftN_eq (Nat.zero_le _)] at this @@ -944,3 +943,14 @@ theorem unfoldDefinition.WF {c : VContext} {s : VState} (he : c.TrExprS e e') : simp only [Expr.getAppArgsRevList_reverse]; constructor · exact (e.mkAppList_getAppArgsList ▸ h1.mkAppList :) · exact h2.rebuild_mkAppList c.Ewf c.Δwf stk.tr (e.mkAppList_getAppArgsList ▸ he :) + +theorem ensureSortCore.WF {c : VContext} {s : VState} (he : c.TrExprS e e') : + RecM.WF c s (ensureSortCore e e₀) fun e1 _ => + (∃ u, e1 = .sort u) ∧ c.TrExpr e1 e' ∧ c.FVarsBelow e e1 := by + simp [ensureSortCore]; split + · let .sort _ := e + exact .pure ⟨⟨_, rfl⟩, he.trExpr c.Ewf c.Δwf, .rfl⟩ + refine (whnf.WF he).bind fun e _ _ ⟨hb, he⟩ => ?_; split + · let .sort _ := e + exact .pure ⟨⟨_, rfl⟩, he, hb⟩ + exact .getEnv <| .getLCtx .throw diff --git a/Lean4Lean/Verify/TypeChecker/InferType.lean b/Lean4Lean/Verify/TypeChecker/InferType.lean index df7efd60..da5b6f01 100644 --- a/Lean4Lean/Verify/TypeChecker/InferType.lean +++ b/Lean4Lean/Verify/TypeChecker/InferType.lean @@ -1,21 +1,12 @@ import Lean4Lean.Verify.TypeChecker.Reduce import Lean4Lean.Verify.EquivManager +open Lean4Lean + namespace Lean4Lean.TypeChecker.Inner open Lean hiding Environment Exception open Kernel -theorem ensureSortCore.WF {c : VContext} {s : VState} (he : c.TrExprS e e') : - RecM.WF c s (ensureSortCore e e₀) fun e1 _ => - (∃ u, e1 = .sort u) ∧ c.TrExpr e1 e' ∧ c.FVarsBelow e e1 := by - simp [ensureSortCore]; split - · let .sort _ := e - exact .pure ⟨⟨_, rfl⟩, he.trExpr c.Ewf c.Δwf, .rfl⟩ - refine (whnf.WF he).bind fun e _ _ ⟨hb, he⟩ => ?_; split - · let .sort _ := e - exact .pure ⟨⟨_, rfl⟩, he, hb⟩ - exact .getEnv <| .getLCtx .throw - theorem ensureForallCore.WF {c : VContext} {s : VState} (he : c.TrExprS e e') : RecM.WF c s (ensureForallCore e e₀) fun e1 _ => c.FVarsBelow e e1 ∧ c.TrExpr e1 e' ∧ ∃ name ty body bi, e1 = .forallE name ty body bi := by diff --git a/Lean4Lean/Verify/TypeChecker/IsDefEq.lean b/Lean4Lean/Verify/TypeChecker/IsDefEq.lean index a6ed5d53..7eddbada 100644 --- a/Lean4Lean/Verify/TypeChecker/IsDefEq.lean +++ b/Lean4Lean/Verify/TypeChecker/IsDefEq.lean @@ -1,6 +1,8 @@ import Lean4Lean.Verify.TypeChecker.Reduce import Lean4Lean.Verify.EquivManager +open Lean4Lean + namespace Lean4Lean.TypeChecker.Inner open Lean hiding Environment Exception @@ -170,7 +172,7 @@ theorem quickIsDefEq.WF {c : VContext} {s : VState} isDefEqForall.WF (subst := #[]) (fvs := []) rfl (c.withMLC_self ▸ he₁) (c.withMLC_self ▸ he₂) · have .sort hu := he₁; have .sort hv := he₂ refine .pure fun h => ⟨_, .sortDF (.of_ofLevel hu) (.of_ofLevel hv) ?_⟩ - exact Level.isEquiv'_wf (toLBool_true.1 h) hu hv + exact Level.isEquiv_wf (toLBool_true.1 h) hu hv · let .mdata he₁ := he₁; let .mdata he₂ := he₂ exact .toLBoolM <| isDefEq.WF he₁ he₂ · cases he₁ @@ -279,15 +281,20 @@ theorem isDefEqApp.WF {c : VContext} {s : VState} simp [Expr.getAppArgs_toList, Expr.mkAppList_getAppArgsList] at h2 exact h2 hb _ he₁ _ he₂ +theorem getSortLevel.WF + (he : c.TrExprS e e') : (getSortLevel e).WF c s fun l _ => + ∃ u', VLevel.ofLevel c.lparams l = some u' ∧ c.HasType e' (.sort u') := by + refine (inferType.WF he).bind fun ty _ le ⟨ty', _, _, h1, h2⟩ => ?_ + refine (ensureSortCore.WF h1).bind fun ty _ le h => ?_ + obtain ⟨⟨u, rfl⟩, ⟨ty₂, h3, h4⟩, _⟩ := h + let .sort hu := h3 + exact .pure ⟨_, hu, h2.defeqU_r c.Ewf c.Δwf h4.symm⟩ + theorem isProp.WF (he : c.TrExprS e e') : (isProp e).WF c s fun b _ => b → c.HasType e' (.sort .zero) := by - unfold isProp - refine (inferType.WF he).bind fun ty _ le ⟨ty', _, _, h1, h2⟩ => ?_ - refine .stateWF fun wf => ?_ - refine (whnf.WF h1).bind fun ty _ le ⟨_, ty₂, h3, h4⟩ => .pure ?_ - simp [Expr.prop, Expr.eqv_sort]; rintro rfl - let .sort h3 := h3; cases h3 - exact h2.defeqU_r c.Ewf c.Δwf h4.symm + refine (getSortLevel.WF he).bind fun l _ le ⟨u', hu, h⟩ => .pure fun H => ?_ + exact h.defeqU_r c.Ewf c.Δwf + ⟨_, .sortDF (.of_ofLevel hu) trivial (ofLevel_isAlwaysZero hu H)⟩ theorem isDefEqProofIrrel.WF {c : VContext} {s : VState} (he₁ : c.TrExprS e₁ e₁') (he₂ : c.TrExprS e₂ e₂') : @@ -339,7 +346,7 @@ theorem lazyDeltaReductionStep.WF {c : VContext} {s : VState} refine .getEnv ?_; extract_lets delta cont F1 F2 have hdelta {s e e' ci} (he : c.TrExprS e e') (H : isDelta c.env e = some ci) : (delta e).WF c s fun r _ => c.TrExpr r e' := by - let ⟨n, h1, ⟨_, h2⟩, ls, h3⟩ := isDelta_is_some.1 H + let ⟨n, h1, ⟨_, h2⟩, ls, h3, _⟩ := isDelta_is_some.1 H have ⟨_, stk⟩ := AppStack.build (e.mkAppList_getAppArgsList ▸ he) have .const a1 a2 a3 := h3 ▸ stk.tr have ⟨b1, b2, b3, b4⟩ := c.trenv.find?_uniq h1 a1 @@ -371,8 +378,8 @@ theorem lazyDeltaReductionStep.WF {c : VContext} {s : VState} split <;> [skip; exact cacheFailure.WF.lift.bind fun _ _ _ _ => hF1] rename_i h1 h2; simp at h1 cases ptrEqConstantInfo_eq h1.1.1.2 - have ⟨n₁, b1₁, ⟨_, b2₁⟩, ls₁, b3₁⟩ := isDelta_is_some.1 hd1 - have ⟨n₂, b1₂, ⟨_, b2₂⟩, ls₂, b3₂⟩ := isDelta_is_some.1 hd2 + have ⟨n₁, b1₁, ⟨_, b2₁⟩, ls₁, b3₁, _⟩ := isDelta_is_some.1 hd1 + have ⟨n₂, b1₂, ⟨_, b2₂⟩, ls₂, b3₂, _⟩ := isDelta_is_some.1 hd2 simp [b3₁, b3₂, Expr.constLevels!] at h2 have ⟨_, stk₁⟩ := AppStack.build (e₁.mkAppList_getAppArgsList ▸ he₁) have ⟨_, stk₂⟩ := AppStack.build (e₂.mkAppList_getAppArgsList ▸ he₂) diff --git a/Lean4Lean/Verify/Typing/Lemmas.lean b/Lean4Lean/Verify/Typing/Lemmas.lean index 354474fa..4778e76c 100644 --- a/Lean4Lean/Verify/Typing/Lemmas.lean +++ b/Lean4Lean/Verify/Typing/Lemmas.lean @@ -6,8 +6,8 @@ import Lean4Lean.Theory.Typing.UniqueTyping import Lean4Lean.Instantiate namespace Lean4Lean -open VEnv Lean -open scoped List +open Lean4Lean VEnv Lean +open scoped _root_.List theorem fvarsIn_iff : FVarsIn P e ↔ (∀ fv ∈ e.fvarsList, P fv) ∧ FVarsIn (fun _ => True) e := by induction e <;> simp [FVarsIn, Expr.fvarsList, *] <;> grind @@ -534,7 +534,8 @@ protected theorem WF.instL : ∀ {Δ}, VLCtx.WF env ls.length Δ → VLCtx.WF env U (Δ.instL ls) | [], _ => ⟨⟩ | (_, d) :: Δ, ⟨h1, h2, h3⟩ => - ⟨h1.instL, by simpa [instL_eq_map, fvars] using h2, by simpa using h3.instL hls⟩ + ⟨h1.instL, by simpa [instL_eq_map, fvars, Function.comp_def] using h2, + by simpa using h3.instL hls⟩ theorem find?_instL : find? Δ v = some (e, A) → find? (Δ.instL ls) v = some (e.instL ls, A.instL ls) := by @@ -791,7 +792,7 @@ theorem VLCtx.IsDefEq.find?_uniq (hΔ : VLCtx.IsDefEq env U Δ₁ Δ₂) · rintro ⟨⟩ ⟨⟩; exact ⟨⟨_, h4⟩, h3⟩ · simp rintro d₁' n₁' H1' rfl rfl d₂' n₂' H2' rfl rfl - simpa [VLocalDecl.depth] using find?_uniq hΔ H1' H2' + simpa [VLocalDecl.depth, VLCtx.toCtx] using find?_uniq hΔ H1' H2' theorem VLCtx.IsDefEq.find?_defeqDFC (hΔ : VLCtx.IsDefEq env U Δ₁ Δ₂) (H : Δ₁.find? v = some (e₁, A₁)) : @@ -1438,6 +1439,19 @@ theorem ofLevel_isNeverZero (h : VLevel.ofLevel Us u = some u') (H : u.isNeverZe obtain ⟨_, h1, _, h2, rfl⟩ := h simp [VLevel.eval, Nat.imax, ih2 h2 H ls] +theorem ofLevel_isAlwaysZero (h : VLevel.ofLevel Us u = some u') (H : u.isAlwaysZero) : + u' ≈ .zero := by + induction u generalizing u' with + simp [Level.isAlwaysZero, VLevel.ofLevel] at H h <;> subst_vars <;> + refine VLevel.equiv_def.2 fun ls => ?_ + | zero => rfl + | max _ _ ih1 ih2 => + obtain ⟨_, h1, _, h2, rfl⟩ := h + simp [VLevel.eval, VLevel.equiv_def.1 (ih1 h1 H.1) ls, VLevel.equiv_def.1 (ih2 h2 H.2) ls] + | imax _ _ _ ih2 => + obtain ⟨_, _, _, h2, rfl⟩ := h + simp [VLevel.eval, Nat.imax, VLevel.equiv_def.1 (ih2 h2 H) ls] + theorem ofLevel_mkLevelIMax' (h1 : VLevel.ofLevel Us u = some u') (h2 : VLevel.ofLevel Us v = some v') : ∃ w, VLevel.ofLevel Us (mkLevelIMax' u v) = some w ∧ w ≈ .imax u' v' := by diff --git a/Main.lean b/Main.lean index 6a0605e2..7d3a3ebe 100644 --- a/Main.lean +++ b/Main.lean @@ -3,320 +3,11 @@ Copyright (c) 2023 Scott Morrison. All rights reserved. Released under Apache 2.0 license as described in the file LICENSE. Authors: Scott Morrison -/ -import Lean.CoreM -import Lean.Util.FoldConsts -import Lean4Lean.Environment +import Lean4Lean.Replay import Lake.Load.Manifest -namespace Lean - -def HashMap.keyNameSet (m : Std.HashMap Name α) : NameSet := - m.fold (fun s n _ => s.insert n) {} - -namespace Environment - -def importsOf (env : Environment) (n : Name) : Array Import := - if n = env.header.mainModule then - env.header.imports - else match env.getModuleIdx? n with - | .some idx => env.header.moduleData[idx.toNat]!.imports - | .none => #[] - -end Environment - -/-- Like `Expr.getUsedConstants`, but produce a `NameSet`. -/ -def Expr.getUsedConstants' (e : Expr) : NameSet := - e.foldConsts {} fun c cs => cs.insert c - -namespace ConstantInfo - -/-- Return all names appearing in the type or value of a `ConstantInfo`. -/ -def getUsedConstants (c : ConstantInfo) : NameSet := - c.type.getUsedConstants' ++ match c.value? with - | some v => v.getUsedConstants' - | none => match c with - | .inductInfo val => .ofList val.ctors - | .opaqueInfo val => val.value.getUsedConstants' - | .ctorInfo val => ({} : NameSet).insert val.name - | .recInfo val => .ofList val.all - | _ => {} - -end ConstantInfo - -end Lean - open Lean hiding Environment Exception -open Kernel - -structure Context where - newConstants : Std.HashMap Name ConstantInfo - verbose := false - compare := false - checkQuot := true - fuel : Lean4Lean.FuelConfig := {} - -structure State where - env : Environment - remaining : NameSet := {} - pending : NameSet := {} - postponedConstructors : NameSet := {} - postponedRecursors : NameSet := {} - numAdded : Nat := 0 - hasStrings := false - -abbrev M := ReaderT Context <| StateRefT State IO - -/-- Check if a `Name` still needs processing. If so, move it from `remaining` to `pending`. -/ -def isTodo (name : Name) : M Bool := do - let r := (← get).remaining - if r.contains name then - modify fun s => { s with remaining := s.remaining.erase name, pending := s.pending.insert name } - return true - else - return false - -def Lean.Kernel.Exception.mapEnvM [Monad m] - (ex : Exception) (f : Environment → m Environment) : m Exception := do - match ex with - | unknownConstant env c => return .unknownConstant (← f env) c - | alreadyDeclared env c => return .alreadyDeclared (← f env) c - | declTypeMismatch env d t => return .declTypeMismatch env d t - | declHasMVars env c e => return declHasMVars (← f env) c e - | declHasFVars env c e => return declHasFVars (← f env) c e - | funExpected env lctx e => return funExpected (← f env) lctx e - | typeExpected env lctx e => return typeExpected (← f env) lctx e - | letTypeMismatch env lctx n t1 t2 => return letTypeMismatch (← f env) lctx n t1 t2 - | exprTypeMismatch env lctx e t => return exprTypeMismatch (← f env) lctx e t - | appTypeMismatch env lctx e fn arg => return appTypeMismatch (← f env) lctx e fn arg - | invalidProj env lctx e => return invalidProj (← f env) lctx e - | thmTypeIsNotProp env c t => return thmTypeIsNotProp (← f env) c t - | other _ - | deterministicTimeout - | excessiveMemory - | deepRecursion - | interrupted => return ex - -/-- Use the current `Environment` to throw a `Kernel.Exception`. -/ -def throwKernelException (ex : Exception) : M α := do - let options := pp.match.set (pp.rawOnError.set {} true) false - -- Note: because the environment we are using has no extension state, - -- we cannot safely use it with lean functions like the pretty printer. - -- Here we instead create a fresh environment, which is good enough to get - -- basic pretty printing working. - let env ← mkEmptyEnvironment - let ex ← ex.mapEnvM fun _ => return env.toKernelEnv - Prod.fst <$> (Lean.Core.CoreM.toIO · { fileName := "", options, fileMap := default } { env }) do - Lean.throwKernelException ex - -def Lean.Declaration.name : Declaration → String - | .axiomDecl d => s!"axiomDecl {d.name}" - | .defnDecl d => s!"defnDecl {d.name}" - | .thmDecl d => s!"thmDecl {d.name}" - | .opaqueDecl d => s!"opaqueDecl {d.name}" - | .quotDecl => s!"quotDecl" - | .mutualDefnDecl d => s!"mutualDefnDecl {d.map (·.name)}" - | .inductDecl _ _ d _ => s!"inductDecl {d.map (·.name)}" - -/-- Add a declaration, possibly throwing a `KernelException`. -/ -def addDecl (d : Declaration) : M Unit := do - if (← read).verbose then - println! "adding {d.name}" - let t1 ← IO.monoMsNow - match Lean4Lean.addDecl (← get).env d true (fuel := (← read).fuel) with - | .ok env => - let t2 ← IO.monoMsNow - if t2 - t1 > 1000 then - if (← read).compare then - let t3 ← match (← get).env.addDecl {} d with - | .ok _ => IO.monoMsNow - | .error ex => _root_.throwKernelException ex - if (t2 - t1) > 2 * (t3 - t2) then - println! - "{(← get).env.header.mainModule}:{d.name}: lean took {t3 - t2}, lean4lean took {t2 - t1}" - else - println! "{(← get).env.header.mainModule}:{d.name}: lean4lean took {t2 - t1}" - else - println! "{(← get).env.header.mainModule}:{d.name}: lean4lean took {t2 - t1}" - modify fun s => { s with env, numAdded := s.numAdded + 1 } - | .error ex => - throwKernelException ex - -deriving instance BEq for ConstantVal -deriving instance BEq for ConstructorVal -deriving instance BEq for RecursorRule -deriving instance BEq for RecursorVal - -def Lean.Expr.hasStrLit (e : Expr) : Bool := (e.find? isStringLit).isSome - -def Lean.ConstantInfo.hasStrLit (ci : ConstantInfo) : Bool := - ci.type.hasStrLit || ci.value?.any (·.hasStrLit) - -mutual -/-- -Check if a `Name` still needs to be processed (i.e. is in `remaining`). - -If so, recursively replay any constants it refers to, -to ensure we add declarations in the right order. - -The construct the `Declaration` from its stored `ConstantInfo`, -and add it to the environment. --/ -partial def replayConstant (name : Name) : M Unit := do - if ← isTodo name then - let some ci := (← read).newConstants[name]? | unreachable! - let mut usedConstants := ci.getUsedConstants - -- We want `String.ofList` to be available when encountering string literals. - -- Presumably faster to first check if we already have it, before traversing - -- the declaration - unless (← get).hasStrings do - if ci.hasStrLit then - usedConstants := usedConstants.insert ``String.ofList - usedConstants := usedConstants.insert ``Char.ofNat - modify ({· with hasStrings := true }) - replayConstants usedConstants - -- Check that this name is still pending: a mutual block may have taken care of it. - if (← get).pending.contains name then - let addDeclAt (d : Declaration) := - try addDecl d catch e => throw <| IO.userError s!"at {name}: {e.toString}" - match ci with - | .defnInfo info => addDeclAt (.defnDecl info) - | .thmInfo info => addDeclAt (.thmDecl info) - | .axiomInfo info => addDeclAt (.axiomDecl info) - | .opaqueInfo info => addDeclAt (.opaqueDecl info) - | .inductInfo info => - let lparams := info.levelParams - let nparams := info.numParams - let all ← info.all.mapM fun n => do pure <| (← read).newConstants[n]! - for o in all do - modify fun s => - { s with remaining := s.remaining.erase o.name, pending := s.pending.erase o.name } - let ctorInfo ← all.mapM fun ci => do - pure (ci, ← ci.inductiveVal!.ctors.mapM fun n => do - pure (← read).newConstants[n]!) - -- Make sure we are really finished with the constructors. - for (_, ctors) in ctorInfo do - for ctor in ctors do - replayConstants ctor.getUsedConstants - let types : List InductiveType := ctorInfo.map fun ⟨ci, ctors⟩ => - { name := ci.name - type := ci.type - ctors := ctors.map fun ci => { name := ci.name, type := ci.type } } - addDeclAt (.inductDecl lparams nparams types false) - -- We postpone checking constructors, - -- and at the end make sure they are identical - -- to the constructors generated when we replay the inductives. - | .ctorInfo info => - modify fun s => { s with postponedConstructors := s.postponedConstructors.insert info.name } - -- Similarly we postpone checking recursors. - | .recInfo info => - modify fun s => { s with postponedRecursors := s.postponedRecursors.insert info.name } - | .quotInfo _ => addDeclAt .quotDecl - modify fun s => { s with pending := s.pending.erase name } - -/-- Replay a set of constants one at a time. -/ -partial def replayConstants (names : NameSet) : M Unit := do - for n in names do replayConstant n - -end - -/-- -Check that all postponed constructors are identical to those generated -when we replayed the inductives. --/ -def checkPostponedConstructors : M Unit := do - for ctor in (← get).postponedConstructors do - match (← get).env.constants.find? ctor, (← read).newConstants[ctor]? with - | some (.ctorInfo info), some (.ctorInfo info') => - unless info == info' do throw <| IO.userError s!"Invalid constructor {ctor}" - | _, _ => throw <| IO.userError s!"No such constructor {ctor}" - -/-- -Check that all postponed recursors are identical to those generated -when we replayed the inductives. --/ -def checkPostponedRecursors : M Unit := do - for ctor in (← get).postponedRecursors do - match (← get).env.constants.find? ctor, (← read).newConstants[ctor]? with - | some (.recInfo info), some (.recInfo info') => - unless info == info' do throw <| IO.userError s!"Invalid recursor {ctor}" - | _, _ => throw <| IO.userError s!"No such recursor {ctor}" - -/-- -Check that at the end of (any) file, the quotient module is initialized by the end. -(It will already be initialized at the beginning, unless this is the very first file, -`Init.Core`, which is responsible for initializing it.) -This is needed because it is an assumption in `finalizeImport`. --/ -def checkQuotInit : M Unit := do - unless (← get).env.quotInit do - throw <| IO.userError s!"initial import (Init.Prelude) didn't initialize quotient module" - -/-- "Replay" some constants into an `Environment`, sending them to the kernel for checking. -/ -def replay (ctx : Context) (env : Environment) (decl : Option Name := none) : - IO (Nat × Environment) := do - let mut remaining : NameSet := ∅ - for (n, ci) in ctx.newConstants.toList do - -- We skip unsafe constants, and also partial constants. - -- Later we may want to handle partial constants. - if !ci.isUnsafe && !ci.isPartial then - remaining := remaining.insert n - let (_, s) ← StateRefT'.run (s := { env, remaining }) do - ReaderT.run (r := ctx) do - match decl with - | some d => replayConstant d - | none => - for n in remaining do - replayConstant n - checkPostponedConstructors - checkPostponedRecursors - if (← read).checkQuot then checkQuotInit - return (s.numAdded, s.env) - -open private ImportedModule.mk from Lean.Environment in -unsafe def replayFromImports (module : Name) (verbose := false) (compare := false) - (fuel : Lean4Lean.FuelConfig := {}) : IO Nat := do - let mFile ← findOLean module - unless (← mFile.pathExists) do - throw <| IO.userError s!"object file '{mFile}' of module {module} does not exist" - let mut fnames := #[mFile] - let sFile := OLeanLevel.server.adjustFileName mFile - if (← sFile.pathExists) then - fnames := fnames.push sFile - let pFile := OLeanLevel.private.adjustFileName mFile - if (← pFile.pathExists) then - fnames := fnames.push pFile - let parts ← readModuleDataParts fnames - let some (mod, _) := parts[parts.size - 1]? | unreachable! -- load private module data - let (_, s) ← (importModulesCore mod.imports).run - let env ← match Kernel.Environment.finalizeImport s mod.imports module 0 with - | .ok env => pure env - | .error e => throw <| .userError <| ← (e.toMessageData {}).toString - let mut newConstants := {} - for name in mod.constNames, ci in mod.constants do - -- Multi-part oleans can materialize the same auto-generated lemma - -- (`*.eq_1`, `*.congr_simp`, ...) in several modules' parts; a real - -- import dedups those realizations in `finalizeImport`, so the replay - -- must skip names the imported env already provides instead of - -- re-declaring them (and spuriously rejecting, e.g. on Std). - if (env.constants.find? name).isNone then - newConstants := newConstants.insert name ci - let (n, env') ← replay { newConstants, verbose, compare, fuel } env - -- Free the import closure's regions (the memory that scales with a - -- multi-module run), but deliberately leak this module's own `parts` - -- regions: `parts`, `mod`, and the replayed constants are ordinary RC'd - -- objects pointing into those mmapped regions, so freeing them here makes - -- the reference-count walk at scope exit read unmapped headers and - -- segfault (`lean_dec_ref_cold`). The leak is one module's olean parts, - -- bounded until process exit. - (Environment.ofKernelEnv env').freeRegions - pure n - -unsafe def replayFromFresh (module : Name) - (verbose := false) (compare := false) (decl : Option Name := none) - (fuel : Lean4Lean.FuelConfig := {}) : IO Nat := do - Lean.withImportModules #[module] {} (trustLevel := 0) fun env => do - let ctx := { newConstants := env.constants.map₁, verbose, compare, checkQuot := false, fuel } - Prod.fst <$> replay ctx (.empty module) decl +open Kernel Lean4Lean.Replay /-- Read the name of the main module from the `lake-manifest`. -/ -- This has been copied from `ImportGraph.getCurrentModule` in the diff --git a/divergences.md b/divergences.md index 33afa81a..dbcfd9c6 100644 --- a/divergences.md +++ b/divergences.md @@ -6,7 +6,8 @@ This is a list of places where lean4lean deliberately has different behavior fro * [`Lean4Lean.Environment.checkPrimitiveDef`](Lean4Lean/Primitive.lean), `checkPrimitiveInductive`: Lean does not check that primitives are declared with the correct types and definitional behavior, except in the case of `Eq` which is used in the declaration of `Quot`. This is required for soundness, but Lean is able to get away with it because Lean ships its prelude and using an alternative prelude is not supported. * [`Lean4Lean.TypeChecker.Inner.inferType'`](Lean4Lean/TypeChecker.lean), literal case: The original code was not checking that the literal type actually exists. Again, this is okay provided that the prelude is trusted. * [`Lean4Lean.TypeChecker.Inner.tryStringLitExpansionCore`](Lean4Lean/TypeChecker.lean): there is a counterproductive `whnf` call in this function which is removed in Lean4lean. -* [`Lean.Level.normalize'`](Lean4Lean/Level.lean), `isEquiv'`, `geq'`: Lean4lean implements an experimental new algorithm for level normalization, which is complete for level algebra. We may in the future use a hybrid approach avoid the performance cost in the common case. +* [`Lean.Level.normalize`](https://github.com/leanprover/lean4/blob/v4.31.0/src/Lean/Level.lean), `isEquiv`, `geq`: Lean4lean uses the level operations from Lean's standard library. These currently differ from the C++ kernel implementation; [leanprover/lean4#14356](https://github.com/leanprover/lean4/pull/14356) tracks aligning them. The primed operations in [`Lean4Lean/Level.lean`](Lean4Lean/Level.lean) are an unused experimental decision procedure for level algebra. * [`Lean4Lean.addDefinition`](Lean4Lean/Environment.lean), `Lean4Lean.addTheorem`: two calls ([1](https://github.com/leanprover/lean4/blob/v4.26.0/src/kernel/environment.cpp#L183) [2](https://github.com/leanprover/lean4/blob/v4.26.0/src/kernel/environment.cpp#L203)) are redundant and have been removed. * [`Lean4Lean.TypeChecker.Inner.inferLambda`](Lean4Lean/TypeChecker.lean), `inferLet`: lean4lean does the `ensureSort` call before extending the context, while [`infer_lambda`](https://github.com/leanprover/lean4/blob/v4.26.0/src/kernel/type_checker.cpp#L124-L126) does it afterward. It's not clear whether this is actually unsound but it would require some very weird invariants to justify having unchecked things in the local context and hoping that they won't be used in the typing proof of that same expression. * [`Lean4Lean.checkConstantVal`](Lean4Lean/Environment.lean): The original implementation would call `check` which sets the level params and then unsets them afterward, and then `ensure_sort` would run in a context without any level params. In lean4lean the monad is parameterized over level params, so they remain the same across the two calls. +* [`Lean4Lean.TypeChecker.Inner.isProp`](Lean4Lean/TypeChecker.lean), [`Lean4Lean.toCtorWhenStruct`](Lean4Lean/Inductive/Reduce.lean): Lean decides whether a sort is `Prop` by comparing it syntactically against `Sort 0`. That misses `Sort (imax 1 0)`, which denotes `Prop` without being syntactically `zero`, and the mismatch between this test and the one used for proof irrelevance resulted in a soundness bug ([leanprover/lean4#14613](https://github.com/leanprover/lean4/pull/14613)). Lean4lean tests the level instead, but using `isAlwaysZero` instead of `isZero` in `isProp`, and `isNeverZero` instead of `!isAlwaysZero` in `toCtorWhenStruct` and `inferProj`. The lean check using `!isAlwaysZero` in `toCtorWhenStruct` would be unsound if not for the fact that the level algorithm rejects the true equation `imax 1 u ≤ u`: `inductive T.{u} : Sort u where mk : Bool → T` would allow proving false using a similar construction to the one in [#14613](https://github.com/leanprover/lean4/pull/14613). diff --git a/flake.lock b/flake.lock index 4774ee5e..b6cd9081 100644 --- a/flake.lock +++ b/flake.lock @@ -24,11 +24,11 @@ "nixpkgs": "nixpkgs" }, "locked": { - "lastModified": 1775267043, - "narHash": "sha256-yUCn4Wc5kLboN9JHom/SJAknn7aoSEDyerqFq3k7g0I=", + "lastModified": 1784744474, + "narHash": "sha256-9yx5PzXBkZ+160uquH4f7lCCPZGlzdc1Y2j+zOKRc54=", "owner": "lenianiva", "repo": "lean4-nix", - "rev": "56e917e2766385d0b096ea8be9c40ae54bfe138a", + "rev": "9edc9448c8fe9552ba2b66e6097abda6e14e5c6f", "type": "github" }, "original": { diff --git a/flake.nix b/flake.nix index d3971a3a..16cd2d74 100644 --- a/flake.nix +++ b/flake.nix @@ -44,26 +44,25 @@ }: let # Lake package lake2nix = pkgs.callPackage lean4-nix.lake {}; - # Restrict the Lake build inputs to Lean-relevant files so edits to - # unrelated files (flake.nix, docs, the nix/ fixtures) don't - # invalidate the build. - leanSrc = pkgs.lib.fileset.toSource { - root = ./.; - fileset = - pkgs.lib.fileset.difference - (pkgs.lib.fileset.unions [ - ./lakefile.toml - ./lake-manifest.json - ./lean-toolchain - (pkgs.lib.fileset.fileFilter (f: f.hasExt "lean") ./.) - ]) - ./nix; + # lean4-nix reads lake-manifest.json while evaluating derivations. + # Reuse the flake's lazy source instead of creating a nested + # fileset.toSource path that may be unrealized under --no-build. + leanSrc = inputs.self.outPath; + # Batteries v4.31.0 accidentally split deprecated recycling modules + # into a second Lake library with a dependency back to Batteries. Its + # shared/static facets therefore form a cycle, which matters here + # because lake2nix exports those facets for downstream consumers. + # Backport the upstream fix released after the v4.31.0 tag. + batteries431CycleFix = pkgs.fetchurl { + url = "https://github.com/leanprover-community/batteries/commit/ba9a97018925ecc18fd8411d8c53de6056cf9dff.patch"; + hash = "sha256-HjF68B7QUeioDcGT/q6SWQEqPp8o5OQqErfw5D9rdIY="; }; # Dependencies from lake-manifest.json (batteries). lean4-nix's # default target guess ("batteries" -> "Batteries") is correct, so - # no overrides are needed. + # only the v4.31 shared/static cycle backport is needed. lakeDeps = lake2nix.buildDeps { src = leanSrc; + depOverride.batteries.patches = [batteries431CycleFix]; }; lakeBuildArgs = { inherit lakeDeps; @@ -184,7 +183,10 @@ # fails before any consumer updates its pin. consumer = lake2nix.mkPackage { name = "consumer"; - src = ./nix/fixtures/consumer; + # lake2nix reads this fixture's manifest during evaluation. Keep it + # inside the already-realized flake source rather than coercing the + # subdirectory into a second, not-yet-realized store path. + src = "${leanSrc}/nix/fixtures/consumer"; lakeDeps = { lean4lean = lean4leanLakeDependency; batteries = lakeDeps.batteries; @@ -201,7 +203,7 @@ }; # Regression test for the `replayFromImports` teardown segfault (see - # plans/segfault-fix-plan.md): run the shipped wrapper from a clean + # plans/DEPRECATED-segfault-fix-plan.md): run the shipped wrapper from a clean # environment on a small module and require a clean exit plus the # summary line the crash used to swallow. cliSmoke = @@ -254,7 +256,9 @@ # Lean overlay _module.args.pkgs = import nixpkgs { inherit system; - overlays = [(lean4-nix.readToolchainFile ./lean-toolchain)]; + overlays = [ + (lean4-nix.readToolchainFile ./lean-toolchain) + ]; }; packages = { diff --git a/lake-manifest.json b/lake-manifest.json index 306f79ac..3542863a 100644 --- a/lake-manifest.json +++ b/lake-manifest.json @@ -1,15 +1,16 @@ -{"version": "1.1.0", +{"version": "1.2.0", "packagesDir": ".lake/packages", "packages": [{"url": "https://github.com/leanprover-community/batteries", "type": "git", "subDir": null, "scope": "", - "rev": "756e3321fd3b02a85ffda19fef789916223e578c", + "rev": "fa08db58b30eb033edcdab331bba000827f9f785", "name": "batteries", "manifestFile": "lake-manifest.json", - "inputRev": "v4.29.0", + "inputRev": "v4.31.0", "inherited": false, "configFile": "lakefile.toml"}], "name": "lean4lean", - "lakeDir": ".lake"} + "lakeDir": ".lake", + "fixedToolchain": false} diff --git a/lakefile.toml b/lakefile.toml index 531391e0..f862fab7 100644 --- a/lakefile.toml +++ b/lakefile.toml @@ -1,10 +1,10 @@ name = "lean4lean" -defaultTargets = ["Lean4Lean", "lean4lean", "Lean4Lean.Theory", "Lean4Lean.Verify"] +defaultTargets = ["Lean4Lean", "lean4lean", "Lean4Lean.Theory", "Lean4Lean.Verify", "Lean4Lean.Tests"] [[require]] name = "batteries" git = "https://github.com/leanprover-community/batteries" -rev = "v4.29.0" +rev = "v4.31.0" [[lean_lib]] name = "Lean4Lean" @@ -17,6 +17,10 @@ globs = ["Lean4Lean.Theory.*"] name = "Lean4Lean.Verify" globs = ["Lean4Lean.Verify.*"] +[[lean_lib]] +name = "Lean4Lean.Tests" +globs = ["Lean4Lean.Tests.*"] + [[lean_lib]] name = "Lean4Lean.Experimental" globs = ["Lean4Lean.Experimental.+"] diff --git a/lean-toolchain b/lean-toolchain index 14791d72..18640c8b 100644 --- a/lean-toolchain +++ b/lean-toolchain @@ -1 +1 @@ -leanprover/lean4:v4.29.0 +leanprover/lean4:v4.31.0 diff --git a/plans/roadmap.md b/plans/roadmap.md new file mode 100644 index 00000000..113d6f5c --- /dev/null +++ b/plans/roadmap.md @@ -0,0 +1,3640 @@ +# Lean4Lean completion roadmap, with Ix as the first external consumer + +**Status:** authoritative local roadmap, audited 2026-08-04 against the +committed fork, the current `jcb/induct` development branch, and ix's +formalization branch. + +**Overall assessment:** progressing, not stalled. The fork has a published, +green vertical slice through checked single-family generation, normalized +Verify replay, and a proof-carrying non-identity Theory transaction. The live +critical path has moved past `IndexedVec`'s executable outer producer: +the real one-parameter, one-index family and its ordered `nil`/`cons` +constructors now pass exact family validation, post-family constructor +validation, dependent candidate-list assembly, and the complete successful +`buildNormalizationCandidate` call. The published identity-replay bridge can +interpret syntactically identity-normalizing traces at caller-selected Theory +endpoints. The published semantic checkpoint uses that bridge to assemble the +complete `IndexedVec` semantic generation package, producer-selected +certificate, proof-erased Theory transaction, and checked E1 environment +replay. The executable list boundary is now reusable: dependent +`CandidateFamilyTypeListProduced`, `CandidateConstructorListProduced`, and +`CandidateFamilyListProduced` witnesses prove exact family-type, ordered +constructor, and complete-family traversal results at arbitrary list lengths. +AliasFormer and AnnotatedPi use the singleton instances, while `IndexedVec` is +the two-constructor regression. The outer singleton boundary is also reusable: +`GenerationCandidateSemanticRun.producedPackage` attaches an exact successful +whole-metadata equation to the same source- and candidate-indexed semantic +owner, and all three fixtures now use it instead of hand-assembling outer +records. +The retained semantic boundary is now reusable and automatically assembled. +`CandidateExprSemanticRootInput` lets the retained checker run select one +Theory view from a verified context and strict source translation. Dependent +constructor, family, and normalization inputs combine with the arbitrary-length +operational `Produced` witnesses to return a +`Nonempty ProducedNormalizationCandidateSemanticRun`; no caller supplies a +view, and no choice-based data extractor is added. Semantic generation owners +project every family and constructor spine from that same hierarchy, so +normalization, generation, packaging, and produced packaging cannot drift onto +parallel roots. AliasFormer, AnnotatedPi, and `IndexedVec` all use this path. +The `IndexedVec` regression additionally proves that the automatically +assembled hierarchy retains exact `nil`/`cons` source order and rejects a +swapped view at the computational normalization-shape gate. Exact compile-time +axiom guards cover the generic constructors and projections plus all three +fixture roots. The published analyzer-provenance checkpoint closes two more +structural gaps. `GenerationCandidateRun` now retains the exact equation that +the candidate normalization's dependent `generation?` analysis returned its +`GenerationChecked`; a successful analysis generically determines the retained +normalization. Post-family `VEnv.WF` is reconstructed from the verified +pre-family context, candidate raw/view definitional equality, checked family +typing, and exact raw-family insertion. AliasFormer, AnnotatedPi, and +`IndexedVec` consequently supply neither an independent `normalization_eq` nor +`typeEnv_wf`. The generation shape-alignment checkpoint closes the remaining +component-alignment gap. `GenerationCandidateSemanticShapeRun` accepts only +checked WF plus source-indexed family/constructor `storedSpine` and total +spine-length data. Exact dependent analysis determines the raw family, full +checked family view, normalized constructor pairs, and complete constructor +order; the total binder counts determine raw telescopes/results, while exact +checked shape determines view terminals. Its generic projection reconstructs +the established semantic generation owner without `zip`, truncation, +reordering, a caller-selected pair, or fixture component equations. +AliasFormer, AnnotatedPi, and the two-constructor `IndexedVec` regression now +use this reduced boundary. Together with the preceding structural-evidence +checkpoint, fixtures no longer supply `viewTel`, terminal typing, raw/result or +view-terminal equations, normalized pair identities, normalization equality, +post-family WF, or dependent-list alignment. The consolidated +generation-readiness checkpoint removes the remaining fixture-owned checked WF +and per-position generation-shape records. One source-indexed executable gate +checks the complete singleton family and constructor hierarchy, including +retained emitted Pi spines, full raw telescope lengths, and exact constructor +list cardinality; missing and extra raw constructors are rejected explicitly. +`ProducedGenerationShapeCandidate` retains both that successful gate and the +exact ordinary `buildNormalizationCandidate` equation. Exact dependent +analysis plus WF of the analyzer-owned view declaration then derives checked +WF and expands the one Boolean result into every dependent family/constructor +stored-spine/count record. AliasFormer, AnnotatedPi, and `IndexedVec` all use +this path. Bare producer success deliberately remains neither generation-shape +authority nor Theory semantics: WHNF can change the visible Pi spine, and the +ordinary producer checks neither `storedSpine` nor semantic WF. Complete +one-family parity (L4L-07) and the ix oracle handoff (L4L-11) remain beyond the +narrowed boundary. +Ix Pin A is complete against the +certificate-bearing +`5e5bb767b3491d21a71908d4c58bcbaa007283bb` checkpoint; it deliberately makes +no oracle claim. + +**Completed milestone: L4L-01A — staged semantic-input consolidation.** Source +checkpoint `7c7922091f94b4a4f51c6834b376de376be22e71` introduces one +source-indexed staged owner over verified pre-family/post-family candidate +contexts, strict source translations, exact insertion alignment, and the +existing family/constructor `Produced` traversals. AliasFormer, AnnotatedPi, +and `IndexedVec` use that owner, preserve exact constructor order, and no +longer define the repeated per-root semantic-input tower. The theorem returns +only `Nonempty ProducedNormalizationCandidateSemanticRun`; no view-WF, +generation-package, or choice-extraction claim was added. The explicit +downstream witnesses and analyzer-owned `viewWF` proofs remain visibly +temporary for L4L-01D/L4L-01E. + +**Completed milestone: L4L-01B — family-validation semantics and staging.** +Source checkpoint `da45b536220a3eff5ed78cf2f5afcf5e7491c40f` interprets the +exact singleton `checkInductiveTypes`/family-candidate execution from one +verified entry candidate context. It derives the analyzer-owned +parameter/index telescope, terminal-sort typing, raw-family constant WF through +semantic definitional equality, exact raw-family insertion, and the verified +post-family candidate stage. AliasFormer, AnnotatedPi, and `IndexedVec` no +longer supply independently verified post-family environments, contexts, or +fixture-specific post-family `VEnvs.WF` reconstructions. Exact axiom guards and +the universal Lake/Nix gates pass; constructors are not semantically +interpreted. + +**Completed milestone: L4L-01U — upstream v4.31 reconciliation.** +The source reconciliation is complete at +`7f864b459e4a6062b468d6e5416688feac0f9f99`: digama `upstream/master` +through `ef849dfbd94a` is a merge parent, Lean and lean4-nix are on v4.31, the +overlapping inductive/checker/Verify/level proofs build, and the fork's staged +family APIs remain intact. The merge removes four cached-`Expr` axioms and the +obsolete hand-declared `Expr.mkAppRangeAux.eq_def`, reducing the custom-axiom +inventory from 34 to 29. It adds two classified sorry-frontier entries: +`NormLevel.isEquiv_wf` (L4L-02B) and `addDecl.WF` (L4L-19B), taking the exact +frontier from 20 to 22 without increasing the supported-root trust budget. +All local Lean/Lake/Nix, exact-axiom, and sorry-frontier gates pass. An isolated +ix v4.31 probe replayed the merged Lean4Lean modules and built ix's runtime +typechecker modules; the remaining failures are ix-owned Lean/Batteries proof +API migrations. Because L4L-01U is not an ix pin, that consumer migration is +deferred and does not block this checkpoint. The source and this completion +ledger are published to origin `jcb/induct`; neither master nor the digama +remote moved. This was an integration-only checkpoint: it added no +constructor-trace work. + +**Active milestone: L4L-01C — retained constructor-validation trace.** Retain +the complete successful singleton `checkConstructors` +traversal as dependent, source-ordered operational evidence and prove exact +decomposition/recomposition while preserving phase-specific failures. This +checkpoint makes no Theory-WF claim; semantic interpretation remains L4L-01D. + +The former generic-package milestone was not independently closable: its +requested view-WF conclusion depends on a semantic interpretation of +`checkInductiveTypes` and `checkConstructors`, while those proofs were assigned +to later validation milestones. Section 13 now decomposes that boundary into +L4L-01A through L4L-01E: consolidate staged inputs; derive family-validation +semantics and the post-family verified stage; retain the complete constructor +validation trace; interpret that trace as analyzer-owned view WF; and only +then close and migrate the produced-package theorem. The mandatory L4L-01U +upstream-reconciliation checkpoint is interposed between L4L-01B and L4L-01C +because upstream moved at that boundary; it does not combine or reorder the +five semantic deliverables. No checkpoint may claim +the strengthened theorem from bare `buildNormalizationCandidate` success. +Checked WF, raw/view identities, telescope/result/view-terminal equations, +constructor-pair order, per-position shape records, dependent-list alignment, +normalization equality, post-family WF, view telescopes, and terminal typing +remain generic consequences and must not return as final package premises. Do +not use erasure equality, unchecked `zip`, whole-Pi injectivity, a +caller-selected view, or a normalization oracle. Ix Pin A is complete: +the local ix `jcb/ix-formalization2` snapshot +`1f73f5c016907eadb8ed0dc86ac65b07eb24a145` pins Lean4Lean +`5e5bb767b3491d21a71908d4c58bcbaa007283bb`, builds the complete `IxTcVerify` +target, and reconciles the exact sorry and root-axiom audits. The complete +post-L4L-01E order is defined only by §13; the track labels below are +work-package references, not competing milestones. The independent 22-entry metatheory, +checker, projection, and trust work remains release work rather than evidence +that the inductive producer track is stalled. + +**Baselines.** The current formalization source is the L4L-01U merge checkpoint +`7f864b459e4a6062b468d6e5416688feac0f9f99`, with parents +`da45b536220a3eff5ed78cf2f5afcf5e7491c40f` +(`feat: derive family validation staging`) and +`ef849dfbd94a` (`upstream/master`). This roadmap-only ledger child records that +immutable source hash without changing the formalization. The source follows +roadmap decomposition checkpoint +`f82ee77f7181`, generation-readiness source +`bbb45e0e950724cdbbd405d75e304e2020cecf82`, and its ledger child +`c4fd62b23a89500154b113d849d183afbf84907f`. +The earlier structural checkpoint derives exact checked family and +constructor shapes in Theory, types the inserted family constant once, derives +every checked constructor result target, recovers candidate view telescopes +from their exact terminals, and removes all fixture-supplied `viewTel` and +`rightType` fields. The analyzer-provenance checkpoint replaces fixture +normalization equalities with exact dependent analyzer-success equations, +derives the retained normalization in Theory, reconstructs post-family +environment WF in Verify, and removes all fixture-supplied `normalization_eq` +and `typeEnv_wf` fields. The generation-readiness checkpoint derives exact raw/check +family identity, normalized constructor pairing and order, raw +telescope/results, view terminals, and the complete dependent constructor list +from analysis plus minimal stored-spine/count shapes. That checkpoint +adds the complete executable hierarchy gate, retains it with exact ordinary +producer provenance, derives checked WF and every dependent shape record from +that one gate plus exact analysis and analyzer-owned view WF, and migrates all +three fixtures away from hand-built checked WF or per-position shape evidence. +It also pins missing- and extra-constructor rejection. Fixtures no longer name +normalized pairs or provide any component equation. The executable gate, +strengthened producer, and exact-success theorem have exactly the accepted +`propext`/`Classical.choice`/`Quot.sound` closure; semantic derivations inherit +only the already recorded checked-semantic closure. L4L-01A adds the staged +semantic-input owner and migrates all three positives without changing that +trust boundary or extracting its `Nonempty` result. L4L-01B interprets the +exact singleton family-validation run and derives the post-family stage from +the entry context, eliminating every independently verified post-family +fixture context while leaving constructor interpretation for L4L-01C/L4L-01D. +No new axiom or normalization oracle was added. On the v4.31 merge, the +154-job default Lake build, default Nix build, all six current-host flake +checks, all-system no-build flake evaluation, exact 22-entry sorry frontier, +29-declaration custom-axiom inventory, formatter, CLI replay, and whitespace +checks pass. Local `master` and +`origin/master` remain fixed at the prior candidate-context-provenance +checkpoint, `1fb7d6ef9042c5a80b2de9320c88ac0f3ce404cb`; only local +`jcb/induct` and `origin/jcb/induct` are published by this work. The live +digama `upstream/master` tip `ef849dfbd94a` is the merge's second parent and +was not modified by this branch. The published +development checkpoint contains a green Stage-3 +generalized one-family port, two checked-analysis slices, E1 environment alignment, and a +completed bounded I2 recursive-Pi slice, plus the first explicit +normalization/definitional-equality boundary, its paired checked-block +slice, complete mixed-artifact preservation, the identity-normalization +public artifact switch, and one traced normalized Theory transaction with +identity and non-identity preservation fixtures, a normalized Verify +transaction trace, six actual-metadata Verify replays, and the first verified +WHNF-to-Theory normalization-certificate producer instantiated on both alias +cases. The executable side now also has the first generic candidate-view +traversal: `AddInductive.normalizeCandidateExpr` runs the ordinary checker +full check and WHNF at every inspected node, descends through Pi domains and +bodies under the exact annotation-consumed local declarations used by the +kernel, and retains every full checker context/input/result in a positionally +indexed trace with exact check, WHNF, and binder-domain `isDefEq` run +equalities. Raw binder syntax is preserved. A structural certificate records +whether `outParam`, `semiOutParam`, `optParam`, or `autoParam` was peeled, and +its executable result is checked against Lean's actual +`Expr.consumeTypeAnnotations` before the body context is extended. +Because that helper is an opaque partial definition with no usable equation +theorem, `CandidateTypeAnnotations` deliberately does not claim a +propositional equality to it. The producer rejects a runtime disagreement as +an implementation-consistency failure; Verify derives semantic authority only +from the structural peeling trace and the exact successful raw-to-consumed +`isDefEq` execution. This separates a useful executable cross-check from the +proof boundary and avoids a new axiom, native evaluator, or opaque-function +equation. +`buildNormalizationCandidate` stages family +normalization before raw family insertion and constructor normalization in +the post-family environment. `CandidateWhnfStep.innerRun` recovers the +state-bearing recursive execution erased by `M.run`, and +`WhnfRun.ofCandidateStep` converts a step to the existing Verify certificate +once strict translations are supplied. Candidate families and constructors +also retain exact full `checkType` observations, with the parallel +`CheckTypeRun.ofCandidateStep` adapter. The AliasFormer family WHNF plus its +family and post-family constructor full checks now use these adapters. +The trace tree itself is now recursively context- and source-indexed, so a Pi +child cannot be forged for a different raw domain, instantiated body, local +context, or fresh binder identifier. +`CandidateNodeRun` pairs each retained full check with its retained WHNF in one +verified context. `CandidateNodeRun.exists_ofCandidate` now obtains the +checker-returned inferred-type and WHNF-result translations directly from the +two verified executions once the matching context and root source translation +are known. `CandidateExprRun` recursively interprets those pairs into +`DefEqEvidence`, including Pi congruence under the exact raw free-variable +context and explicit type transport when a checker-inferred type is merely +definitionally equal to the structural sort; `source_tr` and `view_tr` prove +that both semantic endpoints translate the context/source-indexed kernel +syntax. AliasFormer's actual terminal trace now feeds this interpreter and +supplies its normalization and generation evidence. The current development +checkpoint constructs the verified candidate root from `VEnvs.WF`, extends +its exact `VContext`/`MLCtx` positionally at every retained Pi binder, proves +fresh-name reservation for a newly initialized checker state, and recursively +certifies arbitrary annotated-domain traces. The root full-check refinement +selects the strict source translation automatically from only the syntactic +free-variable condition; Pi result decomposition supplies child translations +and raw binder typing. At every Pi, `IsDefEqRun.ofCandidateStep` refines the +retained raw-to-consumed equality run to Theory `IsDefEqU`; +`CandidateExprRun` transports the strict body translation, typing evidence, +reconstructed-view translation, and Pi congruence between the raw, +annotation-consumed, and normalized binder contexts. +AliasFormer's actual candidate exercises that automatic root path without any +fixture-supplied Theory expression. `CandidateExprRootRun` now binds each +root trace to explicitly translated raw and exact candidate-view endpoints. +`CandidateConstructorListRun` folds constructor evidence positionally without +`zip` or truncation, and `NormalizationCandidateRun` accepts only a singleton +source-indexed family list and singleton raw Theory declaration, constructs +the corresponding `Normalization`, and assembles its `NormalizationRun`. +AliasFormer's real family and post-family constructor traces now flow through +that generic list boundary; its resulting view computes to the existing +checked alias view, and a truncated constructor view is rejected by +`normalization?` before dependent analysis or transaction construction. +The candidate boundary now continues through complete generation +certification. `CandidateExprTrace.storedSpine` requires WHNF to preserve the +raw emitted Pi spine while still permitting normalization inside binder +domains and the terminal result; `spineLength` records its exact length. +`CandidateExprRun.spineEvidence` recursively extracts raw/view binder +equality and terminal-result evidence from the same context-indexed checker +runs. `TelResultDefEqEvidence` packages those two components, supports exact +prefix replacement without forall injectivity, and preserves the induced raw +contexts. `CandidateFamilyGenerationRun`, `CandidateNormalizedCtorRun`, and +the dependent `CandidateNormalizedCtorListRun` align the extracted components +with the successful dependent analysis and forbid constructor truncation, +reordering, or evidence reuse. `GenerationCandidateRun` then assembles the +existing `GenerationRun` and `GenerationChecked.WF` certificates. +AliasFormer's actual non-identity family and constructor candidate runs now +exercise this complete generic assembler; its existing checked +`AddInductTrace`, final transaction, WF, and alignment replay consume the +result rather than a parallel hand-filled generation witness. Candidate +output remains untrusted unless this exact source-indexed run, stored-spine +condition, dependent analysis, and semantic assembly all succeed. +`AnnotatedPi.mk : ((p : outParam Prop) → AnnotatedPi) → AnnotatedPi` now closes +the missing recursive-Pi-plus-annotation vertical slice. Its exact ordinary +checker traces cover family and constructor full checks, WHNF of the retained +`outParam Prop` domain, the complete lazy-delta `isDefEq` path to `Prop`, and +the recursively extended raw/consumed binder contexts. Those runs assemble a +nonempty nested-Pi `NormalizationCandidateRun`, +`GenerationCandidateRun`, and `GenerationChecked.WF`; the resulting checked +`AddInductTrace` replays the final environment, generated recursor, and iota +rule while preserving the raw annotated binder in emitted metadata. A staged +whole-candidate negative reuses that exact metadata with a correctly typed but +opaque `outParam`; it reaches candidate traversal and is rejected at the +raw-to-consumed binder equality boundary. + +The published certified-consumer slice adds the proof-carrying boundary +needed by ix without pretending that executable metadata production is already +fully certified. Theory's `GenerationCertificate source env` couples one exact +`GenerationChecked source` with its `GenerationChecked.WF env` proof, and +`VEnv.addInductCertified` erases the proof and computes through the existing +`addInductGeneration` transaction. Its trace, atomicity, and `Ordered` +preservation theorems stay wholly in Theory. Verify's dependent +`GenerationCandidatePackage` binds the exact kernel source, source-indexed +candidate, normalization run, dependent generation result, and +`GenerationCandidateRun`; `.certificate` is the only erasure into the Theory +API, while `.addInductTrace` forces metadata replay to use the generation and +WF proof owned by that package. AliasFormer and AnnotatedPi both exercise this +public non-identity path and retain exact axiom guards. The separate +`ProducedGenerationCandidatePackage` records the stronger outer equation that +`buildNormalizationCandidate` produced the packaged candidate. AliasFormer and +AnnotatedPi now inhabit this layer with exact successful whole-call equations +in their real pre-family and post-family environments, and both Theory +certificates and Verify metadata replays project from their produced packages. +General construction for an arbitrary successful metadata call remains open. +Arbitrary-length source-indexed operational list assembly and automatic +semantic-hierarchy assembly from verified per-position inputs are complete, so +the missing work is deriving those inputs plus structural generation alignment +and the terminal package from the outer success, followed by producer breadth; +another transaction API is not needed. +The next positive outer fixture is now complete. `AddInductive.hasIndOcc` is a +transparent structural traversal, so recursion and positivity branches reduce +in exact producer theorems without a new opaque-traversal contract. AnnotatedPi +has exact equations for singleton family validation, name freshness, +recursive-occurrence detection, raw-family declaration, constructor +validation, annotation consumption, nested-Π candidate traversal, dependent +candidate-list assembly, and the complete successful whole call. Its Theory +certificate and Verify replay now project from +`annotatedPiProducedGenerationCandidatePackage`. +`VInductDecl.checked?` returns a dependent, data-bearing `Checked` +descriptor. `stage3` and the public `VEnv.addInduct` compatibility entry point +still begin with raw-normal-form acceptance analysis. Verify's +`AddInductTrace`, however, now retains the exact `GenerationChecked decl` and +its `GenerationChecked.WF` certificate and proves the same +`VEnv.addInductGeneration` transaction used by explicit views; +`VDecl.WF.induct` records that normalized transaction in environment histories. +The public identity-path preservation proof constructs the canonical +`GenerationChecked.WF` bridge and delegates to it. The public `Checked` motive, minors, +recursor, and rules now delegate to its canonical identity +`GenerationChecked`, so artifact construction has one mixed implementation +even before the transaction accepts a non-identity normalization. The +descriptor records normalized parameter and +index telescopes, result level, elimination mode, generated names, constructor +fields, and recursive arguments including Pi-binder telescopes and terminal +index spines. Its environment-free analysis rejects loose metadata, duplicate +generated names, invalid universe annotations anywhere in family or +constructor metadata, self-reference in the family telescope, malformed +result heads/spines, parameter-count errors, and +declaration/type/constructor universe-count mismatches. `Checked.WF env` adds +the semantic telescope, recursive-target, field, and result-spine obligations +over the input environment, is equivalent to the legacy `VInductDecl.WF env` +when paired with the exact analyzer result, and is what `VEnv.addInduct_WF` +converts to the normalized generation certificate. Its non-recursive-field +universe obligation now states Lean's +impredicative Prop exception explicitly: `l = .zero ∨ u ≤ l`. + +The normalization audit ruled out the tempting assumption that translated +kernel metadata is already in the syntax expected by `checked?`. Lean retains +reducible aliases in real `InductiveType.type` and constructor types: +`AliasFormer` stores the alias `TypeFamilyAlias` instead of its sort WHNF, and +`AliasRec.mk` stores `RecAlias AliasRec` instead of the direct recursive +target. The fork now has a named `Normalization source` with a +shape-preserving analysis `view`, `Normalization.checked?`, and a semantic +`Normalization.WF env` contract. The contract relates the raw and view family +types before insertion and their constructor types after insertion of the raw +family constant. `NormalizedChecked source` now retains the singleton raw +family, the normalization, the dependent checked view, and the exact analyzer +equation in one value. Structural theorems recover source/view arities and +ordered family/constructor headers; identity normalization computes back to +the legacy analyzer. `GenerationChecked` adds an executable outer-telescope +layout certificate and ordered raw/checked constructor pairs. Its additive +mixed motive/minor/recursor/rule definitions emit raw parameter, index, and +constructor-field binders while consulting the checked view for recursive +arguments and result indices. Identity specialization reduces exactly for +Nat, Eq, `IndexedVec`, and `Acc`; both alias recursors and iota rules reduce +exactly to Lean's kernel metadata, including preservation of the raw +`RecAlias AliasRec` minor binder. `VEnv.TelDefEq` now states pointwise +raw/view binder equality in the context generated by the earlier raw binders, +and constructs the corresponding Theory context equality without using the +unfinished `forall`-injectivity theorem. The strengthened +`GenerationChecked.WF` is staged: it certifies the raw family telescope and +result before family insertion, then certifies both the exact stored +constructor telescope and the raw family/field telescope emitted by artifacts +after insertion. Generic lemmas prove the raw family and every paired raw +constructor insertion-ready from that certificate. `GenerationEnv` proves the +mixed motive, every paired minor, the complete minor telescope, the recursor +type and recursor constant, each rule component, every generated iota rule, +and the ordered full rule fold well formed. The minor/rule lists have exact +length and positional lookup facts, so no proof silently relies on `zip` +truncation. Exact guards pin the mixed transport, minor, recursor, rule, and +fold roots to subsets of `[propext, Classical.choice, Quot.sound]`. +`Checked.identityGeneration` constructs the canonical identity block from any +retained analyzer witness; generic theorems show that all four public artifacts +equal the legacy identity-normal forms, and Nat, Eq, `IndexedVec`, and `Acc` +check those equalities by reduction. Both alias examples still construct the +granular certificate explicitly and retain exact `[propext, Quot.sound]` +guards. `Checked.WF.identityGeneration` supplies the ordered semantic bridge +for the compatibility path. `AddInductSuccess` and `addInduct_WF` now project +from the normalized trace/preservation theorem rather than reconstructing the +legacy `Stage3Env` transaction. `AliasFormer` and `AliasRec` execute that core +directly: their final environments preserve exact raw family and constructor +payloads, contain the kernel recursor and every generated rule, grow their +inputs, and are `Ordered`, with exact axiom guards. + +Verify now has the first checked normalization producer rather than only +hand-written Theory equality witnesses. `TypeChecker.WhnfRun` packages an +exact `Inner.whnf'` execution, its well-formed checker state, and strict +translations of the input and result; the existing checker-refinement theorem +turns that execution into an ordinary Theory definitional equality. +`TypeChecker.CheckTypeRun` similarly packages an exact full +`Inner.inferType _ false` execution and identifies the verified existential +result with named strict translations; it exposes both `HasType` and +sort-valued `IsType` consequences, including the case where the inferred type +must itself be normalized by a `WhnfRun`. +`TypeChecker.DefEqEvidence` composes reflexivity, WHNF, application, beta, +transitivity, and forall congruence without adding a normalization oracle. +`TypeChecker.TelDefEqEvidence` extends that evidence pointwise through raw +binder contexts. `VInductDecl.NormalizedCtorRun` and `GenerationRun` assemble +the declared/emitted constructor paths, exact post-family insertion state, and +complete `GenerationChecked.WF`; their interpretation roots are exactly +guarded. +`VInductDecl.NormalizationRun` stages the family comparison in the input +environment and constructor comparisons in the exact environment obtained by +inserting the raw family, and `.wf` constructs `Normalization.WF`. The +actual-metadata `AliasFormer` fixture runs WHNF on `TypeFamilyAlias`; the +`AliasRec` fixture runs WHNF on `RecAlias.{1}` and composes application, beta, +transitivity, and outer-forall congruence. `AliasFormer` also executes +`inferType (.const ``TypeFamilyAlias []) false` to obtain its family-is-a-type +premise and executes a second full check on the actual `AliasFormer.mk` type in +the exact post-family environment. That constructor check returns the retained +`TypeFamilyAlias`; the verified WHNF certificate turns it into the required +sort. `AliasRec` now likewise executes a full check on the actual raw +`RecAlias AliasRec` field in the exact post-family environment; its field +certificate uses that checked typing premise and composes the verified +`RecAlias` WHNF, application, and beta steps. Neither checked normalization +proof now borrows typing from the older hand-built generation certificate. +Both fixtures instantiate the generic +`GenerationRun` assembler to obtain complete checked +`NormalizedChecked.WF` and `GenerationChecked.WF` roots and inject those roots +into dedicated data-bearing `AddInductTrace`/`TrEnv'` replays. Every +operational, semantic, block, generation, and checked-trace boundary has an +exact axiom guard. + +The remaining parity boundary is now generalization of the outer executable +producer, not the consumer transaction. `stage3` and `VEnv.addInduct` remain +the raw-normal-form compatibility path and therefore still reject the raw +alias declarations. +`VEnv.addInductCertified`, however, accepts any source-indexed Theory +generation certificate; its proof is erased, and generic trace/atomic/WF facts +show that it is exactly the normalized transaction already proved sound. +Verify packages candidate provenance, dependent analysis, semantic assembly, +and checked metadata replay without allowing an unrelated generation witness, +and AliasFormer, AnnotatedPi, and `IndexedVec` reach the public certified +transaction through packages selected by exact whole +`buildNormalizationCandidate` calls: family validation, raw-family +declaration, constructor validation, recursive candidate traversal, and +dependent candidate-list assembly all run in the same retained contexts. What +is not yet generic is deriving such a package from every arbitrary successful +metadata call. The executable family-type, ordered-constructor, and complete +family traversals now have arbitrary-length dependent `Produced` witnesses, +and all three fixtures delegate their list equations to those generic +theorems. `GenerationCandidateRun.producedPackage` also provides the generic +outer singleton constructor once the exact semantic run exists. +`CandidateExprSemanticRootInput` and the dependent semantic input hierarchy now +invoke that retained interpreter at every exact source position. Combined with +the operational list witnesses, `.exists_ofProduced` returns the complete +source-ordered semantic hierarchy under `Nonempty`. The corresponding semantic +generation owners project every family and constructor spine from the same +value, and all three fixtures route package construction through those +projections. What remains generic is deriving the structural generation +alignment and verified inputs from the successful dependent analyzer/outer +producer itself, then returning a complete produced generation package without +fixture-supplied equations. The opaque-`outParam` whole-candidate rejection and +the reordered-`IndexedVec` view rejection remain the negative gates. The +identity API stays as a compatibility wrapper until kernel parity and +downstream migration are green. + +The bounded recursive-Pi convergence slice is coherent and green. +`recTarget?`/`recArg?` recognize a family target below a strictly positive Pi +telescope; `minorTypeRec`, `recConstRec`, `ruleCall`, `ruleRec`, and `rulesRec` +generate functional induction hypotheses and lambda-wrapped recursive calls; +and the exact `Acc.rec` type and iota RHS reduce by `rfl` to those generalized +artifacts. The semantic proof chain now closes through normalization and +list-level application of every functional induction hypothesis, +`minorAppRec_hasType`, `recRuleAppRec_hasType`, `ruleRec_WF`, and the generated +rule fold in `addInduct_WF`. `Checked.minorTypes`, `Checked.recursor`, +`Checked.generatedRules`, `VEnv.addInduct`, and `AddInductSuccess` all select +the generalized artifacts. Public `Acc` checking, transaction consequences, +`Ordered` preservation, and actual-kernel-metadata E1 replay are green. This +closes the planned recursive-Pi widening, but not L4L-07: WHNF/definitional-equality +parity, full positivity, small elimination, K behavior, and the complete +one-family differential matrix remain. + +The complete checkpoint gate was rerun on 2026-08-02 over parent `d553930a` +plus the complete `IndexedVec` semantic replay, now published at `cf3d5a47`. +The 124-job +`lake build Lean4Lean.Theory Lean4Lean.Verify`, exact 20-entry sorry audit, +focused `IndexedVecSemanticReplay` build, default `nix build`, all-system no-build +evaluation, and current-host `nix flake check` are green. The host flake check +builds the proof library, sorry frontier, downstream consumer, and all three +CLI checks. The two public semantic-package/E1 roots have exact compile-time +axiom guards. Formatter, diff, and import-boundary gates also pass. + +Two successive checkpoints move the outer family validator beyond the former +zero-parameter/immediate-sort seam. Revision `9a865ea02d4326e60d0e5fd663d6efe79c735b1c` +adds a generic, source-indexed replay theorem for any singleton candidate +family spine, computing the exact parameter expressions, index count, +terminal local context, result universe, and emitted family constant selected +by `checkInductiveTypes`. Revision +`a62736281ea419d7d0ee13d76f0e0fd9a4d9d90f` instantiates that theorem on +Lean's real universe-polymorphic `IndexedVec` family (`α : Type u`, index +`Nat`, result `Type u`). It proves the actual full `checkType`, WHNF, binder +domain `isDefEq`, fresh-local, annotation, `buildCandidateExpr`, and complete +family-validation executions. The candidate computes with spine length two, +parameter vector containing the first fresh local, index-count vector `#[1]`, +result level `u + 1`, and family constant `IndexedVec.{u}`. The proof retains +the checker-produced `mkLevelIMax'` expression instead of assuming an opaque +reduction equation. No new axiom declaration, native evaluator, or +fixture-specific normalization principle was added. The next exact slice was +the post-family `IndexedVec.nil`/`IndexedVec.cons` constructor validation and +ordered dependent-list assembly; this historical checkpoint did not yet claim +a whole executable `IndexedVec` result. + +Revision `f0d80f8ba21e44a694566ea3d6469be85a809307` adds an early +`Expr.eqv` success path to `TypeChecker.Inner.isDefEq`. The verifier transports +the strict source translation across the existing expression-equivalence +lemma and derives the same `IsDefEqU` result, while the executable run returns +without consulting or mutating `EquivManager`. Existing exact-state fixtures +now assert that stronger behavior; the old reflexivity-specific manager +simulations were deleted. Non-reflexive comparisons still traverse +`isDefEqCore` and add a successful equivalence exactly as before. This is a +sound checker simplification, not a new axiom or normalization assumption, and +it is the reusable state-stability fact needed by exact `IndexedVec.nil` and +`IndexedVec.cons` application traces. + +Five later published checkpoints close that executable boundary. Revisions +`6732659058fe770e2b768ffaeb10d147ef1f466b` and +`c40a471dce8403d236284e3e10c85e7b84281a56` certify the exact `nil` and `cons` +constructor candidates in the post-family environment; +`c739d412302da94a962fb986ff0f380962692df3` stabilizes their candidate-context +provenance; and `82f4a54cf38d1ca510cdb05fcc1c4af4c5e3737a` proves that the complete +one-parameter, one-index, two-constructor request returns the exact retained +`IndexedVec` normalization candidate. Revision +`d553930affdb3690ad43fbf9acddf68d476fe260` adds the generic recursive +identity-normalization interpreter needed to keep caller-selected Theory +endpoints through those traces. Revision +`cf3d5a47d35867e0e6ebe023c0803982e3e36cd1` instantiates identity witnesses +for the family, `nil`, and `cons`, converts identity root runs into +generation-ready spine evidence, and uses `IndexedVecSemanticReplay` to +assemble the complete `GenerationCandidatePackage`, certified Theory +transaction, and checked E1 replay. Both public roots have exact guards and the +complete checkpoint gate passes. + +The exact CI evaluation command +`nix flake check --all-systems --no-build --accept-flake-config` is also green. +Its earlier `path '*-source' is not valid` failure was reproducible: the nested +`fileset.toSource` used for `leanSrc` could be demanded during evaluation +before that store path was realized. The flake now reuses the lazy +`inputs.self.outPath`, which restores app and check evaluation on all four +declared systems. The tradeoff is broader source invalidation, so restoring a +narrow *evaluation-safe* source filter remains packaging optimization debt. +The non-fatal `system` to `stdenv.hostPlatform.system` warning remains in the +pinned Nix dependency stack. Actual Linux and Darwin builds are still supplied +by their platform CI jobs; cross-system evaluation is no longer the blocker. +Descriptor invariants, semantic compatibility and normalization witnesses, +Theory and Verify transaction APIs, and the environment-WF roots retain exact +compile-time axiom-closure guards. + +The executable-candidate checkpoint at +`bc37d436dfd6f7d6fa1ae186c0951e48677b931f` passed the same complete local +gate on 2026-08-01. It proves AliasFormer's exact successful whole producer, +constructs `aliasFormerProducedGenerationCandidatePackage`, and routes both +the certified Theory transaction and checked Verify replay through it. Exact +guards at that pre-v4.31 checkpoint exposed the additional +`Expr.hasExprMVar_eq`, `Expr.hasLevelMVar_eq`, and `Expr.hasFVar_eq` cache +contracts reached while checking closed constructor constants; L4L-01U later +proves those properties and removes their axiom declarations. No native +evaluator or assumed normalization equation was added. Only `origin/jcb/induct` moved; +both master refs and every digama/upstream ref remain unchanged. +The core E1 Verify path is no longer +vacuous: typed witnesses align kernel `ConstMap` insertions with Theory +constants and rules, and the `TrEnv'` inductive case is live. The concrete +replay layer quotes Lean's actual Nat, Eq, index-changing `IndexedVec`, and +recursive-Pi `Acc` metadata plus the actual alias definitions and metadata for +`AliasFormer` and `AliasRec`. It drives all six complete +metadata-to-normalized-Theory transactions and proves that an older +value-bearing definition remains translatable through the Nat transaction. +Every quoted kernel rule RHS is pinned to the generated Theory rule by +definitional equality. The alias replays additionally pin raw source/view +separation, exact raw binders, final environment equality, WF, alignment, and +family/constructor/recursor lookup uniqueness. + +**Ix companion.** `~/projects/ix/plans/lean4lean-upstream-gaps.md` (the file +named `lean4lea-upstream-gaps.md` in the request has a one-character typo) is +the 2026-07-29 demand-side analysis. Keep its A1-A7 and P1-P4 identifiers for +cross-repo discussion. Its fork status and M0-M5 progress are now stale, so +this later audit wins on current state and sequencing; the companion remains +authoritative for the shape of ix's consumer obligations. + +**Versioning note.** `plans/roadmap.md` is intentionally unignored and tracked +so the sole status-bearing L4L ladder travels with each checkpoint. Other files +under `/plans` remain ignored. The root-level `upstream-divergence.md` remains +the tracked per-delta ledger; it complements this roadmap rather than replacing +its milestone state. + +--- + +## 1. Mission and exact meaning of “complete” + +Lean4Lean has two products: + +1. `Lean4Lean/Theory/`: an implementation-independent model of Lean's kernel + language, typing, definitional equality, environment growth, and the + metatheory needed to use that model safely. +2. `Lean4Lean/Verify/`: a proof that the executable checker over `Lean.Expr` + refines Theory. + +Ix is the first demanding external consumer. Its `Ix/Tc/Verify/` development +translates content-addressed `KExpr` into the same Theory and proves the Ix.Tc +checker sound there. Success therefore means more than deleting the original +three inductive sorries. + +The supported formalization is complete when all of the following hold: + +- **Theory coverage:** every safe inductive declaration accepted by + `Lean4Lean/Inductive/Add.lean` has a faithful Theory description, generated + recursors and iota rules, and an `Ordered`/`WF` preservation proof. Temporary + `stageN` predicates are gone from the public contract or have become proved + implementation lemmas rather than permanent restrictions. +- **Live proof closure:** there are zero real `sorry` tokens in + `Lean4Lean/Theory/` and `Lean4Lean/Verify/`. `Experimental/` is explicitly + not part of the supported product; parked experiments must not be imported + by a supported root. +- **No semantic placeholders:** `Verify.Environment.AddInduct` is inhabited + and useful, `TrProj` has a justified semantics, and every currently empty or + impossible verification path corresponds to a real checker execution. +- **Checker refinement:** the six remaining Level/TypeChecker proof roots are + proved, including recursor reduction, projection inference/reduction, + structure eta, and unit-like comparison. +- **Trust is explicit:** all final roots have an audited `#print axioms` + closure. No bridge axiom known to be false for the pinned Lean toolchain is + reachable. Any unavoidable runtime contracts (for example pointer equality + or opaque C++ implementations) are narrowly stated, tested, documented, and + separated from the mathematical Theory. +- **Ix is enabled:** ix pins a published revision, imports only + `Lean4Lean.Theory.*`, constructs `InductiveOracle` from checked blocks, + obtains a concrete `TrProjOK`, derives literal well-formedness from its + prelude contract, and removes the corresponding upstream sorry origins from + its executable audit manifests. `NativeOracle` remains an explicit ix trust + boundary by design, not a lean4lean proof hole. +- **Upstreamability:** the fork delta is split into reviewable PRs, every + deliberate divergence is tracked, and both repositories build at each pin + boundary. + +This definition deliberately separates **proof-complete** (no sorries or +fake relations) from **trust-minimal** (no unnecessary custom axioms). Both are +required for the final release; they can be reached in separate milestones. + +## 2. Audited current state + +### 2.1 What has landed on the green baseline + +The old gap plan started at `0c38ab8`, where `VInductDecl.WF`, +`VEnv.addInduct`, and `VEnv.addInduct_WF` were all sorries. That is no longer +the fork's state. + +- The sorry-frontier audit and Nix CI are tracked. The audit currently accepts + exactly 22 live sorries and excludes `Experimental/`; the two v4.31 additions + are classified under L4L-02B and L4L-19B. The exact CI all-system evaluation + command is green on the L4L-01U source; + the remaining `system` deprecation warning comes from the pinned Nix stack + and is non-fatal. +- Stage 1 introduced real computational recursor/iota generation for a single, + parameter-free, non-indexed type and proved `addInduct_WF`. +- Stage 2, at `efb2a2b2`, supports any number of parameters for one + non-indexed type with direct recursive fields in a syntactically never-zero + sort. `addInduct_WF` is sorry-free for that class. +- Nat, Bool, List, Prod, and Option fixtures compare generated recursor types + and rules definitionally with the actual kernel declarations. +- The current Stage-3 development branch extends that proof to one generalized + family, including subsingleton large elimination, indexed recursive calls, + constructor-result spines, and recursive targets below Pi telescopes. Eq, + HEq, `IndexedVec`, and `Acc` compare generated recursors and/or iota rules + definitionally with Lean's kernel declarations. +- The fork also contains the `0c38ab8` kernel soundness fix and the Nix + downstream-consumer artifact work. Ix Pin A now pins the certificate-bearing + fork revision `5e5bb767` instead of upstream `8865b155`; its complete + `IxTcVerify` target and exact trust audits consume the proved normalized + generation/certificate boundary and remove the three former inductive + `sorryAx` origins. + +### 2.2 Green Stage-3/I1/E1, recursive Pi, and mixed-preservation frontier + +The Stage-3/I1 and current I2 implementation spans `Theory/Inductive.lean`, +`Theory/InductiveFixtures.lean`, `Theory/Typing/InductiveLemmas.lean`, and a +small generic environment extension in `Theory/Typing/Lemmas.lean`. E1 also +changes `Verify/Typing/Lemmas.lean`, `Verify/Environment/Basic.lean`, and +`Verify/Environment/Lemmas.lean`, and adds +`Verify/Environment/InductiveFixtures.lean`; the sorry-frontier wording is +updated. Relative to current common ancestor `8865b155`, source checkpoint +`da45b536` changes 33 files with 45,662 insertions and 66 deletions. Its direct +tree diff against the now-diverged `upstream/master` changes 68 files with +46,136 insertions and 1,097 deletions. Use per-checkpoint diffs, rather than +either accumulated total, for review sizing. + +The development branch contains: + +- parameter-and-index spines (`SpineWF`, `recPairs`, indexed motives and + minors); +- a single-family Stage-3 guard with a syntactic subsingleton/large-elimination + test; +- a dependent `VInductDecl.Checked` result and `checked?` analyzer. The public + Stage-3 Boolean is now descriptor existence rather than an independent pass; + public `addInduct` and its success/WF proofs unwrap the same checked value and + specialize it to identity normalization. Verify's `AddInductTrace` has moved + to the more general exact `GenerationChecked decl` plus + `GenerationChecked.WF` certificate; +- an explicit `Normalization source` boundary separating raw stored metadata + from the view inspected by the analyzer. `normalizationShape` fixes universe + arity, parameter count, family/constructor identities, order, and counts + while allowing expression payloads to change. `Normalization.WF env` requires + family-type defeq in the input environment and pairwise constructor-type + defeq after the raw family constant is inserted. This semantic staging is + intentionally one-family; I3 must generalize it to insertion of every family + constant in a mutual block; +- a dependent `NormalizedChecked source` boundary value built by + `Normalization.check?`, `normalizedChecked?`, or the identity compatibility + analyzer. It retains `sourceType` and its singleton equation alongside the + normalization, the exact `norm.view.Checked`, and the analyzer equation that + produced it. `Normalization.shape` exposes source/view universe arity, + parameter count, and ordered family/constructor header agreement; + `NormalizedChecked.source_anatomy` specializes that agreement to the raw + singleton family and checked singleton view. Identity normalization has a + computational Nat fixture and an `isSome` compatibility theorem. + `Checked.analyzer_eq`, `identityBlock`, and `identityGeneration` now package + any retained identity analyzer witness without re-running or choosing a + second result. The legacy `addInduct` transaction remains an identity-only + compatibility wrapper, but its semantic bridge and preservation proof now + run through this boundary and the live `Checked` artifact accessors have + moved here. The additive `GenerationCertificate`/`addInductCertified` API + accepts a semantically certified non-identity generation without exposing + Verify state or changing that compatibility behavior; +- a `GenerationChecked source` layout gate and mixed artifact layer. + `generationShape` checks raw parameter/index arity, constructor coverage, + header agreement, raw constructor parameter count, and raw/view field-count + alignment. `GenerationChecked.shape`, `rawCtors_eq`, and `viewCtors_eq` + expose those facts without downstream zipping or truncation. Mixed + parameters, indices, motives, minors, recursors, and rules retain raw binder + syntax and use only retained view descriptors for recursive classification + and result indices; no mixed helper re-runs `recArg?` on raw metadata. + Identity fixtures for Nat, Eq, `IndexedVec`, and `Acc` reduce to the existing + artifacts. Both alias cases reduce to the actual kernel recursor and rule; + the `AliasRec` fixture separately pins the raw alias as the emitted minor + binder. `VEnv.TelDefEq` records binder-by-binder raw/view equality under the + preceding raw binders and exposes raw-telescope well-formedness, universe + instantiation, and an `IsDefEqCtx` bridge. `GenerationChecked.WF` now carries + the pre-family family telescope/result and, after exact raw family insertion, + both the constructor's stored raw telescope/result and the raw + family/field telescope/result emitted in mixed artifacts. The two paths are + intentionally separate so definitionally equal constructor parameters need + not be syntactically identical. Generic guarded lemmas derive raw family and + constructor `IsType` facts from this granular contract without `forall` + injectivity. Both alias fixtures construct it at the standard Theory + closure. The mixed preservation layer now proves the motive, exact raw + constructor application under the mixed telescope, every individual minor, + the complete constructor-aligned minor telescope, the recursor type and + constant, every rule application and rule, and the complete ordered rule + fold well formed. Supporting length/lookup lemmas preserve constructor + position, and `familyApp_transport` supplies the common + insertion/weakening step. Exact compile-time guards cover every stabilized + mixed root. The public `Checked` motive/minor/recursor/rule accessors are + identity specializations of this implementation; generic compatibility + theorems recover the old identity forms, and Nat/Eq/`IndexedVec`/`Acc` + compare all four accessors by `rfl`. The additive artifact refactor is + closed. A single `VEnv.addInductGeneration` transaction now inserts the raw + family and constructors and the mixed recursor/rules; its data-bearing + `AddInductGenerationTrace` is exposed axiom-minimally through `Nonempty`, + with freshness, lookup, membership, monotonicity, atomicity, and normalized + `Ordered` preservation theorems. The raw public `addInduct` entry point is + an exact identity-normalization wrapper around that core. The proof-carrying + public `addInductCertified` entry point is an equally exact wrapper around + the same core: its certificate owns `generation` and `generation.WF env`, + but only `generation` affects computation. Generic trace, atomicity, and WF + theorems give ix a Theory-only non-identity consumer boundary. + `Checked.WF.identityGeneration` now constructs its semantic certificate + through a post-family invariant, and the legacy public success/WF + certificates delegate to the normalized trace and preservation theorem. + The redundant `Stage3Env` transaction proof has been removed; +- actual-metadata alias fixtures proving that normalization is necessary, not + hypothetical. `AliasFormer` retains a reducible alias at the family result + and `AliasRec.mk` retains one around a recursive field. Their raw declarations + fail `checked?`, their explicit views compute to accepted descriptors, and + their `Normalization.WF` proofs derive the required delta/application/beta + equalities in Theory. Exact guards pin both roots to `propext` and + `Quot.sound`. Each fixture now also constructs a `NormalizedChecked` block + and proves its combined `NormalizedChecked.WF` certificate at the same exact + axiom closure. The normalized transaction is now live and preserves raw + constants and kernel-shaped generated binders while pairing them + constructor-by-constructor with normalized analysis facts. Direct + `AliasFormer`/`AliasRec` transactions now pin exact raw payloads, kernel + recursors and iota rules, all lookup/membership consequences, monotonicity, + and final `Ordered`, while their raw `checked? = none` regressions remain. + Verify ingestion and actual-metadata replay are now complete for both aliases: + the trace consumes the same certified generation as Theory, preserves the + actual raw `ConstantInfo` payloads, and proves final equality, WF, alignment, + and lookup uniqueness. The public identity wrapper still rejects their raw + declarations, as intended. The checked producer now derives each fixed + fixture's normalization equality from an exact verified WHNF run and + compositional defeq evidence. A generic `CheckTypeRun` derives named Theory + typing consequences from exact full-check executions; `AliasFormer` uses it + for both the raw family and actual constructor premises, with the latter + staged after family insertion, while `AliasRec` uses it for the actual raw + recursive field in that same exact post-family state. Both aliases now + assemble complete checked block + and `GenerationChecked.WF` roots through the generic + `TelDefEqEvidence`/`NormalizedCtorRun`/`GenerationRun` layer, without + bootstrapping from the older hand-built generation-WF proofs. Dedicated + checked traces carry those certificates through `TrEnv'` to final + WF/alignment. `AddInductive.normalizeCandidateExpr` now supplies the first + generic executable metadata-to-candidate traversal: it uses the checker's + configured full check, WHNF, and inductive fuel; recursively exposes Pi + domains while checking bodies under structurally certified + annotation-consumed local declarations; preserves raw metadata headers; and + retains exact full-check, WHNF, and binder-equality runs at every applicable + position. + `buildNormalizationCandidate` repeats the existing family/constructor + validity checks, normalizes families in the input environment, inserts the + raw families, and only then normalizes constructor payloads. An exact + `AliasFormer` leaf regression pins this traversal to the already verified + checker WHNF run and guards its operational axiom closure. + `CandidateWhnfStep.innerRun`/`WhnfRun.ofCandidateStep` and the parallel + full-check adapters now bridge stored `M.run` equalities to state-bearing + Verify certificates once translations are provided. Every family, + constructor, Pi domain, and instantiated body retains its full check in the + exact pre-/post-family and raw-local context; the AliasFormer semantic WHNF, + family check, and constructor check all use this route. Matching verified + contexts and translations are now constructed recursively for every retained + position, and generic spine/result extraction plus dependent constructor-list + assembly produce `GenerationChecked.WF`. `GenerationCandidatePackage` + retains those exact dependent indices, erases to a Theory + `GenerationCertificate`, and builds a checked `AddInductTrace` whose + generation cannot be unrelated to the package. AliasFormer and AnnotatedPi + both run through `addInductCertified`, prove exact successful whole + `buildNormalizationCandidate` equations, inhabit the stronger + `ProducedGenerationCandidatePackage`, and route their Theory and Verify + consumers through those values. `IndexedVec` now supplies the next exact + executable result: its parameter/index family and ordered two-constructor + list reduce through the complete outer producer to the retained candidate. + The published `cf3d5a47` checkpoint carries that exact value through semantic + generation/package assembly and E1 replay. What remains is generalization + beyond the three fixture-specific successful calls; +- normalized descriptor data for parameters, indices, result universe, + elimination mode, generated names, constructors, and recursive arguments. + `RecArg` now records a possibly nonempty Pi-binder telescope, field position, + terminal index spine, and the target-family slot reserved for I3. The current + one-family analyzer populates the binder telescope and still fixes + `targetType = 0`; +- exact closed-metadata, complete universe-annotation range, family-telescope + self-reference, direct result-shape, and internal generated-name `Nodup` + checks. Their proof API includes `Checked.analysis_accepted`, + `type_closed`/`ctor_closed`, `type_levelWF`/`ctor_levelWF`, `names_nodup`, and + `direct_anatomy`, so consumers do not unfold the analyzer. Environment-relative + name freshness remains correctly enforced by the transactional `addConst` + chain and exposed by `AddInductSuccess`; +- an environment-indexed `Checked.WF env` contract over the normalized + parameter/index telescope and each constructor's field/result spine, with + `Checked.wf_of_decl`, `Checked.to_declWF`, and + `VInductDecl.wf_iff_exists_checked` proving exact compatibility with the + legacy declaration-level `WF`. The preservation theorem now obtains its + semantic premises through this descriptor contract rather than destructing + the raw declaration relation. Its field-universe condition explicitly + models Lean's impredicative Prop exception (`l = .zero ∨ u ≤ l`), which is + required by `Acc : Prop` while preserving the bound for non-Prop families; +- computed positive descriptor-shape fixtures for Nat, Eq, and `IndexedVec`, and + a computed negative matrix covering duplicate/internal generated-name + aliases, loose variables, self-reference in parameter domains, invalid + universe annotations in family and constructor fields, non-sort family + results, wrong constructor heads and parameter spines, excessive `nparams`, + family/constructor universe-count mismatches, illegal recursive-Pi domains, + changed recursive-target parameters, family occurrences in recursive target + indices, and pre-existing type, constructor, and recursor names. The three + recursive-Pi cases have exact kernel `#guard_msgs` comparisons, and every + case is rejected before any partial environment is observable; +- public generalized recursor and iota generation for direct indexed recursion + and recursive arguments below Pi telescopes: functional minor IHs, + generalized recursor types, lambda-valued recursive calls, and generalized + iota rules. Exact computational fixtures match `Acc.rec` and its rule after + universe permutation. The older direct definitions remain only as + specialization/reference code; no public `Checked` accessor or transaction + selects them; +- a closed generalized semantic chain through recursive-target transport, + `minorTypeRec`/`recTypeRec` well-formedness, recursor application, rule + binders/type, recursive-call normalization, list-level application of all + functional IHs, `minorAppRec_hasType`, `recRuleAppRec_hasType`, + `ruleRec_WF`, and the generalized generated-rule fold in `addInduct_WF`; +- Eq, HEq, and index-changing `IndexedVec` kernel-equality fixtures; +- a complete indexed environment invariant, recursor typing proof, constructor + fold, indexed iota LHS/RHS proofs, rule well-formedness proof, and final + `addInduct_WF`; +- `#guard_msgs` axiom checks proving that the checked-analysis and semantic + compatibility roots depend only on `propext` and `Quot.sound`, while the + recursive-Pi typing/preservation roots and `VEnv.addInduct_WF` depend only + on those plus `Classical.choice`; +- an `AddInductSuccess` transaction certificate plus `addInduct_le`, freshness, + type/constructor/recursor lookup, generated-rule membership, atomicity, and + early-rejection theorems for downstream consumers. The certificate now also + retains the exact `checked? = some checked` result, so ix-facing consumers + need not re-run analysis after a successful transaction; +- `AddInductConstant`, `AddInductConstants`, and `AddDefEqs` witnesses in + Verify, with fold realization, lookup, freshness, monotonicity, map-WF, and + value-preservation lemmas; +- a real `AddInduct` transaction aligning `inductInfo`, ordered `ctorInfo`s, + `recInfo`, and generated iota rules; real proofs of + `AddInduct.to_addInduct`, `AddInduct.le`, and `Aligned.addInduct`; and a live + `TrEnv'.of_value` inductive case; +- compile-time axiom-closure guards for the new Verify bridge roots. They + intentionally expose the inherited `TrProj` `sorryAx` until Track P closes + it; they do not bless it as a release axiom; +- `TrTypeExpr`, a representation-only metadata-type translation whose + `to_trExprS` theorem recovers application and pi typing premises from the + declaration's real Theory well-formedness proof; +- a replay-driven Nat fixture that quotes the actual `inductInfo`, both + `ctorInfo`s, and `recInfo` from Lean, translates them in the exact + intermediate environments, constructs `AddInduct`, executes + `TrEnv'.induct`, and checks final `WF`, alignment, and recursor lookup + uniqueness; +- an actual-metadata Eq replay with the same transaction, final-WF, + alignment, and lookup-uniqueness checks. This additionally exercises a real + index, Prop-valued elimination, and the kernel/generated recursor universe + permutation; +- an actual-metadata `IndexedVec` replay layered over the completed Nat + transaction. It exercises two constructors, a recursive field, a changing + result index, final replay equality/WF/alignment, and uniqueness of the + translated type, constructor, and recursor lookups. The source fixture uses + explicit `Nat.zero`/`Nat.succ`, so this tests the semantic dependency while + deliberately excluding notation's unrelated `OfNat`/`HAdd` instance + closure; +- an actual-metadata `Acc` replay that checks kernel constructor/recursor + counts, parameters, indices, recursive fields, rule constructor and field + count, translates each metadata declaration in its exact intermediate + environment, constructs `AddInduct`, executes `TrEnv'.induct`, and proves + final equality, WF, alignment, and lookup uniqueness. Its quoted kernel + `RecursorRule.rhs` is definitionally equal to the generalized Theory RHS, + including the lambda under the recursive Pi and the kernel universe order; +- actual-metadata `AliasFormer` and `AliasRec` replays, including the real + `DefinitionVal` prefixes for `TypeFamilyAlias` and `RecAlias`. They retain + the raw alias-bearing family/constructor payloads, translate the actual + `inductInfo`, `ctorInfo`, `recInfo`, and kernel rules in exact intermediate + environments, execute the normalized transaction, and prove final equality, + WF, alignment, and family/constructor/recursor lookup uniqueness. The + recursive-field case separately pins the raw alias-bearing minor binder; +- a candidate-produced `AnnotatedPi` replay whose actual constructor shape + combines a recursive target below a Pi with retained `outParam Prop` syntax. + It builds the complete normalization/generation certificate from exact + checker traces, executes the checked transaction, and pins the generated + recursor, iota membership/RHS, lookup uniqueness, WF, and alignment; +- explicit definitional equalities for every quoted kernel rule RHS in all six + actual-metadata replays plus the AnnotatedPi generated iota rule, rather than + only the previously highlighted `Acc` rule; +- a real dependency-free definition replayed before Nat, followed by a + concrete `TrEnv'.of_value` theorem whose proof must traverse the outer + inductive transaction and pull the old lookup through every metadata + insertion; +- a complete post-Verify-migration Lean gate on 2026-08-01: the exact 20-entry + sorry audit, `lake build Lean4Lean.Theory Lean4Lean.Verify`, formatter check, + and `git diff --check` pass; the normal current-host `nix build` also passes. + The current-host full flake check and exact all-system no-build evaluation + also pass at `5e5bb767`; representative Linux/Darwin builds remain CI jobs. + +Stage 3 remains intentionally narrow: it accepts only one type and only large +eliminators. Its structural field check recognizes direct recursion and +recursive targets beneath family-free Pi domains, and its public checked +artifact path now uses that generalized representation throughout. Its +closure and internal-name checks, metadata-wide universe-range checks, and +normalized semantic contracts are real kernel-facing checks. The explicit + normalization boundary now demonstrates how raw syntax can be related to a + checked view. Verify can replay an explicitly certified normalized generation + and now derives the two fixed alias normalization certificates plus the + recursive AnnotatedPi annotation certificate from exact ordinary-checker + executions. AliasFormer, AnnotatedPi, and `IndexedVec` have complete checked + dependent generation certificates, exact whole-call produced packages, and + use the public proof-carrying non-identity transaction; the third case + exercises a parameter, an index, and an ordered two-constructor list, and + the identity compatibility path still peels the raw syntax. No generic outer + producer yet constructs the semantic package directly from an arbitrary + successful whole metadata call. AnnotatedPi closes the nested-Π and + annotation-consumption fixture through exact constructor validation, + candidate-list assembly, and the final produced-package equation. + Constructor-parameter agreement is still + syntactic where the kernel uses definitional equality. It also lacks full + positivity, small-elimination, and K analyses. The +negative Or fixture demonstrates that small elimination is not modeled yet. +Further alias shapes, non-defeq normalization negatives, nested negativity, +mutual blocks, nested inductives, notation-heavy prelude replay, and the full +inductive environment fixture matrix remain future work. A successful default +`nix build` alone is not a release gate. + +### 2.3 Live debt outside inductive breadth + +The sorry-frontier script currently reports exactly: + +| Area | Live debt | +|---|---| +| Projection specification | `Verify/Typing/Expr.lean:67`, `TrProj` | +| Projection structural laws | seven sites in `Verify/Typing/Lemmas.lean`: `weak'`, inverse weakening, `defeqDFC`, `wf`, `uniq`, `instN`, `instL` | +| Core metatheory | `Injectivity.lean` x3, `UniqueTyping.lean` x1, `ChurchRosser.lean` x2 | +| Checker verification | `Verify/Level.lean` x2; `Verify/Environment.lean` x1; `InferType.lean` x1; `WHNF.lean` x2; `IsDefEq.lean` x2 | + +There is important non-sorry debt too: + +- The empty Verify `AddInduct` relation and both vacuous `nomatch` proofs have + been removed. Nat, Eq, `IndexedVec`, and `Acc` now supply actual-metadata + witnesses, lookup-uniqueness, `TrEnv'.wf`, and alignment tests; `Acc` also + checks the actual lambda-under-Pi rule RHS, and Nat has a pre-existing-value + preservation regression. E1 is not fully closed until the remaining I2-I4 + fixture matrix is replayed. +- The public inductive spec is a growing subset, not kernel-complete. +- `VLocalDecl` core facts, literal encodings, `ContainsLits`, + `HasPrimitives`, and `TrProj` are implementation-independent but live under + `Verify/`, forcing ix to import that layer. +- There are 29 project-specific `axiom` declarations outside + `Experimental/`: 27 in `Verify/Axioms.lean` and two pointer-equality + contracts in `PtrEq.lean`. Three cached-field equations remain from the + group known false on the older Lean pin (`lean4#8554`). Lean v4.31 repairs + the underlying cache behavior, but these equations are still unproved and + therefore remain forbidden implementation contracts. Count, classification, + and per-root reachability—not just sorry count—are release criteria. +- The fetched `logrel@upstream` branch at `e431dad8` contains a serious + experimental route to injectivity/unique typing, but the live + `Theory/Typing/Injectivity.lean` still has all three sorries. The branch's + route depends on unfinished `ShapeLogRel`/adequacy work and cannot simply be + merged as a completed proof. + +#### Current custom-axiom inventory + +This classification records the intended release treatment; it is not itself +evidence that an implementation equation is true. In particular, the ten +collection/opaque-layout equations still require validation and may move into +the forbidden class if a counterexample is found. + +| Class | Count | Declarations | Release treatment | +|---|---:|---|---| +| Unproved cached-field equations, known false on older pins | 3 | `Level.hasParam_eq`, `Level.hasMVar_eq`, `Expr.looseBVarRange_eq` | Forbidden from every supported theorem root until proved for the pinned implementation | +| Reference equations documented as `@[implemented_by]` candidates | 13 | `Expr.replace_eq`, lift/lower, instantiate/range/reverse, abstract/range, `hasLooseBVar_eq`, `eqv_eq`, `equal_eq` | Replace axioms with logical reference definitions and separately justified implementations | +| Persistent collection semantics | 5 | `TreeMap.all_eq_all_toList`; `PersistentArray.toList'_push`; hash-map insert, find, and contains/find agreement | Prove upstream or narrow to the actual WF/reachable-state invariant | +| Other opaque or representation-layout bridges | 5 | `Syntax.structEq_eq`; Level and Expr data-layout equations; `Level.mkLevelIMaxCore_eq` | Expose/prove upstream, narrow to the properties and bounds actually needed, or reject | +| Candidate platform contracts | 3 | `ptrEqExpr_eq`, `ptrEqConstantInfo_eq`, `Level.instLawfulBEqLevel` | May remain only in a named, version-pinned platform manifest with differential tests | + +**L4L-01U axiom/sorry result.** Relative to source checkpoint `da45b536`, +upstream commit `3dc52e0` proves and removes the four cached-`Expr` axioms +`hasFVar_eq`, `hasExprMVar_eq`, `hasLevelMVar_eq`, and `hasLevelParam_eq`; +`66172a2` removes the hand-declared `Expr.mkAppRangeAux.eq_def` because Lean +v4.31 generates its defining equation. The exact custom-axiom inventory is +therefore 29, down five from 34. `Level.hasParam_eq`, `Level.hasMVar_eq`, and +`Expr.looseBVarRange_eq` remain unproved; although v4.31 fixes the cached-data +bug, they remain forbidden implementation contracts and are not logical +foundations. The exact sorry frontier is 22, up two from 20: upstream adds +`NormLevel.isEquiv_wf`, mapped to L4L-02B, and the front-end theorem +`Lean4Lean.addDecl.WF`, mapped to L4L-19B. Exact guards confirm that the five +retired declarations disappeared. Existing `Expr.mkData_eq` and +`Expr.mkAppData_eq` become visible in several v4.31 Verify closures because the +new cached-field implementation routes through those already-inventoried +layout contracts; no new axiom declaration or supported-root trust category +was added. Raw count changes are acceptable only with this declaration-level +and per-root classification. + +The current reachability audit is **partially established**, not release-clean: + +- the Stage-3 proof builds; executable `#print axioms` guards pin the descriptor + analysis, closure/level/name/anatomy facts, semantic `Checked.WF` compatibility + bridges, the generic normalization-shape/source-anatomy projections, the two + concrete `Normalization.WF` witnesses and their combined paired-block + certificates, + transaction/collision facts, and `VEnv.addInduct_success` to + `propext`/`Quot.sound`, and `VEnv.addInduct_WF` to those plus + `Classical.choice`. Identity checked-block compatibility and the semantic + `Checked.WF.identityGeneration` bridge are separately pinned to the same + three-axiom Theory upper bound; their proof components reach Lean's lawful + Boolean-equality/weakening facts, while the analyzer and shape tests remain + executable definitions rather than postulated oracles. The six recursive-Pi + preservation roots are separately pinned to the same three-axiom Theory + baseline. The normalized transaction trace, atomicity, monotonicity, lookup, + and rule-membership roots are pinned to exactly `propext` and `Quot.sound`; + normalized transaction preservation, the identity-wrapper computation + theorem, and final ordered alias environments additionally reach only + `Classical.choice`. Each alias trace, raw lookup, kernel recursor lookup, and + iota-membership fixture remains at the smaller two-axiom closure; +- `Theory/` currently declares no custom axioms and imports neither + `Verify/Axioms` nor `PtrEq`, which is the required architectural boundary; +- the full generated closure report for the remaining Theory endpoints, + Verify checker roots, and ix-imported theorem set does not yet exist; +- the new E1 bridge roots have checked closures, but they inherit `sorryAx` + through the type dependency `TrConstVal → TrExprS → TrProj`; this is Track + P's projection-specification hole, not a new E1 axiom declaration; +- the five L4L-01U-retired names are absent from the source and exact guards; + their former textual uses have kernel proofs or generated v4.31 equations; +- all three remaining cached-field equations are simp lemmas and can enter a + proof without a textual reference to their names, so their absence must be + established by exact root guards rather than source search. + +Consequently, source import/name searches are useful diagnostics but are not +the release audit. Only the generated transitive axiom closure of each named +root is authoritative. + +#### Current root-level axiom snapshot + +The exact current closures below answer two different questions. The Theory +set is reasonable for this formalization: it is Lean's usual logical baseline +and contains no project-specific bridge axiom. The Verify set is reasonable +only as an explicitly guarded *transitional diagnosis*; `sorryAx` is not an +acceptable release dependency. + +The acceptance decision is deliberately stricter than “Lean compiled it”: + +- `propext`, `Classical.choice`, and `Quot.sound` are the permitted standard + logical baseline. `propext` supports equality of extensionally equivalent + propositions, choice permits classical witness selection in proofs, and + `Quot.sound` is Lean's quotient identification principle. A root may use only + the subset it actually reaches; +- no project-specific axiom is authorized for `VInductDecl.Checked`, inductive + generation/preservation, the future E2 oracle-construction theorem, or any + other Theory API exported to ix. A perceived need for one is a specification + or proof-design blocker, not a reason to extend the allowlist; +- `sorryAx` and the persistent-map contracts in the Verify rows are recorded so + their removal can be tested. They are not part of the accepted release set; +- the three cached-field equations known false on older toolchains remain + forbidden until proved for v4.31, even though the implementation bug is + fixed. Reachability, rather than declaration presence alone, is the release + criterion. + +| Root | Current transitive closure | Assessment / removal path | +|---|---|---| +| `Checked.analysis_accepted`, `names_nodup`, `type_closed`, `ctor_closed`, `type_levelWF`, `ctor_levelWF`, `direct_anatomy` | `propext`, `Quot.sound` | Accepted logical baseline; every exported structural-analysis fact is compile-time guarded. `checked?` itself is computational and declares no axiom. | +| `Checked.wf_of_decl`, `Checked.to_declWF`, `VInductDecl.wf_iff_exists_checked` | `propext`, `Quot.sound` | Accepted logical baseline; these guarded theorems show that the new environment-indexed semantic certificate adds no trust and is exactly compatible with the legacy relation. | +| `Normalization.shape`, `NormalizedChecked.source_anatomy`, `GenerationChecked.shape`, `GenerationChecked.rawCtors_eq`, `GenerationChecked.viewCtors_eq` | `propext`, `Quot.sound` | Accepted logical baseline; exact generic guards establish declaration arities, ordered family/constructor identities, raw/view layout, and complete positional constructor coverage. They do not assert expression equality or authorize a view semantically. | +| `TelDefEq.raw_onTel`, `TelDefEq.instL`, `TelDefEq.ctx`, `GenerationChecked.WF.rawFamily_isType`, `GenerationChecked.WF.rawCtor_isType` | subset of `propext`, `Quot.sound`, exactly guarded per root | Accepted logical baseline; the structural semantic contract yields raw telescope well-formedness, universe transport, definitionally equal completed contexts, and insertion-ready raw family/constructor types. No injectivity theorem, `sorryAx`, project-specific axiom, or Verify import is reachable. | +| `GenerationEnv.motive_isType`, `familyApp_transport` | `propext`, `Quot.sound` | Accepted and compile-time guarded. These roots cover the mixed motive and the common raw-family application transport without reaching choice or any project axiom. | +| `GenerationEnv.minor_isType`, `minorTypes_onTel`, `recType_isType`, `recursor_wf`, `ruleCall_hasType`, `rule_WF`, `generatedRules_WF`, `generatedRulesFold_ordered` | `propext`, `Classical.choice`, `Quot.sound` | Accepted logical baseline; every stabilized mixed minor/recursor/rule/fold boundary has an exact compile-time guard. No `sorryAx`, Verify import, or project-specific axiom reaches the complete mixed artifact preservation path. | +| `VEnv.addInductGeneration_trace`, `addInductGeneration_atomic`, and `AddInductGenerationTrace.le`/family/constructor/recursor lookup/`rule_mem` | `propext`, `Quot.sound` | Accepted and exactly guarded. The data-bearing trace is returned under `Nonempty`, so proof consumers recover the exact intermediate environments without adding `Classical.choice`; the trace is a certificate of the executable transaction, not a semantic oracle. | +| `VEnv.addInductGeneration_WF`, `addInduct_eq_addInductGeneration` | `propext`, `Classical.choice`, `Quot.sound` | Accepted and exactly guarded. Preservation consumes `GenerationChecked.WF` in insertion order and never reconstructs `Stage3Env`; the wrapper theorem pins the raw API to identity normalization. Choice is inherited from the mixed artifact/identity proof chain, not from extracting transaction states. | +| `VEnv.addInductCertified_eq_addInductGeneration` | `propext`, `Quot.sound` | Accepted and exactly guarded. The theorem is definitionally `rfl`, so it machine-checks the proof-erasure boundary: the public certified entry point computes only with `certificate.generation`, and its WF proof cannot select or alter artifacts. The reported logical closure is reached through the dependent certificate/generation types in the statement, not through computational inspection of the proof. | +| `VEnv.addInductCertified_trace`, `addInductCertified_atomic` | `propext`, `Quot.sound` | Accepted and exactly guarded. The proof-carrying public wrapper computes through `addInductGeneration`; these theorems recover the same transaction trace and atomicity result without exposing or importing Verify. The certificate's WF field is not inspected by computation. | +| `VEnv.addInductCertified_WF` | `propext`, `Classical.choice`, `Quot.sound` | Accepted and exactly guarded. The certificate carries the exact semantic premise consumed by normalized preservation, so ix does not need a separate checker-trace argument or a normalization oracle. This is the intended Theory-only non-identity transaction boundary. | +| `VDecl.WF.induct` | `propext`, `Quot.sound` | Accepted and exactly guarded. Environment histories now record the exact certified `GenerationChecked` transaction, so non-identity normalization is represented honestly rather than being forced through the identity-only public wrapper. | +| `identityChecked?_isSome` | `propext`, `Classical.choice`, `Quot.sound` | Accepted logical baseline; the identity wrapper has exactly the legacy analyzer's success behavior. The standard closure enters through the proof carried by reflexive normalization shape, including symbolic-name `BEq` lawfulness; the underlying analyzer and identity wrapper still compute and declare no oracle. Keep this exact guard so an implementation-proof dependency cannot silently grow. | +| `Checked.analyzer_eq` | `propext`, `Quot.sound` | Accepted logical baseline; any retained dependent descriptor is the unique exact analyzer result, so the identity bridge does not rerun analysis or choose a competing witness. | +| `Checked.identityBlock_generationShape`, `motiveType_eq_legacy`, `minorTypes_eq_legacy`, `recursor_eq_legacy`, `generatedRules_eq_legacy` | `propext`, `Classical.choice`, `Quot.sound` | Accepted and exactly guarded. The `Classical.choice` dependency is inherited from the already-guarded reflexive normalization-header proof; artifact construction remains computational. These roots prove that the live public accessors use the mixed generator while preserving the exact legacy identity output. | +| `aliasFormerNormalization_wf`, `aliasRecNormalization_wf`, both block-WF roots, and both generation-WF roots | `propext`, `Quot.sound` | Accepted logical baseline; exact fixture guards demonstrate that family-result and recursive-field alias normalization can be justified by existing Theory definitional equality and combined with the checked view's semantic, layout, and granular raw-binder certificates. These are evidence for the boundary design, not axioms authorizing arbitrary normalized views. | +| `AddInductive.CandidateTypeAnnotationTrace.build`, `buildCandidateTypeAnnotations`, `buildCandidateExpr`, `buildCandidateCheckType`, `buildNormalizationCandidate`, all three `CandidateExpr.*Step_valid` roots, and all three `Candidate*Step.innerRun` roots | subsets of `propext`, `Classical.choice`, `Quot.sound`, exactly guarded per root | Accepted. The executable producer retains concrete evidence: each WHNF/full-check/binder-equality node stores its actual `M.run` equality, and the `innerRun` adapters only recover erased final states. The structural annotation trace exposes the retained argument; the producer independently rejects disagreement with Lean's opaque `consumeTypeAnnotations` helper and refuses a negative `isDefEq`. The certificate intentionally stores no proposition equating its result with that opaque partial definition: the runtime agreement test is implementation validation, while semantic authority comes from the structural trace plus exact checker equality run. The standard closure is inherited from the checker/container implementation; there is no `sorryAx`, native evaluator, opaque-helper equation, normalization axiom, or project-specific axiom. | +| `TypeChecker.WhnfRun.ofCandidateStep`, `CheckTypeRun.ofCandidateStep`, `IsDefEqRun.ofCandidateStep` | `propext`, `sorryAx`, `Classical.choice`, `Quot.sound` | Transitional and exactly guarded. The adapters supply no semantic proof by themselves: callers must provide a verified context plus strict endpoint translations. `sorryAx` is inherited from the existing Verify context/translation frontier and must disappear there; the adapters add no pointer or cache axiom. | +| `candidateTypeAnnotation_fvarsIn`, `candidateTypeAnnotation_exists_translation`, `IsDefEqRun.isDefEqU` | respectively axiom-free; `propext`, `sorryAx`, `Classical.choice`, `Quot.sound`; and the exact checked semantic set | Transitional and exactly guarded. Structural recursion proves consumption cannot add free variables and extracts the retained argument's strict translation. `IsDefEqRun.isDefEqU` then refines the exact successful checker execution through the existing verified `isDefEq` theorem. The larger closure is inherited from that checker refinement; the annotation bridge declares no axiom and does not convert Lean's Boolean `Expr.equal` agreement check into an unproved propositional equality. | +| `TypeChecker.CandidateNodeRun.ofCandidate`, `CandidateNodeRun.exists_ofCandidate`, `CandidateNodeRun.evidence`, `CandidateExprRun.evidence`, `source_tr`, `view_tr` | the adapter set for direct construction; the exact checked semantic set for existential output recovery, interpretation, and endpoint translation | Transitional and exactly guarded. Recursive context/source indices tie Pi children to the exposed raw domain, exact instantiated body, actual local-context extension, and generated binder identifier. `exists_ofCandidate` derives the returned inferred/result translations from the verifier refinements once given a matching context and source translation. The interpreter consumes the paired runs, uses unique typing to transport alias-valued inferred types to structural Pi sorts, composes Pi congruence under the raw binder, and proves translations of both endpoints; it declares no oracle or axiom. The larger closure is inherited from the existing verifier refinement/context-conversion frontier. | +| `AddInductive.CandidateList.singleton` | axiom-free | Accepted structural helper. The singleton index proves the only possible family-list shape and removes any need for `head!` or a default element. | +| `AddInductive.CandidateFamilyTypeListProduced.normalize`, `CandidateConstructorListProduced.normalize`, `CandidateFamilyListProduced.normalize` | `propext`, `Classical.choice`, `Quot.sound` | Accepted operational structural glue, exactly guarded. The dependent source indices preserve length, order, and family/constructor provenance for arbitrary lists; the proofs only compose exact per-position executable results and introduce no project axiom, erasure equality, unchecked `zip`, or semantic authority. `IndexedVec` exercises the two-constructor case, while AliasFormer and AnnotatedPi exercise the singleton cases. | +| `TypeChecker.CandidateExprRootRun.evidence`, `VInductDecl.CandidateConstructorListRun.evidence`, `NormalizationCandidateRun.normalizationRun` | exactly the checked semantic set listed below | Transitional and exactly guarded. Callers name raw and exact candidate-view translations; the verified recursive run proves their equality. Constructor evidence is folded with `List.Forall₂`, and the singleton family wrapper constructs the semantic `NormalizationRun` without selecting a proof-only existential or accepting an unrelated view. The closure is inherited unchanged from the checker refinement. | +| `VInductDecl.CandidateConstructorListRun.sameHeaders`, `NormalizationCandidateRun.normalization` | respectively `propext`, `sorryAx`, `Classical.choice`, `Quot.sound`; and the same set | Transitional and exactly guarded. These roots derive header/shape preservation from the dependent run itself. They add no semantic equality and cannot truncate either list; the inherited `sorryAx` is type-level Verify debt, not a new shape axiom. | +| `TypeChecker.VState.WF.empty_of_reserves`, `candidateFreshFVarId_reserved`, `CandidateContextRun.root`, `CandidateContextRun.pushLocalDecl` | exact subsets of the transitional context set: the fresh-ID lemma uses only `propext`, `Classical.choice`, `Quot.sound`; root/context extension additionally inherit `sorryAx` plus the already recorded expression/level/container contracts | Transitional and exactly guarded. These roots construct—not assume—the precise verified root and binder contexts retained by a candidate trace. Body contexts contain the annotation-consumed domain; the separately retained exact equality run ties that domain back to raw syntax. The producer records the binder freshness equation, the candidate and checker name prefixes are proved distinct, and every empty-state restart reserves the accumulated free variables. No normalization, evaluation, or context-coherence axiom was added. `sorryAx` remains inherited from the existing `VContext`/`VState` well-formedness frontier and is therefore still release-blocking. | +| `candidateCheckTypeStep_exists_translation`, `CandidateExprRun.exists_ofCandidate`, `CandidateExprRun.exists_ofCandidateFVars` | exactly the checked semantic set (`propext`, `sorryAx`, `Classical.choice`, the two pointer implications, `Quot.sound`, and the named Expr/Level/container refinement contracts listed below) | Transitional and exactly guarded. The first theorem recovers strict source/inferred translations and typing from an exact retained full check. The recursive roots obtain all node outputs, extend the verified context with the annotation-consumed binder, refine raw-to-consumed equality, transport the body translation and typing between definitionally equal contexts, and certify an arbitrary annotated-domain trace. The `FVars` wrapper removes the last caller-chosen Theory expression. This is proof reconstruction over concrete runs, not an oracle; the former `CandidateRawBinderDomains` restriction has been removed. | +| `TypeChecker.TelDefEqEvidence.telDefEq`, `VInductDecl.NormalizedCtorRun.wf`, `GenerationRun.wf` | exactly the checked semantic set listed below | Transitional and exactly guarded. These generic roots interpret compositional checker evidence as the pointwise telescope, constructor, and complete generation certificates required by Theory. Their statements mention exact verifier-run evidence, so inheriting the verifier closure is expected; the assembler declares no axiom and does not enlarge that set. | +| `CandidateExprTrace.storedSpine`, `CandidateExprTrace.spineLength` | `propext`, `Classical.choice`, `Quot.sound` | Accepted structural/computational guards. They inspect the retained trace, require every emitted raw Pi node to remain the same outer Pi, and count exactly those nodes. They permit domain/result normalization but do not postulate Pi injectivity, normalization completeness, or semantic equality. | +| `InductiveReplayFixtures.candidateIsDefEqSelfValid` | `propext`, `Classical.choice`, `Quot.sound`, `Expr.eqv_eq`, `Level.instLawfulBEqLevel`, `Syntax.structEq_eq` | Reasonable as an exactly guarded Verify-layer reflexive execution lemma, but not an ix-facing release allowlist. It proves the ordinary checker accepts `e ≡ e`; it declares no equality or normalization axiom. The three implementation contracts are inherited from Lean expression/level/name equality and must stay confined to Verify until Track T justifies or replaces them. | +| `InductiveReplayFixtures.indexedVecFamily_candidateTrace`, `indexedVecCandidateInductiveStats_nindices`, `indexedVecCandidateInductiveStats_params` | `propext`, `sorryAx`, `Classical.choice`, `Quot.sound`, `Expr.eqv_eq`, `Expr.instantiate1_eq`, `Expr.instantiateRev_eq`, `Expr.instantiate_eq`, `Expr.looseBVarRange_eq`, `Expr.mkAppData_eq`, `Expr.mkData_eq`, `Expr.replace_eq`, `Level.hasParam_eq`, `Level.instLawfulBEqLevel`, `PersistentArray.toList'_push`, `PersistentHashMap.findAux_isSome`, `Syntax.structEq_eq`, `PersistentHashMap.WF.find?_eq`, `PersistentHashMap.WF.toList'_insert` | Transitional and exactly guarded. These roots replay the real `IndexedVec` family through two dependent binders and expose the computed one-parameter/one-index statistics. `sorryAx` and container/reference/layout equations are inherited from the existing Verify environment/context frontier; the fixture adds no axiom and gives these contracts no Theory authority. | +| `InductiveReplayFixtures.indexedVec_checkInductiveTypes` | the preceding `IndexedVec` candidate set plus `Level.hasMVar_eq` | Transitional and exactly guarded. This is the complete executable singleton-family validation, including the closedness checks. The four cached-`Expr` facts are now proved on v4.31; their proofs expose only the already listed data-layout contracts. The closure remains development evidence because every dependency is visible, but its `sorryAx` and implementation contracts are release-blocking and must not flow into the Theory certificate consumed by ix. | +| `AddInductive.observeCandidateIsDefEq_of_run`, `buildCandidateExpr_loop_of_whnf_nonForall`, `buildCandidateExpr_loop_of_whnf_forall` | `propext`, `Classical.choice`, `Quot.sound` | Accepted operational reduction seams, exactly guarded. They expose a supplied exact ordinary-checker execution and assemble one terminal or Π traversal step; they add no normalization oracle, evaluator equation, or fixture-specific axiom. | +| `TypeChecker.TelDefEqEvidence.ofTelDefEq` | `propext`, `sorryAx`, `Classical.choice`, `Quot.sound` | Transitional and exactly guarded. This constructs evidence from already proved pointwise telescope equality; its `sorryAx` is inherited through the Verify translation/context statement, not introduced by extraction. It reaches none of the pointer, expression-reflection, or container contracts used by executable checker refinement. | +| `CandidateExprIdentity.storedSpine`, `CandidateExprRun.exists_ofIdentity`, `CandidateExprRootRun.spineOfIdentity` | a subset of the checked semantic set listed below, reached transitively by both exact `IndexedVec` public-root guards | Transitional. These roots recursively interpret a syntactically identity-normalizing candidate at caller-selected Theory endpoints and recover its generation-ready stored spine from the same source-indexed run. They declare no axiom and do not assume a normalization equation; their closure is inherited from the existing verifier, translation, unique-typing, and container frontier. Add direct guards if they become independently exported audit roots. | +| `CandidateExprSemanticRootRun.exists_ofCandidate`, `.root`, `CandidateExprRootRun.semanticOfIdentity`, `CandidateConstructorSemanticListRun.roots`, `CandidateFamilySemanticRun.root`, `NormalizationCandidateSemanticRun.root`; separately `CandidateExprSemanticRootRun.spine` | the first group has exactly the checked semantic set listed below; `spine` has exactly `propext`, `sorryAx`, `Classical.choice`, and `Quot.sound` | Transitional, directly audited with `#print axioms` at `f0caf16c`. The root theorem lets the retained checker run select its Theory view from verified context/source evidence, while the dependent projections preserve exact source positions through normalization. The spine is a direct projection of that same run. Their new composite construction and generation callers are exact compile-time guarded in the next row; add individual guards here only if one becomes an independently exported audit root. None declares an axiom, assumes normalization, invokes a native evaluator, or gives the operational producer independent semantic authority. The broad closure is inherited from the existing checked-semantic translation/refinement frontier and remains release-blocking for ix-facing evidence. | +| `TypeChecker.CandidateExprSemanticRootInput.exists`, `CandidateConstructorSemanticListInput.exists`, `NormalizationCandidateSemanticInput.exists_ofProduced`, `CandidateFamilySemanticGenerationRun.run`, `CandidateSemanticNormalizedCtorListRun.run`, `GenerationCandidateSemanticRun.run`, `.package`, `.producedPackage` | exactly the checked semantic set listed below, compile-time guarded per root | Transitional and exactly guarded at `7e5f4f77`. The input hierarchy combines verified contexts and strict translations with exact operational list witnesses, then returns the complete source-ordered semantic hierarchy under `Nonempty`; the producer selects the indexed candidate but does not select its Theory view. The semantic-generation projections reuse that hierarchy's recursive runs and spines, eliminating parallel normalization/generation ownership. `Nonempty` is intentional: extracting a data-bearing run would require choice, whereas proof consumers need only semantic existence. No new axiom, normalization oracle, native evaluator, unchecked positional operation, or caller-selected endpoint is introduced. | +| `aliasFormerProducedSemanticHierarchy_exists`, `annotatedPiProducedSemanticHierarchy_exists`, `indexedVecProducedSemanticHierarchy_exists`, the three `*GenerationCandidateSemanticRun` roots, `indexedVecProducedSemanticHierarchy_constructorHeaders`, and `indexedVecReorderedView_rejected` | all positive roots have exactly the checked semantic set; reordered-view rejection has exactly `propext` | Transitional fixtures, all exactly guarded. The three positive blocks exercise terminal-alias, annotated recursive-Π, and parameter/index/two-constructor assembly. `IndexedVec` proves that the existential semantic result retains `nil`/`cons` order, while swapping those headers fails the computational normalization-shape gate before semantic or generation evidence can be attached. The v4.31 cache proofs remove the former AnnotatedPi-only axiom delta. | +| `CandidateExprRun.spineEvidence`, `CandidateExprSpineRun.evidenceAt`, `TelResultDefEqEvidence.replacePrefix`, `CandidateNormalizedCtorRun.normalizedCtorRun`, `GenerationCandidateRun.wf` | exactly the checked semantic set listed below | Transitional and exactly guarded. These generic generation-level roots recursively recover binder equality and the terminal result from the exact run, prove raw-spine length, replace a constructor's declared parameter prefix with the definitionally equal emitted family prefix in the exact induced contexts, fold a source-indexed dependent constructor list, and produce `GenerationChecked.WF`. They use neither forall injectivity nor a choice-selected candidate view and declare no axiom; the closure is inherited unchanged from checker refinement, unique typing, translation, and container contracts. | +| `Checked.type_eq`, `GenerationChecked.viewCtorType_eq`, `GenerationChecked.checkedResultTarget_hasType` | exactly `propext`, `Quot.sound` | Accepted Theory baseline and exactly guarded at `2b1d802f`. These roots expose the analyzer's exact family/constructor telescope decomposition and type a constructor's normalized result application from the retained family constant plus checked parameter/index spines. No Verify import, custom axiom, normalization oracle, or whole-Pi injectivity enters Theory. | +| `Normalization.check?_normalization`, `Normalization.generation?_normalization` | exactly `propext`, `Quot.sound` | Accepted Theory baseline and exactly guarded at `a64fe982`. These theorems invert exact successful dependent analysis to recover the normalization retained by its indexed result. They unfold the computational analyzers and introduce no Verify dependency, choice, custom axiom, or normalization oracle. | +| `GenerationCandidateRun.familyView_eq`, `CandidateNormalizedCtorRun.viewTel_eq` | exactly `propext`, `sorryAx`, `Classical.choice`, `Quot.sound` | Transitional Verify glue and exactly guarded at `2b1d802f`. Singleton normalization indices force the exact checked family view, while a known non-forall terminal plus exact checked constructor shape recovers the complete candidate view telescope. The inherited `sorryAx` is already present in the retained semantic-run types; neither theorem declares an axiom or adds semantic authority. | +| `GenerationCandidateRun.normalization_eq` | exactly `propext`, `sorryAx`, `Classical.choice`, `Quot.sound` | Transitional Verify projection and exactly guarded at `a64fe982`. The theorem consumes the exact `generation? = some generation` field and delegates normalization recovery to the Theory theorem above. The inherited `sorryAx`/choice closure comes from the dependent Verify evidence type in its statement; fixtures no longer provide the equality. | +| `NormalizationCandidateRun.sourceType_eq`, `NormalizationCandidateRun.familyViewType_eq` | exactly `propext`, `sorryAx`, `Classical.choice`, `Quot.sound` | Transitional Verify alignment and exactly guarded at `5aa9ab69`. Singleton source indices and exact dependent analysis determine the retained raw family and complete checked family view. The inherited closure comes from the dependent Verify evidence in the statements; neither theorem declares an axiom, asserts normalization, or lets a caller select a view. | +| `GenerationCandidateSemanticShapeRun.run` | exactly the checked semantic set listed below | Transitional and exactly guarded at `5aa9ab69`. Source-indexed minimal shapes retain only stored-spine success and the total binder count. Exact analysis derives every raw/view pair and the complete ordered constructor list; total length derives raw telescope/results, and checked shape derives view terminals. The projection reconstructs `GenerationCandidateSemanticRun` without `zip`, truncation, reordering, a caller-selected pair, or component premises. Its closure is exactly the existing checked semantic set, so the structural recursion and telescope decomposition add no axiom. | +| `candidateConstructorSemanticGenerationShape`, `normalizationCandidateGenerationShape`, `CandidateConstructorSemanticGenerationShapeList.ofCheck`, `produceGenerationShapeCandidate`, `produceGenerationShapeCandidate_eq_ok` | exactly `propext`, `Classical.choice`, `Quot.sound` | Accepted executable boundary and exactly guarded at `bbb45e0e`. The source-indexed Boolean covers the complete family/constructor hierarchy, checks retained emitted spines and full raw telescope lengths, and rejects missing or extra constructor positions. The strengthened producer retains the exact ordinary producer equation plus this separately successful gate. These roots make no Theory claim, declare no axiom, and cannot turn bare producer success into stored-spine evidence. | +| `NormalizationCandidateSemanticRun.generationShape`, `GenerationCandidateSemanticRun.ofGenerationShape`, `NormalizationCandidateSemanticRun.producedPackageOfGenerationShape`, `ProducedGenerationShapeCandidate.producedPackage` | exactly the already recorded checked semantic set, compile-time guarded per root | Transitional and exactly guarded at `bbb45e0e`. Exact dependent analysis and WF of the analyzer-owned view declaration derive checked WF; the successful complete Boolean expands structurally into every source-indexed family/constructor stored-spine/count record. Packaging then reuses the existing semantic owner for the same producer-selected candidate. The broader closure is inherited from verified checker/context evidence, not introduced by the shape gate; no new axiom, normalization oracle, native evaluator, unchecked positional operation, or caller-selected view is added. | +| `GenerationCandidateRun.typeEnv_wf` | exactly the checked semantic set listed below | Transitional and exactly guarded at `a64fe982`. It reconstructs the post-family environment from retained pre-family WF, the verified raw/view definitional equality, checked family typing, and the exact raw-family insertion. The broad closure is inherited from the existing checker/context evidence; fixtures no longer provide this WF judgment, and no new axiom or environment oracle is introduced. | +| `GenerationCandidateRun.familyConst_hasType`, `CandidateNormalizedCtorRun.rightType_ofChecked` | exactly the checked semantic set listed below | Transitional and exactly guarded at `2b1d802f`. The family constant is typed once in the post-family environment by combining exact insertion, candidate equality, and checked family WF. Every constructor terminal then follows from the checked result spine and telescope-context transport. Fixtures no longer supply terminal typing judgments; the broad closure is inherited from existing Verify checker/context evidence and does not reach the three Theory roots above. | +| `GenerationCandidateRun.package`, `GenerationCandidateRun.producedPackage` | `propext`, `sorryAx`, `Classical.choice`, `Quot.sound` | Transitional and exactly guarded. The first packaging root retains the already indexed source/candidate/run fields without interpreting them. The second attaches an exact successful whole-call equation for that same dependent candidate and cannot be reused for a different run, reordered list, or caller-selected view. The small closure comes from the dependent Verify evidence types in their statements; neither root introduces checker, producer, or normalization authority. | +| `GenerationCandidatePackage.certificate`, `GenerationCandidatePackage.addInductTrace` | exactly the checked semantic set listed below | Transitional and exactly guarded. Certificate erasure derives both the Theory generation and its WF proof from the same package. The metadata replay constructor likewise fixes its trace's generation/WF fields to package projections, so callers may supply insertion witnesses but cannot substitute an unrelated normalized view. The inherited Verify closure remains release-blocking and does not reach the resulting Theory API declaration. | +| `InductiveReplayFixtures.aliasFormerGenerationCandidateRun` | exactly the checked semantic set listed below | Transitional and exactly guarded. This concrete non-identity fixture supplies exact analysis, WF of the analyzer-owned view declaration, and one successful complete generation-shape gate; it no longer supplies checked WF or any per-position shape record. The generic projection derives checked WF, raw/view family identity, normalized pairing/order, all raw telescope/results and view terminals, and the dependent constructor list. Its existing `GenerationRun`, checked `AddInductTrace`, final environment, WF, and alignment replay delegate through this value, so the vertical path adds no axiom beyond the already visible Verify frontier. | +| `InductiveReplayFixtures.aliasFormerNormalizationCandidate_produced` | `propext`, `sorryAx`, `Classical.choice`, `Quot.sound`, `Expr.eqv_eq`, `Expr.looseBVarRange_eq`, `Expr.mkAppData_eq`, `Expr.mkData_eq`, `Level.instLawfulBEqLevel`, `PersistentHashMap.findAux_isSome`, `Syntax.structEq_eq`, `PersistentHashMap.WF.find?_eq`, `PersistentHashMap.WF.toList'_insert` | Transitional and exactly guarded. This is the exact successful whole `buildNormalizationCandidate` call on real AliasFormer metadata. It proves the family check, family insertion, constructor check, and source-indexed list assembly in their actual contexts; it does not assert an erasure equality or authorize a caller-selected view. The v4.31 closed-expression cache facts are proved; their implementation proof reaches the two existing data-layout contracts. | +| `InductiveReplayFixtures.aliasFormerProducedGenerationCandidatePackage` | exactly the checked semantic set | Transitional and exactly guarded. The value uses the generic strengthened outer constructor to combine the exact ordinary producer equation, complete generation-shape success, and the semantic owner. The producer equation selects the candidate but grants no Theory or shape meaning. Generic construction of the verified per-position semantic inputs and analyzer-owned view WF from an arbitrary verified outer context and exact traversals is still open. Checked WF, every per-position shape record, raw/result and view-terminal equations, normalized-pair/order, dependent-list alignment, view telescopes, terminal typing, normalization equality, and post-family WF are generic consequences and are no longer part of that gap. | +| `InductiveReplayFixtures.aliasFormerFamily_whnf`, `aliasFormerCtor_whnf` | `propext`, `sorryAx`, `Classical.choice`, `Quot.sound`, `Expr.eqv_eq`, `Level.instLawfulBEqLevel`, `PersistentHashMap.findAux_isSome`, `Syntax.structEq_eq`, `PersistentHashMap.WF.find?_eq`, `PersistentHashMap.WF.toList'_insert` | Transitional and exactly guarded. These are the pre-family alias reduction and post-family opaque-constructor `Inner.whnf'` traces. They reach no pointer-equality axiom and use no `native_decide` or newly declared reduction principle; the remaining contracts are inherited Verify/platform debt. | +| `InductiveReplayFixtures.aliasFormerFamily_candidateTrace`, `aliasFormerCtor_candidateTrace`, `aliasFormerFamily_candidate` | the exact AliasFormer operational set plus `Expr.looseBVarRange_eq` from retained full checks | Transitional and exactly guarded. These pin both positions of the real singleton family/constructor candidate list plus the erased family view. They do not certify an arbitrary translated candidate or add semantic authority to `NormalizationCandidate`. | +| `InductiveReplayFixtures.aliasFormerFamily_candidateRun_exists`, `aliasFormerFamily_candidateSource_tr`, `aliasFormerFamily_candidateView_tr` | respectively the exact checked semantic set, retained-check set, and checked semantic set | Transitional and exactly guarded. The existential fixture instantiates automatic root-context and source/output recovery on actual metadata without supplying a Theory expression. The endpoint fixtures pin the strict raw and reconstructed view translations. AliasFormer's normalization and generation evidence consume the same interpreted trace; none of these fixtures authorizes an arbitrary candidate. | +| `InductiveReplayFixtures.aliasFormerNormalizationCandidateRun`, `aliasFormerCandidateNormalization_eq` | exactly the checked semantic set | Transitional and exactly guarded. The complete source-indexed singleton list now computes the established AliasFormer view and supplies its live `NormalizationRun`; all downstream checked generation and replay roots therefore exercise the generic list boundary. `aliasFormerTruncatedView_rejected` separately uses only `propext` and proves a shorter view fails before transaction construction. | +| `InductiveReplayFixtures.recAlias_whnf` | the preceding exact set plus `Expr.mkAppData_eq`, `Expr.mkData_eq`, `Expr.replace_eq`, and `Level.hasParam_eq` | Transitional and exactly guarded. The additional contracts arise from instantiating and reducing the universe-polymorphic `RecAlias` value. The former `Expr.hasLevelParam_eq` axiom is now a theorem whose implementation proof reaches the two data-layout contracts. This is still an execution theorem, not an oracle that asserts its result. | +| `InductiveReplayFixtures.aliasFormerFamily_checkType`, `aliasFormerCtor_checkType` | `propext`, `sorryAx`, `Classical.choice`, `Quot.sound`, `Expr.eqv_eq`, `Expr.looseBVarRange_eq`, `Level.instLawfulBEqLevel`, `PersistentHashMap.findAux_isSome`, `Syntax.structEq_eq`, `PersistentHashMap.WF.find?_eq`, `PersistentHashMap.WF.toList'_insert` | Transitional and exactly guarded. These are exact operational full-check traces. The family check returns `Sort 2`; the constructor check runs after raw-family insertion and returns the retained `TypeFamilyAlias`. Both record the cache result, reach no pointer-equality contract, and introduce no evaluation axiom. | +| `InductiveReplayFixtures.aliasFormerFamily_isType_checked`, `aliasFormerCtor_isType_checked`, both `*Normalization_wf_checked`, both `*Block_wf_checked`, and both `*GenerationChecked_wf_checked` roots | `propext`, `sorryAx`, `Classical.choice`, `ptrEqConstantInfo_eq`, `ptrEqExpr_eq`, `Quot.sound`, `Expr.abstractRange_eq`, `Expr.abstract_eq`, `Expr.eqv_eq`, `Expr.hasLooseBVar_eq`, `Expr.instantiate1_eq`, `Expr.instantiateRange_eq`, `Expr.instantiateRevRange_eq`, `Expr.instantiateRev_eq`, `Expr.instantiate_eq`, `Expr.looseBVarRange_eq`, `Expr.lowerLooseBVars_eq`, `Expr.mkAppData_eq`, `Expr.mkData_eq`, `Expr.replace_eq`, `Level.hasMVar_eq`, `Level.hasParam_eq`, `Level.instLawfulBEqLevel`, `PersistentArray.toList'_push`, `PersistentHashMap.findAux_isSome`, `Syntax.structEq_eq`, `PersistentHashMap.WF.find?_eq`, `PersistentHashMap.WF.toList'_insert` | Transitional and exactly guarded. The semantic bridge correctly inherits the existing verified checker's pointer/reflection, data-layout, and container contracts; completing the paired block and generation certificates adds no dependency beyond the normalization endpoint. `sorryAx` remains on the separately tracked translation frontier. The v4.31 closure drops the generated `mkAppRangeAux` axiom and the previously reachable TreeMap contract. This is development evidence, not a release allowlist, and it must not reach Theory or ix semantic roots. | +| `InductiveReplayFixtures.aliasFormerGenerationCandidatePackage`, `aliasRecAddInductTraceChecked`, `aliasRec_trEnv'_checked` | exactly the preceding checked semantic set | Transitional and exactly guarded. The semantic package owns the generation/WF pair, and the AliasRec replay retains the established checked semantic closure. No outer producer equation is involved in these roots. | +| `InductiveReplayFixtures.aliasFormer_addInductCertified_checked`, `aliasFormerGenerationChecked_wf_checked`, `aliasFormerAddInductTraceChecked`, `aliasFormer_trEnv'_checked` | exactly the preceding checked semantic set | Transitional and exactly guarded. These concrete consumers now project from the produced package, making exact whole-call provenance visible in their axiom reports. Proof erasure still keeps those contracts out of transaction computation, and the generic Theory API remains Theory-clean; the inherited `sorryAx` and platform equations remain release-blocking for this Verify-produced value. | +| `InductiveReplayFixtures.annotatedPiCtor_candidateTrace`, `annotatedPiFamily_candidateTrace` | exact guarded operational subsets of the checked semantic set; the nested constructor root inherits `sorryAx`, `ptrEqExpr_eq`, and the existing Expr/Level/container refinement equations, while the family root uses only `propext`, `Classical.choice`, `Quot.sound`, `Expr.eqv_eq`, `Expr.looseBVarRange_eq`, `Level.hasParam_eq`, `Level.instLawfulBEqLevel`, and `Syntax.structEq_eq` | Transitional and exactly guarded. These are the exact recursive candidate traversals selected by the real constructor and family producer calls. The family profile remains narrow; the constructor profile exposes existing checker-refinement debt because it traverses annotation consumption beneath a recursive Π. Neither trace is semantic authority by itself. | +| `InductiveReplayFixtures.annotatedPiNormalizationCandidate_produced` | `propext`, `sorryAx`, `Classical.choice`, `ptrEqExpr_eq`, `Quot.sound`, `Expr.eqv_eq`, the existing instantiate/replace/loose-variable contracts, `Expr.mkAppData_eq`, `Expr.mkData_eq`, `Level.hasMVar_eq`, `Level.hasParam_eq`, `Level.instLawfulBEqLevel`, and the existing persistent-array/hash-map/syntax contracts | Transitional and exactly guarded. This is the exact successful whole `buildNormalizationCandidate` equation for AnnotatedPi, including nested Π traversal and dependent list assembly. The four former cached-`Expr` axioms are now proved; their data-layout dependencies remain visible and do not assert semantic normalization. | +| `InductiveReplayFixtures.annotatedPiProducedGenerationCandidatePackage` | exactly the checked semantic set | Transitional and exactly guarded. The record combines AnnotatedPi's exact whole operational result with its semantic-generation owner. As for AliasFormer, the producer equation selects the candidate while the retained semantic hierarchy supplies all Theory meaning; inherited `sorryAx` and platform equations remain release-blocking. | +| `InductiveReplayFixtures.annotatedPiNormalizationCandidateRun`, `annotatedPiGenerationCandidateRun`, `annotatedPiGenerationCandidatePackage`, `annotatedPi_addInductCertified`, `annotatedPiGenerationChecked_wf_checked`, `annotatedPiAddInductTraceChecked`, `annotatedPi_trEnv'_checked` | exactly the preceding checked semantic set | Transitional and exactly guarded. `AnnotatedPi` exercises the complete recursive-Pi annotation path: exact full checks, WHNF, annotation consumption, lazy-delta definitional equality, recursive candidate contexts, generation assembly, the public certified transaction, and final checked replay. The fixture adds no oracle, and the inherited `sorryAx`/platform closure remains release-blocking exactly as for the alias fixtures. | +| `InductiveReplayFixtures.indexedVecNormalizationCandidateProduced` | the exact `IndexedVec` operational set: `propext`, `sorryAx`, `Classical.choice`, `Quot.sound`, the retained Expr/Level/cache equations, and the persistent-array/hash-map/syntax contracts printed at the root | Transitional and exactly guarded. This is the complete one-parameter, one-index, ordered `nil`/`cons` outer producer equation. It selects the exact candidate but supplies no Theory meaning by itself. | +| `InductiveReplayFixtures.indexedVecSemanticProducedGenerationCandidatePackage`, `indexedVecSemantic_trEnv'_checked` | exactly the checked semantic set used by the existing produced-package replays | Transitional and exactly guarded. These roots interpret every family/constructor node at the identity endpoint, assemble the source-indexed generation package, project the proof-erased Theory certificate, and carry that same package through the final E1 replay. The former closedness cache axioms are proved on v4.31; the fixture adds no oracle or axiom, and inherited `sorryAx` and platform contracts remain release-blocking and visible in both exact guards. | +| `InductiveReplayFixtures.annotatedPiFinalEnv_iota_mem` | `propext`, `Quot.sound` | Accepted logical baseline and exactly guarded. Once the checked generation value is supplied, membership of the generated recursive-Pi iota rule in the final Theory environment does not inherit the Verify checker closure. This is the ix-relevant separation to preserve in the general producer/public path. | +| `VEnv.addInduct_success`, `addInduct_checked`, constructor/recursor collision rejection | `propext`, `Classical.choice`, `Quot.sound` | Accepted logical baseline; compile-time guarded. The success certificate carries analyzer evidence rather than postulating it. `Classical.choice` now enters because the transaction's public artifacts are identity-normalization specializations of the mixed generator. | +| `VEnv.addInduct_WF` | `propext`, `Classical.choice`, `Quot.sound` | Accepted logical baseline; compile-time guarded. | +| Recursive-Pi roots (`recTypeRec_isType`, `recConstRec_wf`, `ruleCallRec_hasType`, `minorAppRec_hasType`, `recRuleAppRec_hasType`, `ruleRec_WF`) | `propext`, `Classical.choice`, `Quot.sound` | Accepted logical baseline; every named root has an exact compile-time guard, including the final generalized iota-rule preservation theorem. No custom or Verify axiom reaches the public generalized Theory path. | +| `TrTypeExpr.to_trExprS` | `propext`, `sorryAx`, `Classical.choice`, `Quot.sound` | Transitional only. The helper itself is projection-free, but its `TrExprS` result type reaches the still-sorried `TrProj`; compile-time guarded. | +| `AddInductTrace.to_addInductGeneration`, `AddInduct.to_addInduct`, `AddInduct.le`, `Aligned.addInduct`, `TrEnv'.wf`, `TrEnv'.aligned` | `propext`, `sorryAx`, `Classical.choice`, `Quot.sound` | Transitional only. The Verify trace now proves and its public wrapper existentially exposes the exact normalized Theory transaction. The `sorryAx` is inherited because `TrExprS` has a projection constructor whose relation `TrProj` is still a sorry; P0-P2 must remove it. The stabilized roots are compile-time guarded so any closure change is reviewed. | +| `TrEnv'.of_value` | the preceding set plus `Lean.PersistentHashMap.findAux_isSome`, `Lean.PersistentHashMap.WF.find?_eq`, and `Lean.PersistentHashMap.WF.toList'_insert` | Transitional Verify/platform debt. T2 must prove or narrowly manifest the persistent-map contracts, while P removes `sorryAx`. | +| `InductiveReplayFixtures.nat_trEnv'`, `eq_trEnv'`, `indexedVec_trEnv'`, `acc_trEnv'`, `aliasFormer_trEnv'`, `aliasRec_trEnv'`, their WF/alignment roots, and `seed_after_nat_of_value` | the `TrEnv'` set plus the same three persistent-map contracts | Transitional fixture closure, compile-time guarded. The collection contracts enter while proving freshness for the concrete sequence of `SMap` insertions; the fixtures declare no axiom and must shrink with P/T2. The two aliases add no dependency beyond the existing replay closure despite exercising non-identity normalization. | + +Do not summarize this table as “four acceptable axioms.” A theorem's axiom +set includes dependencies occurring through its statement and inductive +types, not just constants named in its proof body. In particular, E1 can be +locally sorry-free while its exported roots remain transitively sorry-bearing. + +#### Axiom-set decision and release thresholds + +**Decision:** the axiom set of the current inductive **Theory** roots is +reasonable. It contains only the standard Lean logical principles +`propext`, `Classical.choice`, and `Quot.sound` (often a strict subset), and no +axiom asserting facts about the behavior or representation of Lean's +implementation. The axiom set of the current end-to-end **Verify** roots is not +release-acceptable: its `sorryAx` and collection/opaque implementation +contracts are useful diagnostics while proofs migrate, not foundations to +endorse. The checked normalization producer and the candidate-generation +assembler do not change that verdict: their design is reasonable because they +record concrete checker executions, recursively extract exact binder/result +evidence, and derive Theory equality through existing refinement theorems. +Their exact guarded closures still expose the inherited `sorryAx`, +pointer/reflection, translation, and container debt that must be discharged or +isolated before release. The `AnnotatedPi` slice confirms that verdict at the +hardest current annotation seam: retaining only the structural annotation +trace and exact `isDefEq` run is sufficient, while the opaque helper agreement +remains a runtime producer check rather than an assumed theorem. The four +cached-`Expr` properties it exercises are proved on v4.31; their proofs route +through the two already classified data-layout contracts, which remain exactly +guarded and outside the release allowlist. The automatic semantic-input, +produced-hierarchy, and semantic-generation projection roots have exactly the +same checked semantic set as the retained interpreter; their compile-time +guards show no trust growth. Returning the assembled hierarchy under +`Nonempty` is deliberate: it states semantic existence without using choice to +extract a data-bearing checker-selected view. The exact AliasFormer whole-call +proof no longer reaches three separate closedness cache axioms; it reaches +`Expr.mkData_eq` and `Expr.mkAppData_eq` through the new kernel proofs instead. +Those dependencies are exactly guarded and remain transitional layout +contracts. No new axiom or oracle was added. +The certified public path sharpens this separation: its generic Theory +transaction theorems use only the accepted logical baseline, while concrete +AliasFormer/AnnotatedPi/`IndexedVec` certificate values retain the exact +transitional Verify closure that produced their semantic proofs. Proof erasure prevents +that closure from influencing transaction computation, but does not erase it +from the axiom report of a concrete proof-carrying value. The optional +`ProducedGenerationCandidatePackage` adds only an exact executable producer +equation; it grants no semantic authority without the enclosed checked +package. All three concrete certificates and replays intentionally project +from their produced values; their exact guards therefore retain the +fixture-specific closedness/cache equations reached by ordinary checker +execution. The generic Theory `GenerationCertificate` and transaction +theorems retain their smaller accepted logical closure. +This distinction is part of the formalization's specification. + +| Boundary | Allowed during development | Required at its release gate | +|---|---|---| +| Computational `Checked` analysis, normalization shape, and generation | No axiom declaration; evaluation and equality fixtures must compute | Same; no oracle or opaque semantic bridge in acceptance/generation | +| Theory normalization validity, preservation, patterns, projection semantics, and ix-facing Theory API | Any subset of `propext`, `Classical.choice`, `Quot.sound`; exact closure guarded per exported root | Same subset policy; zero `sorryAx`, zero project-specific axiom, and no import path to `Verify/Axioms` or `PtrEq` | +| Verify's mathematical refinement roots | Transitional bridges may remain only when named, classified, and exposed by an exact guard | Standard logical baseline only, unless the theorem is explicitly a platform-refinement theorem rather than a mathematical soundness theorem | +| Version-pinned platform adapter | A narrowly stated candidate contract with an owner, pinned Lean revision, removal issue, and tests | Only reviewed manifest entries; expected upper bound is the two pointer-equality implications and possibly lawful level `BEq`. These must not reach Theory or ix's semantic theorem roots | +| Fixtures and differential tests | May expose transitional dependencies to diagnose their path | They do not justify an axiom; release fixtures must have the closure required by the root they certify | + +Audit computation and proof closure separately. For example, +`normalizationShape`, `checked?`, and `identityChecked?` are executable +definitions with no normalization oracle, while a theorem or dependent value +carrying the proof `normalizationShape source source = true` may report the +standard logical closure used by Lean's generic `BEq` lawfulness proof. That +is acceptable under the Theory threshold; it is not permission to replace the +Boolean test or semantic `Normalization.WF` evidence with an axiom. + +Apply the following rules mechanically: + +1. Treat the accepted logical baseline as a **set upper bound**, not a demand + that every theorem use all three axioms. Keep exact `#guard_msgs` checks for + today's named roots so either growth or unexpected shrinkage receives + review. +2. Reject `sorryAx` from every release root. A proof whose statement reaches a + sorried relation is not release-clean merely because its proof body contains + no `sorry`. +3. Reject every known-false cache equation from every supported root and ban + project-specific axioms from the global simp set. Removing `[simp]` is only + containment; the declaration must still be proved, narrowed, or made + unreachable. +4. Require an explicit design decision before expanding the logical baseline + or platform manifest. Proof difficulty, convenience, or pre-existence in + `Verify/Axioms.lean` is not sufficient justification. +5. Keep ix's `NativeOracle` in ix's own named consumer boundary. It does not + authorize a corresponding lean4lean Theory axiom, an assumed + `InductiveOracle`, or an opaque projection relation. +6. Treat a normalization view as untrusted data until it has both computed + shape coherence and an environment-indexed `Normalization.WF` proof. + Verify must derive that proof from translated checker/defeq behavior, and ix + must derive it from its ordinary Theory typing/defeq world. Neither consumer + may assume a normalization oracle or add a project-specific reduction axiom. + +For the I2 normalization migration, apply that policy to a fixed root set +rather than auditing whichever helper happens to be convenient: + +1. The executable roots `normalizationShape`, `Normalization.check?`, + `generationShape`, and the mixed motive/minor/recursor/rule constructors + must continue to compute without an oracle. Their kernel-equality fixtures + are computational tests, not substitutes for semantic preservation. +2. Guard the component preservation roots + `GenerationEnv.motive_isType`, `minor_isType`, `minorTypes_onTel`, the + completed `recType_isType`/`recursor_wf` pair, `ruleCall_hasType`, + `rule_WF`, `generatedRules_WF`, and the complete generated-rule fold. + Record the exact closure of each; + the permitted set is a subset of + `{propext, Classical.choice, Quot.sound}`, not permission to acquire all + three. +3. Guard the block-level theorem that turns `GenerationChecked.WF` into + well-formed raw constants, a mixed recursor, and mixed rules. Then guard the + normalized `addInduct_success`, lookup/membership/atomicity consequences, + and `addInduct_WF` separately. A clean component proof does not certify a + wrapper whose statement or result type reaches a forbidden axiom. +4. Keep identity-normalization compatibility roots separate from the general + normalization roots. The identity wrapper must reduce to the legacy result; + the general path must consume explicit `Normalization.WF` evidence and may + not infer semantic validity from shape coherence. +5. Before closing the I2 artifact or transaction checkbox, run both the exact + guards and a generated transitive closure report for the public roots. + Reject `sorryAx`, every `Verify/Axioms` or `PtrEq` dependency, and every + project-specific declaration even when it enters only through a theorem's + type. +6. Apply the same audit to the eventual E2 theorem consumed by ix. Its Theory + closure must meet the standard upper bound. Verify's actual-metadata trace + may expose named transitional platform debt during development, but it + cannot be the release proof of the ix-facing semantic theorem until that + debt has been removed or isolated outside the theorem's closure. + +### 2.4 Ix demand surface, re-audited + +Ix has advanced beyond the original “construct the first oracle” framing. +Its E2b milestone now constructs `InductiveOracle` for a staged, closed +singleton-enumeration fragment and its next local critical path is E3-S, +which composes that fragment with the production environment driver. This does +not complete lean4lean's handoff: L4L-11 widens the construction from that +deliberately small fragment to the full safe single/mutual/nested block class +established by L4L-07 through L4L-10B. The fork should strengthen the shared +Theory certificate and lookup/pattern consequences, not duplicate ix's +address, catalog, ingress, or driver proofs. + +The current ix working tree contains about 55,449 lines under +`Ix/Tc/Verify/` and 1,192 root entries across its two audit manifests. It +imports these lean4lean modules: + +```text +Theory.VLevel +Theory.VEnv +Theory.Typing.Env +Theory.Typing.Lemmas +Theory.Typing.Pattern +Verify.Typing.Expr +Verify.Typing.Lemmas +Verify.VLCtx +``` + +The ix obligations and their lean4lean owners are: + +| Ix boundary | Lean4Lean deliverable | +|---|---| +| `InductiveOracle` | full inductive spec/generation, the Theory-only `GenerationCertificate`/`addInductCertified` consumer boundary, environment alignment, lookup/monotonicity lemmas, and block-local pattern facts; ix must construct certificates from its ordinary semantic world rather than import Verify checker state | +| upstream sorry origins `VInductDecl.WF`, `VEnv.addInduct`, `addInduct_WF` | already removed on the fork baseline; publish and pin to shrink ix's audit, then broaden the spec enough to construct the oracle | +| abstract `RawProjRel` + `TrProjOK` | Theory-level projection relation and its lift/inst/WF/uniqueness/transport package | +| `literalWF`/`hlit` assumptions | Theory-level primitive/prelude readiness implies typing of `trLiteral` | +| ix recursor-pattern soundness | generated rules in `SimplePattern.iota` form plus `Params`-shaped soundness and non-overlap facts | +| `forallE_inv_stratified` and `sort_inv` sorry origins | live metatheory track, not permanently deferred | +| `NativeOracle` | remains an explicit consumer oracle; lean4lean documents and proves stability of the `.extra` extension point | + +### 2.5 Retired milestone vocabulary + +The companion's M0-M5 labels and this roadmap's former C0-C8 labels are +historical only. They mixed infrastructure, proof breadth, consumer handoffs, +and release work at incompatible scales, which made “M0 complete” ambiguous. +Section 13's L4L-00 through L4L-20C ladder supersedes both status systems and is +the only source of current milestone status. + +For historical discussion: companion M0/M1 are covered by completed L4L-00; +M2 is decomposed across L4L-01A through L4L-09C; M3 across +L4L-10A/L4L-10B/L4L-11; M4 across L4L-13A through L4L-15C; and M5's +nested/upstream pieces are L4L-09A through L4L-09C and L4L-20C respectively. +The old C0-C8 mapping is recorded after the new +milestone table. None of these legacy names may be used to report current +status. + +
+Archived M0-M5 assessment before the L4L ladder + +| Companion milestone | Archived assessment (superseded) | +|---|---| +| **M0** | Partially complete: upstream remote, token-aware sorry frontier, Nix CI, and a root-level non-ignored divergence ledger exist. The coherent generalized one-family/checked-analysis slice now includes recursive-Pi `Acc`, annotation-complete recursive candidate certification, generic generation-certificate assembly, the proof-carrying public non-identity transaction, three published produced packages, generic parameter/index family validation, exact `IndexedVec` family/`nil`/`cons` candidates, a complete executable outer producer equation, generic exact identity replay, checked `IndexedVec` E1 replay, arbitrary-length source-indexed operational list assembly, generic outer produced-package construction, retained source-indexed semantic ownership, automatic produced semantic-hierarchy assembly under `Nonempty`, semantic-owned generation/package projections, generic derivation of family/constructor view telescopes and terminal typing, exact dependent analyzer provenance, derived normalization identity, reconstructed post-family WF, analyzer-determined raw/view family and constructor alignment, generic raw telescope/result and view-terminal derivation, exact dependent constructor-list reconstruction, and a complete executable generation-readiness gate that derives checked WF plus every per-position shape record when combined with exact analysis and analyzer-owned view WF. At archival, the source checkpoint was `bbb45e0e950724cdbbd405d75e304e2020cecf82`, with tracked ledger child `c4fd62b23a89500154b113d849d183afbf84907f`, on `argumentcomputer/lean4lean`'s `jcb/induct` branch. Constructing the verified semantic inputs and analyzer-owned view WF from one arbitrary verified outer context and its exact traversals, then combining them with the strengthened gate to return a complete produced package, was the immediate M0 boundary. Ix Pin A and full downstream `IxTcVerify`/trust-audit validation are complete at the recorded pair Lean4Lean `5e5bb767b3491d21a71908d4c58bcbaa007283bb` and local ix snapshot `1f73f5c016907eadb8ed0dc86ac65b07eb24a145`; actual platform builds remain assigned to Linux/Darwin CI. | +| **M1** | Complete and exceeded on committed `master`: the vertical slice now covers parameters plus Nat/Bool/List/Prod/Option, with sorry-free `addInduct_WF`. | +| **M2** | In progress: the generalized one-family slice is green for Eq, HEq, an index-changing recursive family, and recursive-Pi `Acc`. Shared `Checked` analysis covers closure, all universe annotations, generated-name uniqueness, family-telescope self-reference, direct result shape, and recursive Pi targets; `Checked.WF env` carries normalized semantic evidence including the Prop impredicativity exception. Generalized artifacts, preservation, public accessors, and the `Acc` transaction agree. Actual alias metadata established the separate raw/view `Normalization` boundary; `NormalizedChecked` packages the raw singleton and checked view, both alias cases have combined semantic certificates, and the complete mixed generator/preservation path feeds a single traced `addInductGeneration` core. Verify's generic run/evidence bridge turns exact checker executions into Theory typing, equality, and `Normalization.WF`. `CandidateExprRun.spineEvidence` extracts raw/view telescopes and terminal results under an explicit stored-spine invariant; `TelResultDefEqEvidence.replacePrefix` transports constructor evidence to the family-emitted parameter prefix; and the dependent `GenerationCandidateRun` assembler produces complete `GenerationChecked.WF` without truncation, forall injectivity, or a selected arbitrary view. Exact checked decomposition, dependent analyzer provenance, and retained semantic evidence now derive view telescopes, terminal typing, normalization identity, post-family WF, raw/view family and constructor alignment, and the complete dependent constructor list. The consolidated executable hierarchy gate additionally derives checked WF and every per-position stored-spine/count record from exact analysis and analyzer-owned view WF; fixtures provide neither class of evidence, and missing/extra constructor regressions pin cardinality. `GenerationCandidatePackage` owns the resulting assembly and erases to the Theory-only `GenerationCertificate` consumed by `addInductCertified`; semantic-owned projections attach exact strengthened whole-call provenance to that same candidate. AliasFormer, the nested recursive-Pi AnnotatedPi, and the parameter/index/two-constructor `IndexedVec` all route their consumers through this boundary, including checked E1 replay. Generic construction of the verified semantic inputs and analyzer-owned view WF from arbitrary verified outer metadata, full environment-relative WHNF/defeq integration, positivity, small elimination, K, mutual/nested blocks, and kernel-complete coverage remain absent. | +| **M3** | In progress: the core Verify `AddInduct` trace retains `GenerationChecked` and its semantic certificate; normalized alignment, monotonicity, `TrEnv'` WF, and environment-history proofs are live. Actual-metadata Nat, Eq, `IndexedVec`, `Acc`, `AliasFormer`, and `AliasRec` replays pin all kernel rule RHSs, final equality, WF/alignment, and lookup uniqueness. The `AnnotatedPi` transaction additionally replays a nonempty recursive-Pi candidate whose raw constructor retains `outParam Prop`, including the generated recursor and iota rule. Generic candidate-spine extraction, exact constructor-prefix replacement, analyzer-determined normalized pairing/order, dependent constructor-list generation assembly, generic raw/view component and terminal derivation, generic view-telescope/result-typing derivation, analyzer-derived normalization alignment, reconstructed post-family WF, candidate-derived `GenerationChecked.WF`, exact outer package construction, automatic produced semantic-hierarchy assembly, retained semantic ownership, and derivation of checked WF plus every per-position shape record from one complete hierarchy gate are live. The generic package fixes generation/WF ownership across the public certified transaction and metadata replay; AliasFormer and AnnotatedPi provide two non-identity exact strengthened-producer instances, and `IndexedVec` provides the parameter/index/two-constructor identity-normalizing instance. Generic construction of the verified semantic inputs and analyzer-owned view WF from an arbitrary verified outer context, the broader I2-I4 replay matrix, and the block-local `Params` package remain absent. | +| **M4** | Not started: `TrProj` and all seven structural laws remain sorries. | +| **M5** | Not started: nested parity and the semantic upstream PR series have not begun. | + +
+ +## 3. Architecture and trust contract + +These are invariants at every milestone. + +1. **Theory points downward only.** `Lean4Lean/Theory/` imports no + `Lean4Lean/Verify/`. Mathematical declarations mention `VExpr`, `VLevel`, + `VEnv`, and proof objects, not `Lean.Expr`, `FVarId`, `ConstMap`, or ix's + `KExpr`/addresses/catalogs. +2. **Consumer-neutral semantics.** No ix namespace, hash, address, cache, or + checker-state type enters lean4lean. Ix-specific transport stays in ix. +3. **Theory-shaped APIs live in Theory.** Move literal encodings, the + VExpr-only local-declaration core, primitive readiness, projection + semantics, and generally useful pattern lemmas down. Leave `Lean.Expr` + translation and `ConstMap` alignment in Verify. Old Verify paths re-export + compatibility names while consumers migrate. +4. **Kernel parity is the adequacy test.** `Inductive/Add.lean` determines + which safe declarations and metadata must be modeled. The Theory generator + must compute its own output; proofs may compare it with the kernel but may + not assume translated recursor shapes as hypotheses. +5. **Staging is monotone and temporary.** Every Stage-N predicate is an + executable, proved subset with rejection fixtures. The final public + contract covers the full safe implementation. Never replace a missing case + with `sorry`, an oracle, or an overstrong premise that real kernel output + cannot satisfy. +6. **Checked analysis and normalization have explicit roles.** The raw + `VInductDecl` is the stored constant payload. `Normalization` supplies a + shape-compatible analysis view, and `Normalization.WF env` justifies that + view by Theory defeq at the kernel's declaration stages. `Checked` is the + environment-independent result computed from the view; `Checked.WF env` + supplies its semantic typing evidence. Do not fold `VEnv`, `Lean.Expr`, or + ix-specific evidence into the computational analyzer, and do not treat a + shape-compatible view as semantically valid without its WF proof. +7. **One accepted source/view pair, one artifact path.** A normalized block + accepted by the public transaction must preserve the raw metadata payload, + use the same checked view for every WHNF-sensitive decision, generate and + preserve one artifact set, expose it through `AddInductSuccess`, and replay + it in Verify. Parallel raw/view or direct/generalized generators are + permitted only as short-lived proof migrations; no checkpoint may accept a + case for which the public accessor returns a weaker or different + recursor/rule set. + The consumer-facing erasure is `GenerationCertificate`: it must couple the + exact generation with its WF proof, and `addInductCertified` must remain + definitionally the same computation as `addInductGeneration`. The proof may + authorize preservation but may not affect generated artifacts or transaction + control flow. +8. **Additive migrations first.** Before changing an existing Theory + signature, grep `ix:Ix/Tc/Verify/` and the upstream Verify layer. Add a new + API and compatibility theorem first, flip ix, then remove the old path. +9. **Classic-module compatibility.** Ix currently uses classic imports because + lean4lean does. Do not introduce `module` headers in reachable files without + a coordinated migration. +10. **Axiom budget is checked per root.** New Theory roots may depend only on + the accepted logical baseline (`propext`, `Classical.choice`, `Quot.sound`, + usually a subset). Verify bridge contracts need a separate, named manifest. + “It was already in `Verify/Axioms.lean`” is not acceptance. +11. **Every fork divergence is tracked.** Create a tracked + `upstream-divergence.md` (or deliberately track `/plans`) with one entry per + semantic/API delta, its ix impact, test, upstream issue/PR, and removal + condition. Empty means fully upstreamed. + +## 4. Dependency spine + +The `S`/`I`/`E`/`L`/`P`/`M`/`V`/`T` labels below are stable work-package +references. They describe proof ownership and preserve detailed checklists; +they do **not** carry milestone status. Section 13 is the only execution order +and the only place where a milestone may be `queued`, `active`, or `complete`. +There is no `partially complete` milestone state: useful prerequisites for a +future milestone remain recorded in their track, but that milestone stays +queued until every exit condition passes. + +The primary execution order is deliberately serial. Letter suffixes are real +milestones, not subitems that may be completed as a batch: + +```text +published baseline + -> staged singleton semantic inputs + -> family-validation semantics and post-family staging + -> constructor-validation trace and semantics + -> generic singleton package closure + -> isolated level proof + -> singleton validation/normalization/positivity/elimination closure + -> mutual representation, validation, then generation/replay + -> nested representation, transformation, then generation/replay + -> generated-pattern core, then environment assembler + -> ix inductive-oracle handoff + -> Theory local-declaration surface, then literal/prelude readiness + -> projection API decision, semantics, and laws + -> projection checker, eta, and import closure + -> metatheory route selection and sort inversion + -> remaining injectivity and weakening inversion + -> Church-Rosser proof, then extension contract + -> recursor reduction, environment/checker closure, and zero-sorry gate + -> axiom retirement, differential corpus, and upstream release +``` + +No later milestone begins until the active one is complete. Read-only design +reconnaissance for a later milestone is allowed when it changes the active +design, but implementation and publication stay serial. This prevents several +half-migrated public artifact paths from being live simultaneously and gives +each checkpoint one auditable claim. Projection semantics intentionally waits +for the full inductive/structure descriptor even though preliminary design +work could be done earlier. + +## 5. Track S — stabilize and publish the work already done + +### S0 — make the active indexed port green (completed by L4L-00) + +- **Status: complete in the development branch on 2026-07-30.** The exact Theory and + Verify build gate passes; keep the following as the regression checklist. +- [x] Finish the `Stage2Env` to `Stage3Env` conversion from line ~2000 onward in + `InductiveLemmas.lean`. +- [x] Update every old helper application to the indexed signatures: motives now + take `ty`, minors take both `ty` and constructor lists, recursive positions + carry index spines, and result typing consumes `SpineWF`. +- [x] Reprove the recursor type, recursor constant, constructor fold, iota LHS/RHS, + rule WF, and final `addInduct_WF` in that order. Do not patch from the bottom; + each generated component should have a named typing lemma used by the next. +- [x] Rename residual Stage-2 declarations/comments only after the proof compiles, + to keep review mechanical. +- [x] Restore an executable `#print axioms`/`#guard_msgs` check for + `VEnv.addInduct_WF`; it currently accepts exactly `propext`, + `Classical.choice`, and `Quot.sound`. +- [x] Finish the exact gates in §13. The sorry audit, + `lake build Lean4Lean.Theory Lean4Lean.Verify`, formatter check, and + `nix flake check --accept-flake-config --print-build-logs` all pass. A + successful default `nix build` alone remains insufficient. + +### S1 — publish safe checkpoints (ongoing gate; baseline in L4L-00) + +- [x] Publish the coherent Stage-3/I1/E1/bounded-I2 checkpoint after rerunning + the full gate. Revision `472a6f0417e574aaf277fc0150284d0b733aec3a` + is published on `argumentcomputer/lean4lean` after the sorry-frontier, + Theory/Verify build, formatter, diff, and Nix-build gates passed. Generalized + recursive-Pi preservation, the public artifact switch, `Acc` transaction and + replay, the additive paired normalization boundary/alias certificates, + and exact axiom guards are green. At that checkpoint, the broader + cross-system evaluation gate in §13 was still outstanding. The public transaction + remains the coherent raw-normal-form subset; do not checkpoint midway + through the later raw/view artifact or transaction switch. Keep + `efb2a2b2` as the recoverable Stage-2 checkpoint and never publish an + intermediate red or semantically split state. +- [x] Publish the candidate-context-provenance checkpoint after the same local + source and default-Nix gates. Revision + `1fb7d6ef9042c5a80b2de9320c88ac0f3ce404cb` context/source-indexes every + recursive candidate trace, derives checker-output translations from verified + executions, and transports alias-valued inferred types to structural Pi + sorts without adding an axiom. It remains the fixed `master` baseline; at + that checkpoint, the broader cross-system evaluation gate was outstanding. +- [x] Publish the recursive-normalization-candidates checkpoint only on + `argumentcomputer/lean4lean`'s `jcb/induct` branch. Revision + `9fde4c6b6c34cdb5b7c71aebfff25ac75a269a56` constructs exact verified root + and Pi-binder contexts, proves binder freshness and empty-state name + reservation, recovers the root Theory translation from the retained full + check, and recursively certifies raw-domain traces. The actual AliasFormer + metadata exercises the automatic-root path, and every new semantic root has + an exact axiom guard. The exact sorry-frontier, full Theory/Verify build, + formatter, diff, Theory import-boundary, and default-Nix gates passed on + 2026-07-31. `master`, `origin/master`, and the digama upstream were not + moved; the cross-system evaluation gate was then outstanding. +- [x] Publish the annotated-normalization-binders checkpoint only on + `argumentcomputer/lean4lean`'s `jcb/induct` branch. Revision + `b2839120ee3c743fd621154096346c7319141f14` preserves raw annotation syntax, + structurally certifies all four `consumeTypeAnnotations` paths, retains an + exact successful ordinary-checker equality run, refines it to Theory + equality, and transports recursive body evidence across the raw, consumed, + and normalized binder contexts. The former raw-domain restriction is gone; + fixtures cover all four positive gadgets and one exact non-defeq rejection. + The exact sorry-frontier, full Theory/Verify build, formatter, diff, Theory + import-boundary, fixture-target, and default-Nix gates passed on 2026-07-31. + `master`, `origin/master`, and the digama upstream were not moved; the + cross-system evaluation gate was then outstanding. +- [x] Publish the singleton-normalization-candidates checkpoint only on + `argumentcomputer/lean4lean`'s `jcb/induct` branch. Revision + `a84aa19c3e243f9b35bd5baa988c16a0cce39093` adds exact root endpoint + certificates, source-indexed constructor-list runs, and a singleton family + assembler that constructs Theory `Normalization` and `NormalizationRun` + without `head!`, unchecked `zip`, or a caller-selected unrelated view. + AliasFormer's real pre-family and post-family candidate positions now drive + its live normalization, dependent checked analysis still succeeds, and a + truncated constructor view is rejected before transaction construction. + The exact 20-entry sorry frontier, full Theory/Verify build, formatter, diff, + Theory import-boundary, fixture-target, and default-Nix gates passed on + 2026-07-31. `master`, `origin/master`, and the digama upstream were not + moved; the cross-system evaluation gate was then outstanding. +- [x] Publish the candidate-generation-certificates checkpoint only on + `argumentcomputer/lean4lean`'s `jcb/induct` branch. Revision + `c2b1c4fb5f0f992391301c1486e076f13a3af1b3` extracts the exact raw/view + telescope and terminal-result evidence from stored-spine candidate runs, + transports declared constructor parameter prefixes to the emitted family + prefix in exact induced contexts, folds a dependent source-indexed + constructor list, and assembles generic `GenerationChecked.WF`. + AliasFormer's real non-identity family/constructor candidates now supply its + existing checked end-to-end transaction through this generic assembler. + The exact 20-entry sorry frontier, full Theory/Verify build, formatter, diff, + Theory import-boundary, fixture target, exact axiom guards, and default + `nix build` gate passed on 2026-07-31. `master`, `origin/master`, and the + digama upstream were not moved; the cross-system evaluation gate was then + outstanding. +- [x] Publish the annotated recursive-Pi replay checkpoint only on + `argumentcomputer/lean4lean`'s `jcb/induct` branch. Revision + `a1d8943a7b831b050fb8bc0689db2a186850a7f1` adds + `AnnotatedPi.mk : ((p : outParam Prop) → AnnotatedPi) → AnnotatedPi`, proves + the exact ordinary-checker full-check, WHNF, and complete lazy-delta + raw-to-consumed equality traces, recursively certifies the nested candidate, + and assembles `NormalizationCandidateRun`, `GenerationCandidateRun`, and + `GenerationChecked.WF`. Its checked `AddInductTrace`/`TrEnv'` replay pins the + final environment, generated recursor, and iota rule while retaining raw + annotation syntax. The annotation producer's opaque-helper agreement is + recorded as runtime validation rather than a semantic proof field; no new + axiom, oracle, native evaluator, or opaque equation was added. Six exact + root guards pin the inherited transitional Verify closure and the smaller + `[propext, Quot.sound]` iota-membership closure. The exact 20-entry sorry + frontier, full Theory/Verify build, formatter, diff, Theory import boundary, + fixture target, and default `nix build` gate passed on 2026-08-01. `master`, + `origin/master`, and the digama upstream were not moved; the cross-system + evaluation gate was then outstanding. +- [x] Publish the certified non-identity consumer checkpoint only on + `argumentcomputer/lean4lean`'s `jcb/induct` branch at + `6a7788245831b24ae690cfb83659e892c2065be8`. The complete local gate, + including the current-host full flake checks, is green, and remote-ref + verification confirms only `origin/jcb/induct` moved. + This checkpoint adds the Theory `GenerationCertificate` and + `addInductCertified` API, its trace/atomic/WF theorems, the dependent Verify + candidate package and checked replay constructor, the AliasFormer and + AnnotatedPi public transaction fixtures, and the opaque-`outParam` + whole-candidate rejection. Exact guards demonstrate the clean generic + Theory closure and the retained concrete Verify closures. `master`, + `origin/master`, and every digama/upstream ref remain unchanged. +- [x] Publish the executable-candidate producer checkpoint only on + `argumentcomputer/lean4lean`'s `jcb/induct` branch at + `bc37d436dfd6f7d6fa1ae186c0951e48677b931f`. AliasFormer now proves the + exact successful `buildNormalizationCandidate` equation across family + validation, raw-family insertion, constructor validation, and dependent + candidate-list assembly. The resulting + `ProducedGenerationCandidatePackage` supplies both its proof-erased Theory + certificate and checked Verify replay. The exact 20-entry sorry frontier, + focused and full Theory/Verify builds, formatter, diff and import-boundary + audits, default `nix build`, and all six current-host flake checks passed on + 2026-08-01. Exact guards record the three existing expression-cache + contracts added by the outer execution proof. `master`, `origin/master`, and + every digama/upstream ref remain unchanged; `--all-systems` was still the + pre-ix/release gate at this checkpoint. +- [x] Publish the AnnotatedPi outer-validation checkpoint only on + `argumentcomputer/lean4lean`'s `jcb/induct` branch at + `5e5bb767b3491d21a71908d4c58bcbaa007283bb`. The recursive occurrence test is + now transparent and structural, and the fixture proves exact family + validation, freshness, recursion detection, raw-family declaration, and + recursive inner-Π `inferType`/`ensureType` execution. This is progress toward, + not completion of, AnnotatedPi's whole-call produced package. The same commit + restores CI all-system evaluation by replacing the nested unrealized + `fileset.toSource` with `inputs.self.outPath`; the narrower source filter is a + follow-up optimization. The 119-target source build, exact 20-sorry audit, + current-host full flake check, and exact + `nix flake check --all-systems --no-build --accept-flake-config` gate pass. + `master`, `origin/master`, and every digama/upstream ref remain unchanged. +- [x] Publish exact AnnotatedPi constructor validation and positivity on + `argumentcomputer/lean4lean`'s `jcb/induct` branch at + `33b99f4e462eaa02b78aba061dcac37bd64d84c4`. The checkpoint validates the + complete annotated recursive-Π constructor in the real post-family + environment and keeps both master refs and digama/upstream unchanged. +- [x] Complete AnnotatedPi's exact recursive candidate traversal, dependent + family/constructor list assembly, successful whole + `buildNormalizationCandidate` equation, and + `ProducedGenerationCandidatePackage`; published only on `jcb/induct` at + `a3ff9921cc7ef23ebbc808b4dcbab6a119378507` after the full Lean/Nix + checkpoint gate. +- [x] Publish generic singleton family validation through arbitrary + parameter/index candidate spines only on `argumentcomputer/lean4lean`'s + `jcb/induct` branch at + `9a865ea02d4326e60d0e5fd663d6efe79c735b1c`. The candidate trace now exposes + its root WHNF, terminal context/result, positional parameter locals, index + count, and exact emitted `InductiveStats`; the executable + `checkInductiveTypes` loop is replayed from these source-indexed facts rather + than a zero-parameter fixture theorem. Exact core axiom guards remain within + the permitted logical baseline. +- [x] Publish the first real parameter/index family instance only on + `argumentcomputer/lean4lean`'s `jcb/induct` branch at + `a62736281ea419d7d0ee13d76f0e0fd9a4d9d90f`. The new + `IndexedVecCandidate` module proves exact full-check, WHNF, fresh-local, + reflexive domain-equality, recursive candidate, and complete family-validator + executions for `IndexedVec.{u} (α : Type u) : Nat → Type u`, including the + computed parameter/index statistics. The focused module build, 120-job full + Theory/Verify build, exact 20-sorry audit, formatter/diff gates, default Nix + build, and all six current-host flake checks pass on 2026-08-02. Exact guards + record the existing Verify implementation contracts and inherited `sorryAx`; + no axiom was declared. `master`, `origin/master`, and every digama/upstream + ref remain unchanged. The ordered `nil`/`cons` package is deliberately the + next checkpoint, not part of this claim. +- [x] Publish the verified syntactic-equivalence fast path only on + `argumentcomputer/lean4lean`'s `jcb/induct` branch at + `f0d80f8ba21e44a694566ea3d6469be85a809307`. Reflexive `isDefEq` calls now + return before `isDefEqCore` and preserve the incoming checker state; + `TypeChecker.Inner.isDefEq.WF` proves soundness by transporting the strict + translation across `Expr.eqv`. Exact AnnotatedPi, AliasRec, and IndexedVec + fixtures were updated and their obsolete equivalence-manager simulations + removed. The exact 20-sorry audit, focused and 120-job full Lean builds, + formatter/diff/import-boundary gates, default Nix build, all-system flake + evaluation, and all six current-host flake checks pass on 2026-08-02. No + axiom was added; `master`, `origin/master`, and every digama/upstream ref + remain unchanged. +- [x] Publish the `IndexedVec` constructor and outer-producer series only on + `argumentcomputer/lean4lean`'s `jcb/induct` branch. Revisions `67326590` and + `c40a471d` certify `nil` and the dependent recursive `cons` candidate in the + exact post-family environment; `c739d412` stabilizes candidate-context + provenance; and `82f4a54c` proves the complete one-parameter, one-index, + ordered two-constructor `buildNormalizationCandidate` result. Revision + `d553930a` adds generic exact identity replay at caller-selected Theory + endpoints. At that checkpoint local, Git, and `origin/jcb/induct` agreed at + `d553930a`; both master refs and every digama/upstream ref remained unchanged. +- [x] Complete the `IndexedVec` semantic package from that exact executable + result and publish it at `cf3d5a47d35867e0e6ebe023c0803982e3e36cd1`. + Recursive identity for the family, `nil`, + and `cons` supplies the family/constructor `GenerationCandidateRun`; the + resulting `ProducedGenerationCandidatePackage` drives both the certified + Theory transaction and checked E1 replay. Exact guards pin the public package + and `TrEnv'` roots to the existing transitional Verify closure. +- [x] Run formatter/diff/import-boundary gates, describe, and publish the + `IndexedVec` semantic replay checkpoint without moving either master or any + digama/upstream ref. The semantic commit is `cf3d5a47`; local, Git, and + `origin/jcb/induct` agree at its ledger-only follow-up `d35a2f6c`. +- [x] Generalize exact executable list assembly and publish it only on + `argumentcomputer/lean4lean`'s `jcb/induct` branch. Commit + `c9e4ae2d26f28e0adb0c21ffde0e11b42bb691c2` adds arbitrary-length dependent + family-type, constructor, and complete-family `Produced` witnesses, routes + AliasFormer and AnnotatedPi through the singleton instances, and routes + `IndexedVec` through the ordered two-constructor instance. The three generic + `.normalize` theorems are guarded at exactly + `[propext, Classical.choice, Quot.sound]`. Focused and full Lake builds, the + exact 20-sorry audit, all Nix gates, formatter, diff, and import-boundary + checks pass. Local, Git, and `origin/jcb/induct` agree at ledger child + `9ff6be1cac7a3b604b1209d11e0380a858d49574`; neither master nor any + digama/upstream ref moved. +- [x] Generalize the outer produced-package construction and publish it only on + `argumentcomputer/lean4lean`'s `jcb/induct` branch. Commit + `a7d101b5e16f1258c6f5c2a7ea08e55f45eb17f1` adds + `GenerationCandidateRun.producedPackage`, requires one exact + source/candidate-indexed semantic run plus the matching whole-call producer + equation, and migrates AliasFormer, AnnotatedPi, and `IndexedVec`. Its exact + inherited `[propext, sorryAx, Classical.choice, Quot.sound]` closure is + guarded. Focused and full Lake builds, the exact 20-sorry audit, all Nix + gates, formatter, diff, and import-boundary checks pass. Local, Git, and + `origin/jcb/induct` agree at ledger child + `80f9dce41d0798bbb38d41c5abf9a21e25f74bc1`; neither master nor any + digama/upstream ref moved. +- [x] Retain one source-indexed semantic hierarchy for normalization and + generation and publish it only on `argumentcomputer/lean4lean`'s + `jcb/induct` branch. Commit + `f0caf16c5788d094fdbf1e990884c0c061d6fc75` adds + `CandidateExprSemanticRootRun`, its automatic existential root constructor, + and dependent constructor-list/family/singleton-normalization ownership; + AliasFormer, AnnotatedPi, and `IndexedVec` all project their existing + normalization and generation evidence from it. Focused and full Lake builds, + the exact sorry-frontier check, default Nix build, all six current-host flake + checks, whitespace checks, and a direct axiom audit pass. Local, Git, and + `origin/jcb/induct` agree at ledger child + `ea14f31ee172bef30b94c8b5f111bc109965f00d`; neither master nor any + digama/upstream ref moved. +- [x] Assemble the produced semantic hierarchy and publish it only on + `argumentcomputer/lean4lean`'s `jcb/induct` branch. Commit + `e3cf22d293b081ba11be63e910d0d1e1510a042f` adds + `CandidateExprSemanticRootInput`, dependent constructor/family/normalization + inputs, and `NormalizationCandidateSemanticInput.exists_ofProduced`. + Together they pair the arbitrary-length operational list witnesses with the + exact verified contexts and strict translations at the same source-indexed + candidate and return `Nonempty ProducedNormalizationCandidateSemanticRun`. + The retained checker selects each Theory view; the operational result does + not. Semantic-owned family/constructor generation structures and their + compatibility/package projections remove parallel roots and spines. + AliasFormer and `IndexedVec` exercise the complete path. Neither master nor + any digama/upstream ref moved. +- [x] Harden semantic ownership and publish it only on + `argumentcomputer/lean4lean`'s `jcb/induct` branch. Commit + `7e5f4f7715cf71be8d09a583f0ec0d8f7aa02e72` migrates AnnotatedPi's remaining + hierarchy and generation/package path, adds exact compile-time guards for + the generic semantic inputs and projections plus all three fixture roots, + proves automatic `IndexedVec` hierarchy assembly retains `nil`/`cons` order, + and rejects the swapped view at `normalization?`. The exact 20-sorry audit, + focused 118-job semantic replay, 157-job default Lake build, 124-job Nix + proof build, default Nix build, all six current-host flake checks, all-system + no-build evaluation, formatter, diff, and Theory import-boundary checks pass. + Local, Git, and `origin/jcb/induct` agree at ledger child + `1093311b9c4e74f3d1750676429acc5d112724fa`; neither master nor any + digama/upstream ref moved. +- [x] Derive structural generation evidence and publish it only on + `argumentcomputer/lean4lean`'s `jcb/induct` branch. Commit + `2b1d802fc6796e7317ec1d24708a3ebdda416655` adds exact checked + family/constructor shape theorems, derives the family terminal sort and every + constructor result-target typing judgment, recovers view telescopes from + exact non-forall terminals, and removes fixture-owned `viewTel`/`rightType` + fields across AliasFormer, AnnotatedPi, and `IndexedVec`. The exact 20-sorry + audit, focused direct compiles, 124-job Theory/Verify build, 157-job default + Lake build, 124-job Nix proof check, default Nix build, all six current-host + flake checks, all-system no-build evaluation, formatter, diff, and Theory + import-boundary checks pass. Local, Git, and `origin/jcb/induct` agree at + tracked ledger child `0270843dccd2e0599a48b40aa31d4fe6eb8c94af`; + neither master nor any digama/upstream ref moved. +- [x] Derive generation analyzer provenance and publish it only on + `argumentcomputer/lean4lean`'s `jcb/induct` branch. Commit + `a64fe982bc2a7f1c6c34ec82565ec5fe1c26350b` replaces each semantic + generation fixture's bare normalization equality with the exact successful + dependent `generation?` equation. Theory derives the retained normalization + from successful `check?`/`generation?`; Verify reconstructs post-family + environment WF from retained semantic evidence and exact raw-family + insertion. AliasFormer, AnnotatedPi, and `IndexedVec` now omit both + `normalization_eq` and `typeEnv_wf`. Exact guards pin the two Theory roots and + two Verify derivations. The exact 20-sorry audit, focused direct compiles, + 124-job Theory/Verify build, 157-job default Lake build, default Nix build, + all six current-host flake checks, all-system no-build evaluation, formatter, + diff, and Theory import-boundary checks pass. Local, Git, and + `origin/jcb/induct` agree at tracked ledger child + `4b66e50e3df95baab3f93a97867c4e31dc6ed21d`; + neither master nor any digama/upstream ref moved. +- [x] Derive generation shape alignment and publish it only on + `argumentcomputer/lean4lean`'s `jcb/induct` branch. Commit + `5aa9ab69fce1c7dab3f4ca357f6ed8f349fd9397` introduces the reduced + `GenerationCandidateSemanticShapeRun` boundary. Exact dependent analysis + determines raw/check family identity, normalized constructor pairing and + source order, while total stored-spine counts determine raw + telescope/results and exact checked shape determines view terminals. The + dependent recursive assembler reconstructs the full constructor run list + without caller-selected pairs, `zip`, truncation, or reordering. AliasFormer, + AnnotatedPi, and the two-constructor `IndexedVec` fixture now provide no + component equations or normalized-pair alignment. Exact guards pin both + singleton alignment roots to the small inherited Verify set and the public + shape projection to the unchanged checked semantic set. The exact 20-sorry + audit, focused direct compiles, 124-job Theory/Verify build, 157-job default + Lake build, default Nix build, all six current-host flake checks, all-system + no-build evaluation, formatter, diff, whitespace, and Theory import-boundary + checks pass. Local, Git, and `origin/jcb/induct` agree at tracked ledger child + `fda0016632e3b64d14e0628dbccd230338c531c0`; neither master nor any + digama/upstream ref moved. +- [x] Consolidate generation readiness and publish it only on + `argumentcomputer/lean4lean`'s `jcb/induct` branch. Commit + `bbb45e0e950724cdbbd405d75e304e2020cecf82` adds one executable Boolean gate + over the full singleton family/constructor hierarchy and couples its success + to the exact ordinary producer equation in + `ProducedGenerationShapeCandidate`. The gate checks emitted-spine + preservation, full raw telescope lengths, and constructor-list cardinality; + the `IndexedVec` regressions reject both missing and extra raw constructors. + Exact dependent analysis and WF of the analyzer-owned view declaration + derive checked WF and every source-indexed family/constructor shape record. + AliasFormer, AnnotatedPi, and `IndexedVec` now supply neither checked WF nor + per-position generation-shape structures. Bare producer success remains + operational provenance only and is not promoted to Theory meaning or + stored-spine authority. Exact guards pin the pure executable roots to + `propext`/`Classical.choice`/`Quot.sound`; semantic package roots inherit only + the existing checked-semantic closure. The exact 20-sorry audit, focused + direct compiles, 124-job Theory/Verify build, 157-job default Lake build, + 124-job Nix proof check, default Nix build, all six current-host flake checks, + all-system no-build evaluation, formatter, whitespace, and Theory + import-boundary checks pass. The tracked ledger child is + `c4fd62b23a89500154b113d849d183afbf84907f`; neither master nor any + digama/upstream ref moved. +- [x] Update the sorry-frontier comments to describe the current Stage-3 + generalized one-family proof. +- [x] Create the root-level, non-ignored divergence ledger and record the + current development delta from upstream `0c38ab8`; the tracked ledger is now + refreshed against source parent `bbb45e0e` for this checkpoint. +- [x] Run ix Pin A against a green certificate-bearing `jcb/induct` checkpoint, + build the complete `IxTcVerify` target, and reconcile its audits. The local ix + `jcb/ix-formalization2` snapshot + `1f73f5c016907eadb8ed0dc86ac65b07eb24a145` pins Lean4Lean + `5e5bb767b3491d21a71908d4c58bcbaa007283bb`; the exact local sorry frontier and + completed/statement root audits pass, and the former `VInductDecl.WF`, + `VEnv.addInduct`, and `VEnv.addInduct_WF` direct `sorryAx` origins are gone. + The full `InductiveOracle` handoff remains L4L-11, after the + L4L-08A–L4L-09C breadth and L4L-10A/L4L-10B pattern package. + +## 6. Track I — kernel-complete inductives + +The present generalized one-family generator is a valuable vertical slice, +not the final data model. The shared checked analysis and semantic layer now +exist: +`VInductDecl.Checked` exposes normalized type/index telescopes, result sort, +recursive-argument descriptions, elimination mode, names, constructors, +motives, minors, recursor, and generated rules. `checked?`, `stage3`, +`addInduct`, the preservation proof, fixtures, and Verify alignment all consume +that result, while `Checked.WF env` gives the normalized data its +environment-relative meaning. Extend these contracts monotonically as I2-I4 +add cases; do not reintroduce parallel Boolean analyses or downstream de +Bruijn reconstruction. The alias audit adds a second invariant: raw kernel +metadata and normalized analysis syntax are distinct objects. +`NormalizedChecked` is now the one-family data boundary joining those objects +and, through `Checked.identityGeneration`, the public identity artifact input. +It is not passed directly to the general transaction: a +`GenerationCertificate` erases the normalized/checker provenance to the exact +`GenerationChecked` value plus its semantic WF proof, and +`addInductCertified` consumes that Theory-only boundary. Preserve raw constant +payloads and generated binder syntax while using the semantically justified +view for WHNF-sensitive classification. Do not silently overwrite one with the +other or let each consumer choose its own normalization. + +### I1 — finish direct indexed families (completed by L4L-00) + +- [x] Complete S0 for one type with parameters, indices, direct recursive fields, + never-zero or syntactically subsingleton elimination, and generated Eq/HEq + recursors. +- [x] Add `addInduct_le`, generated-constant lookup lemmas, generated-rule + membership lemmas, name-freshness consequences, and failure/atomicity lemmas. + Ix's oracle needs these consequences directly; it should not unfold a large + `foldlM` proof. These are exposed through `VEnv.AddInductSuccess` and + convenience theorems, with a dedicated axiom-closure guard. +- [x] Add `IndexedVec` as a nontrivial indexed fixture whose recursive + occurrence changes indices; compare its recursor and both iota rules exactly + with the kernel. + +### I2 — complete one-family kernel behavior (L4L-01A–L4L-07) + +**Status: the direct-indexed and bounded recursive-Pi slices are green through +checked analysis, generalized artifacts, preservation, the public transaction, +and actual-metadata E1 replay. The normalization/defeq representation decision +is made; the paired raw/view checked-block data boundary, structural +projections, identity compatibility, and first semantic block fixtures are +green. The raw-syntax-preserving mixed artifact implementation matches the +identity and two alias kernels and is proved well formed through the complete +ordered rule fold. All live `Checked` artifact accessors are now canonical +identity specializations of that mixed implementation, with exact generic and +Nat/Eq/`IndexedVec`/`Acc` compatibility checks. The normalized Theory +transaction core, trace consequences, atomicity, and preservation theorem are +now green, as are the public semantic delegation and direct alias +transactions, normalized Verify trace, six actual-metadata replays, and first +checked full-check/WHNF-to-Theory producer. Both fixed alias cases now have +complete checked `GenerationChecked.WF` roots and checked end-to-end +`AddInductTrace`/`TrEnv'` replays. The complete `AnnotatedPi` candidate adds a +nested recursive-Pi annotation normalization/generation/replay path, including +the generated recursor and iota rule. A dependent Verify package and +proof-erased Theory certificate now provide public non-identity transaction +wiring for both AliasFormer and AnnotatedPi. `IndexedVec` now extends exact +outer execution to a parameter, an index, and two ordered constructors, and +the identity-replay bridge needed for its semantic spine is live. Published +checkpoint `cf3d5a47` completes its producer-selected semantic package, +certified Theory transaction, and checked E1 replay. One-family parity is not +complete because +generic arbitrary-constructor construction remains, alongside full positivity, small +elimination, K behavior, and the full differential matrix.** +The following order mirrors `Inductive/Add.lean` and keeps each widening +executable and proved: + +- [x] Introduce dependent `VInductDecl.Checked`/`checked?` and make descriptor + existence the public acceptance result. Route recursor/rule generation, + `VEnv.addInduct`, `addInduct_success`, `addInduct_WF`, Theory fixtures, and + Verify's `AddInductTrace` through the same checked value. +- [x] Record normalized parameters, indices, result level, elimination mode, + generated names, constructor fields, and recursive positions/index spines. + `RecArg.binders` is now populated for recursive Pi fields; retain + `targetType` so I3 mutual recursion does not force a second consumer-facing + redesign. +- [x] Check closed family/constructor metadata and internal generated-name + uniqueness computationally. Export proof-level closure/`Nodup` consequences, + add positive Nat/Eq/`IndexedVec` descriptor fixtures, and add duplicate-name + and loose-variable rejection fixtures. Keep environment-relative freshness + in the `addConst` transaction. Type-, constructor-, and recursor-collision + regressions now exercise stable rejection theorems rather than depending on + the internal fold order. +- [x] Finish the environment-independent, VExpr-normal-form portion of + `checkInductiveTypes`: declaration/type/constructor universe counts, + parameter count, raw parameter/index telescopes, sort result and result-level + well-formedness, range validity of every universe annotation, prohibition of + family self-reference in parameter/index domains, constructor parameter + spine, and direct result family/head/arity. Export the combined facts through + `Checked.analysis_accepted` and `Checked.direct_anatomy`; cover every branch + with the malformed-result/universe/telescope fixture matrix. +- [x] Add `Checked.WF env` for the environment-relative `OnTel`, constructor + field, universe-bound, and result-spine obligations. Prove both migration + directions and `decl.WF env ↔ ∃ checked, decl.checked? = some checked ∧ + checked.WF env`; make `addInduct_WF` consume this certificate. Guard all + three compatibility roots at exactly `propext` and `Quot.sound`. +- [x] Implement the one-family raw-VExpr counterparts of `isValidIndApp?` and + `isRecArg` beneath Pi telescopes. `recTarget?` requires family-free domains, + accepts only a terminal application of the current family to the declaration + parameters and family-free indices, and populates the complete binder + telescope. Computed `Acc` facts pin its field index, two binders, target type, + and terminal index spine. Exact kernel-differential fixtures cover a family + in a recursive-Pi domain, a changed fixed parameter at the recursive target, + and a family occurrence inside the recursive target's index; each also + reduces through public `checked?`/`addInduct` rejection. This is + raw-normal-form parity only; the later normalization task still owns + WHNF/defeq parity. +- [x] Define the generalized artifacts as a reviewable migration step: + `minorIH`/`minorTypeRec`, `recTypeRec`/`recConstRec`, `ruleBinders`, + `ruleCall`/`ruleIH`, and `ruleRec`/`rulesRec`. Exact fixtures prove by + reduction that the generalized constant and rule are `Acc.rec` and its + functional iota RHS (modulo the kernel universe permutation). +- [x] Finish generalized preservation. The proof now covers semantic + `RecArg.WF`, universe transport, binder/index typing, generalized minor and + recursor well-formedness, rule-binder/rule-type typing, recursive-field + application, normalization of lifted `minorIH` entries to `ruleIH`, + list-level application of every functional recursive call, + `minorAppRec_hasType`, `recRuleAppRec_hasType`, `ruleRec_WF`, and the + generalized rule fold. Exact guards keep all six exported recursive-Pi roots + at the standard Theory axiom baseline. +- [x] Collapse the migration to one public path. Make + `Checked.minorTypes`/`recursor`/`generatedRules`, `VEnv.addInduct`, + `AddInductSuccess`, and `addInduct_WF` consume the generalized artifacts. + The direct definitions remain only as specialization/reference code and are + not semantically live through a public accessor. Completion is gated by + exact public `accDecl.checked?`, `addInduct`, generated lookup/rule + membership, `Ordered`, and failure-atomicity fixtures. +- [x] Replay `Acc` through E1 using Lean's actual `inductInfo`, `ctorInfo`, and + `recInfo`; compare recursive-argument metadata, recursor universe order, and + the lambda-wrapped rule RHS. The replay proves exact transaction equality, + lookup uniqueness, final WF/alignment, and definitional equality between the + actual kernel `RecursorRule.rhs` and `ruleRec`. Generic `TrEnv'.of_value` + supplies preservation of older values for this transaction class; the + seed-before-Nat fixture exercises the same persistent-map path concretely + without duplicating it for every family. +- [x] Resolve the normalization representation decision empirically. Actual + Lean metadata is not already in analyzer normal form: `AliasFormer` retains + a reducible alias where the checker sees a result sort, and `AliasRec.mk` + retains a reducible application where positivity sees a recursive target. + Keep the raw declaration as the stored/source object and introduce a named + `Normalization source` carrying a shape-compatible analysis view. + `normalizationShape` already fixes all identities, arities, ordering, and + counts, and `Normalization.checked?` keeps analysis computational and + environment-independent. +- [x] Give the first one-family normalization witnesses semantic meaning. + `Normalization.WF env` compares the raw/view family types in the input + environment and compares constructor types pairwise after insertion of the + raw family constant. The family-result and recursive-field alias fixtures + construct those defeq derivations explicitly; both exact axiom guards are + `[propext, Quot.sound]`. This proves the boundary is compatible with Theory, + but not yet that every checker-produced normalization can be reconstructed + or that generated artifacts preserve the kernel's raw syntax. +- [x] Introduce one paired, data-bearing checked block. + `NormalizedChecked source` contains the normalization, the raw singleton + `sourceType` and source equation, `norm.view.Checked`, and its exact computed + analyzer equation. `Normalization.check?` constructs it without repeating + analysis; `normalizedChecked?` checks an explicit pair; `identityChecked?` + is the compatibility path. `Normalization.shape`, + `NormalizedChecked.source_anatomy`, `uvars_eq`, and `nparams_eq` expose + source/view arities and ordered family/constructor header agreement. + Identity Nat and both alias fixtures compute, and the alias blocks have + complete `NormalizedChecked.WF` certificates. Generic structural roots and + concrete semantic roots have exact axiom guards. At that checkpoint this + completed only the additive data boundary; the now-completed artifact + refactor below added constructor-by-constructor pairing of raw field + telescopes with normalized recursive-target/binder/index facts. + Whole-expression defeq plus matching names is not, by itself, enough to + recover raw binder positions. +- [x] Refactor artifact generation around that paired block before changing + acceptance. Family and constructor constants must be inserted with the raw + metadata payloads; recursor/minor/rule generation must retain the + kernel-observable raw binder syntax while consulting the view for result + sorts, recursive classification, target indices, and elimination facts. + **Complete:** `GenerationChecked` supplies the executable layout gate, + ordered `NormalizedCtor` pairs, raw/view coverage lemmas, and the sole live + mixed motive/minor/recursor/rule implementation. Identity generation + specializes by reduction to the current Nat/Eq/`IndexedVec`/`Acc` artifacts. + The family-result and recursive-field alias recursors and iota rules match the + actual kernel by `rfl`; `AliasRec` additionally proves that the emitted minor + telescope retains the raw `RecAlias AliasRec` field while recursion comes + from the view. Do not generate everything from the rewritten view: the alias + audit shows that would erase syntax retained by kernel metadata and recursor + types. + + The completed artifact-preservation sequence is: + + - [x] Establish the structural contract. `VEnv.TelDefEq` tracks pointwise + equality in raw predecessor contexts; `GenerationChecked.WF` separates + pre-family family evidence from post-family stored-constructor and + emitted-artifact evidence; generic guarded lemmas prove the raw family and + constructors well formed without the unfinished + `IsDefEqU.forallE_inv_stratified`. + - [x] Prove the mixed motive and all mixed minors well formed. + `GenerationEnv.motive_isType`, exact raw constructor-application transport, + recursive-argument/IH transport, `minor_isType`, and `minorTypes_onTel` + cover the full constructor list. `minorTypes_length` and positional + `minorTypesAux_getElem?` prevent silent list misalignment. + - [x] Factor `familyApp_transport`, covering the common operation of + inserting motive/minor binders below the indices and then weakening by a + top stack. The targeted + `Lean4Lean.Theory.Typing.InductiveLemmas` build is green. + - [x] Prove `GenerationEnv.recType_isType` telescope-by-telescope in the + order parameters, motive, minors, lifted indices, major premise, and final + motive application; `GenerationEnv.recursor_wf` closes the mixed recursor + constant. + - [x] Prove every mixed rule well formed. `ruleBinders_onTel`, + `ctorAppRule_hasType`, `ruleCall_hasType`, `minorApp_hasType`, + `recRuleApp_hasType`, and `rule_WF` cover the raw telescope, constructor, + recursive calls, RHS, and rule type; `generatedRules_WF` and + `generatedRulesFold_ordered` close the ordered list without a separate + direct-recursion branch. + - [x] Add exact axiom guards for the stabilized mixed component roots, + recursor, rule, and block-level fold as specified in §2.3. The motive and + family transport use `[propext, Quot.sound]`; the minor, recursor, rule, + and fold roots use the permitted + `[propext, Classical.choice, Quot.sound]` ceiling. + - [x] Make the legacy `Checked` artifact accessors identity-normalization + compatibility specializations of the mixed implementation, prove exact + Nat/Eq/`IndexedVec`/`Acc` public equalities, and confirm both alias + differentials. `Checked.analyzer_eq` gives the unique retained result, + `identityBlock`/`identityGeneration` construct the canonical bridge, and + generic `*_eq_legacy` theorems pin all four artifact forms. The old + `*Rec` functions remain only as compatibility/specification targets until + the transaction contract is migrated; no live public accessor generates + through them. +- [x] Replace the raw-only transaction with one normalized transaction and an + identity-normalization compatibility wrapper. Route `stage3` (or its + successor public predicate), `VEnv.addInduct`, `AddInductSuccess`, + atomicity/freshness/lookups, `addInduct_WF`, and generated-rule membership + through the paired checked block. The preservation theorem must consume + `Normalization.WF`, the checked view's semantic certificate, and the raw + declaration WF facts at their correct pre-/post-family environments. At a + checkpoint there must be one semantically live artifact path, not unrelated + raw and normalized transactions. + + Implement this in the following order: + + - [x] Add a single computational core, + `VEnv.addInductGeneration (gen : GenerationChecked source)`, which inserts + `gen.block.sourceType`, folds its raw constructor list (proved equal to + `gen.block.ctorPairs.map (·.raw)` by `rawCtors_eq`), inserts + `gen.recursor`, and folds `gen.generatedRules`. It does not inspect the + view again and accepts no semantic proof as an oracle. + - [x] Give that core a dependent success certificate retaining the exact + `gen`, intermediate environments, raw family/constructor lookups, recursor + lookup, every generated-rule membership fact, monotonicity, freshness, and + atomic failure behavior. State the primary lookup/rule fields using mixed + artifacts; derive legacy `recConstRec`/`rulesRec` consequences only in the + identity wrapper. `AddInductGenerationTrace` is data-bearing, while + `addInductGeneration_trace` returns `Nonempty` so proof consumers do not + acquire choice solely to unpack transaction bookkeeping. + - [x] Prove normalized preservation in transaction order. Use + `GenerationChecked.WF.rawFamily_isType` for the first insertion, its + staged `rawCtor_isType` facts for the constructor fold, promote the + certificate with `GenerationChecked.WF.toGenerationEnv`, then apply + `GenerationEnv.recursor_wf`, `generatedRules_WF`, and + `generatedRulesFold_ordered`. Do not reconstruct a `Stage3Env` or rerun + legacy recursive analysis. `addInductGeneration_WF` now follows exactly + this chain. + - [x] Redefine the current `VEnv.addInduct env source` as: obtain the exact + `Checked` result once, form `checked.identityGeneration`, and call the + normalized core. `addInduct_eq_addInductGeneration` pins that computation. + - [x] Add the semantic identity bridge + `env.Ordered → Checked.WF env → checked.identityGeneration.WF env`, then make + `AddInductSuccess`, its atomicity/freshness/lookups/rule-membership + consequences, and `addInduct_WF` delegate to the normalized trace and + preservation theorem. Delete the now-redundant legacy `Stage3Env` + transaction proof only after those public statements and exact closures + remain unchanged. `DirectFamilyEnv` captures precisely the state after the + family insertion and before any constructor lookup exists; the bridge uses + it to validate direct/functional recursive fields and exact raw constructor + results without reconstructing `Stage3Env`. + - [x] Add direct Theory transactions for `AliasFormer` and `AliasRec` using + their explicit `GenerationChecked.WF` witnesses. Check raw family and + constructor payload preservation, exact kernel recursor/rules, complete + lookup membership, monotonicity, and final `Ordered`; the raw + `checked? = none` facts must remain true to demonstrate that normalization, + rather than analyzer weakening, enables them. Both final environments now + have trace, freshness, raw lookup, kernel recursor/iota, monotonicity, and + ordering fixtures. + - [x] Complete the exact guard set. Core trace/atomicity/lookups, + normalized preservation, and identity-wrapper computation are already + guarded at the exact closures recorded in §2.3; add guards for the + identity semantic bridge, delegated public roots, and both alias + transaction roots. The identity bridge and ordered alias endpoints use + exactly `[propext, Classical.choice, Quot.sound]`; alias trace/lookups and + rule membership use exactly `[propext, Quot.sound]`. +- [ ] **L4L-01A–L4L-01E (01A–01B complete; 01U active before 01C):** complete generic Verify-side production of + normalized transactions in five separately green checkpoints. The + trace/consumer migration and six actual-metadata replays are complete. The + generic checker-to-Theory `WhnfRun`, `CheckTypeRun`, `DefEqEvidence`, and + `NormalizationRun` APIs are complete, as are both fixed alias normalization + instantiations and both complete checked `GenerationChecked.WF` roots. + AnnotatedPi additionally builds the complete nested candidate, checked + generation certificate, and transaction from exact checker traces. These + checked roots no longer bootstrap from older hand-built generation-WF + proofs. Semantic-input plumbing and family-validator/environment staging are + complete in L4L-01A/L4L-01B. L4L-01U first reconciles the live upstream and + Lean v4.31 without adding a semantic deliverable. Constructor trace + retention, constructor-validator soundness, and final package closure remain + the separate L4L-01C through L4L-01E checkpoints. Bare + `buildNormalizationCandidate` success is insufficient at every stage. The + whole-candidate non-defeq rejection is a required regression; an arbitrary + user-supplied view or assumed normalization oracle is forbidden. + + The Verify migration order is: + + - [x] Replace the trace's free `decl.Checked` field with the exact + `GenerationChecked decl` artifact and `GenerationChecked.WF` certificate + used by Theory; retain raw `ConstantInfo` payloads in every + `AddInductConstant`. + - [x] Add the first checked normalization-certificate producer. + `TypeChecker.WhnfRun` records the exact `Inner.whnf'` run, checker context, + state-WF proof, and input/output translations; its refinement theorem + yields typed Theory defeq. `DefEqEvidence` composes `refl`, `whnf`, `app`, + `beta`, `trans`, and `forallE`, while + `VInductDecl.NormalizationRun.wf` stages family and constructor evidence in + the correct environments. `AliasFormer` uses a real family-head WHNF run; + `AliasRec` uses a real `RecAlias.{1}` run plus application, beta, + transitivity, and forall congruence. Exact operational and semantic axiom + guards pin both paths. + - [x] Add the first full-check typing producer and close the fixed-alias + dependent certificates. `TypeChecker.CheckTypeRun` records exact + `Inner.inferType _ false` runs and exposes named `HasType`/`IsType` + consequences. `AliasFormer` checks the real `TypeFamilyAlias` constant, + then checks the actual constructor type in the exact post-family + environment; the latter returns the retained alias and is combined with + verified WHNF. `AliasRec` checks the actual raw `RecAlias AliasRec` field + in the exact post-family environment, then uses that checked typing premise + in the compositional WHNF/application/beta equality for its constructor. + All three operational traces record their inferred/cache result and have + exact axiom guards. + Both aliases now assemble checked + block-WF and complete `GenerationChecked.WF` roots without using their + older fixture generation-WF proofs. Generic `TelDefEqEvidence`, + `NormalizedCtorRun`, and `GenerationRun` package the pointwise binder, + declared/emitted constructor, and exact post-family evidence, so the fixed + cases exercise the same assembler intended for arbitrary metadata. Exact + guards show that these complete certificates add no dependency beyond the + checked semantic endpoint. + - [x] Feed both fixed-alias checked generation certificates through complete + data-bearing `AddInductTrace` values and `TrEnv'`. The checked traces reuse + the already audited metadata-translation witnesses, preserve the same + final environments, and derive final WF/alignment. Exact guards show that + this end-to-end wiring adds no dependency beyond the checked semantic set. + - [x] Complete candidate-list traversal and semantic certification of the + retained indexed runs at Lean's transparency and fuel boundary. Exact + whole-call package production is tracked separately below. + + - [x] Add the generic executable traversal. + `AddInductive.normalizeCandidateExpr` calls the ordinary checker `whnf` + at every node, traverses exposed Pi domains and instantiated bodies + under the kernel's structurally certified annotation-consumed local + declarations, retains the raw binder syntax plus an exact equality run, + and consumes the configured inductive fuel. Source-indexed candidate + family and constructor lists preserve metadata headers and positions by + construction. + `buildNormalizationCandidate` first repeats + `checkInductiveTypes`, computes family views in the input environment, + inserts all raw families, repeats `checkConstructors`, and computes + constructor views in that exact post-family environment. Its dependent + `NormalizationCandidate source` result prevents accidental reuse for a + different source but is not itself semantic authority. + - [x] Retain and operationally certify generic positional run data. + `CandidateExpr` records the full + `AddInductive.Context`, raw input, WHNF result, and recursive Pi + domain/body split at every node. Source-indexed dependent lists retain + exact family and constructor positions; views are reconstructed from + those traces while all names and non-expression headers come from the + indexed source. Every trace node carries + `CandidateWhnfStep.Valid`, the exact ordinary-checker run equality + obtained by dependent matching on the computation; `step_valid` + exposes it without an oracle or native evaluation. + - [x] Bridge retained steps to the existing semantic certificate boundary. + `CandidateWhnfStep.innerRun` constructively recovers the final checker + state erased by `TypeChecker.M.run`, while + `TypeChecker.WhnfRun.ofCandidateStep` combines that run with a matching + verified context and caller-supplied strict translations. The + AliasFormer family `WhnfRun` now comes from its produced candidate step + through this adapter rather than a parallel hand-filled `run_eq`. + - [x] Retain full checks at both declaration stages and every trace node. + Family traces run before raw family insertion; constructor traces run in + the exact post-family environment. Every recursive Pi domain and + instantiated body is checked in its recorded raw local context before + WHNF/traversal. `CandidateCheckTypeStep.innerRun` and + `CheckTypeRun.ofCandidateStep` mirror the WHNF adapters, while + `checkStep_valid` exposes every run. AliasFormer's family and actual + constructor `CheckTypeRun` values now use these candidate steps, + including the retained alias result after insertion. + - [x] Pin one exact operational leaf. The actual retained + `AliasFormer` family alias reduces through + `buildCandidateExpr` to a terminal trace containing the exact context, + source, and expected sort using the same verified checker WHNF run; + erasing that trace gives the expected `normalizeCandidateExpr` result. + Exact axiom guards record the inherited operational closure. This is + intentionally a leaf test rather than a second, fixture-specific + implementation of whole-expression WHNF. + - [x] Define and verify the recursive semantic interpretation boundary. + `CandidateExprTrace` is recursively context- and source-indexed at Pi + domains and exact instantiated bodies. Its body index is the literal + `Context.pushLocalDecl` update with the producer's next fresh identifier + and structurally certified consumed domain, eliminating the previous + independently supplied child context. `CandidateNodeRun.ofCandidate` + pairs the two retained + executions in one verified context, while + `CandidateNodeRun.exists_ofCandidate` extracts both output translations + from the verifier refinements rather than requiring them from the + caller. `CandidateExprRun` folds terminal nodes and Pi domain/body + children into `DefEqEvidence`, retaining raw Pi syntax while checking + the body under the kernel's consumed binder context. Its Pi case + accepts arbitrary checker-inferred types and transports them to the + structural domain/body/result sorts using unique typing, so a relevant + Pi-producing alias need not be reported syntactically as a sort. + `source_tr` retains the strict raw translation, while `view_tr` abstracts + the exact retained free variable, transports the body across the + raw/normalized domain context, and translates the reconstructed + candidate view. All construction, interpretation, and translation roots + have exact guards. AliasFormer's actual candidate trace supplies its live + `NormalizationRun` and `GenerationRun` family evidence through this path. + - [x] Construct matching verified contexts and translations automatically + for every retained position in a candidate trace. + `CandidateContextRun.root` aligns the exact executable root with a + verified `VEnvs`; `.pushLocalDecl` builds the corresponding + `VContext`/`MLCtx`, proves binder freshness and checker-name reservation, + and restarts the empty checker state soundly. The trace now retains the + exact freshness equation. `candidateCheckTypeStep_exists_translation` + recovers strict source/inferred translations and typing from the root + full check, and `CandidateExprRun.exists_ofCandidateFVars` invokes the + node interpreter recursively, deriving child translations and raw + domain/body typing from Pi decomposition. AliasFormer exercises the + automatic root path without a fixture-supplied Theory expression. Exact + guards cover every new state/context/recursive root. + - [x] Remove the explicit `CandidateRawBinderDomains` restriction and + certify annotation consumption. `CandidateTypeAnnotationTrace` mirrors + the four top-level peeling cases structurally, and + `buildCandidateTypeAnnotations` checks its result against Lean's actual + `consumeTypeAnnotations` implementation. Because that implementation is + an opaque partial definition, the retained `CandidateTypeAnnotations` + stores only the consumed expression and structural trace; the agreement + branch is executable producer validation, not a semantic proof field. + Every Pi retains an exact + successful `isDefEq domain consumed` execution before extending the + body context. `IsDefEqRun.ofCandidateStep` and `.isDefEqU` refine that + execution; strict translation of the consumed argument is extracted + from the raw application trace, so a redundant second full check is not + required. `CandidateExprRun.forallE` now transports domain typing, body + translation/equality, evidence, and the reconstructed view across the + raw, consumed, and normalized contexts. Positive executable fixtures + cover `outParam`, `semiOutParam`, `optParam`, and `autoParam`; a negative + fixture pins both the checker's `.ok false` result and the producer's + dedicated rejection. Exact axiom guards cover every new producer and + verifier root. + - [x] Convert the candidate list to the one-family Theory + `Normalization`, run its dependent checked analysis, and assemble + `NormalizationRun` from retained family and constructor runs. + `CandidateExprRootRun` ties named Theory endpoints to exact candidate + syntax; `CandidateConstructorListRun` folds exact positional evidence; + and `NormalizationCandidateRun` statically accepts only a singleton + source family and singleton raw declaration. AliasFormer's actual family + and post-family constructor candidate traces now drive its live + normalization certificate. A truncated view fails the computational + shape gate before transaction construction. Exact guards cover singleton + elimination, root evidence, list shape/evidence, normalization assembly, + the migrated fixture, and the negative. + - [x] Extract raw/view binder telescopes and terminal results from the + retained recursive runs, align them with the successful dependent + analysis, and assemble generic `GenerationChecked.WF`. + `CandidateExprTrace.storedSpine` prevents WHNF from inventing or deleting + emitted raw binders while allowing binder-domain and terminal-result + normalization. `CandidateExprRun.spineEvidence` returns exact + `TelResultDefEqEvidence` with a proved raw-spine length. + `CandidateFamilyGenerationRun` and `CandidateNormalizedCtorRun` align + that evidence with the dependent checked view; + `TelResultDefEqEvidence.replacePrefix` proves the declared/emitted + constructor bridge through exact contexts; and the dependent + `CandidateNormalizedCtorListRun` cannot truncate, reorder, or reuse a + constructor certificate. `GenerationCandidateRun.wf` produces the + existing Theory `GenerationChecked.WF`. Every extraction and assembly + boundary has an exact axiom guard and introduces no new axiom. + - [x] Route one non-identity candidate-derived generation certificate + through an existing complete checked consumer. AliasFormer's exact + pre-family and post-family candidate spines now build + `aliasFormerGenerationCandidateRun`; its former hand-filled + `GenerationRun` delegates to that generic value, so the checked + `AddInductTrace`, final environment, `TrEnv'`, WF, and alignment roots all + exercise the candidate assembler. + - [x] Add a complete positive candidate-list fixture with an annotation + inside an actual recursive Pi constructor type. `AnnotatedPi.mk` retains + `outParam Prop` in the raw recursive-function domain while the candidate + view consumes it to `Prop`. Its exact full-check, WHNF, and complete + lazy-delta `isDefEq` traces recursively construct the raw and consumed + contexts, pass `storedSpine`, extract the nonempty nested telescope and + terminal result, assemble `GenerationCandidateRun.wf`, and replay the + final environment, recursor, and iota rule through checked + `AddInductTrace`/`TrEnv'`. Exact guards cover normalization, generation, + checked generation, transaction replay, and the small Theory iota root. + - [x] Add the corresponding whole-candidate rejection for non-defeq + annotation domains. The fixture keeps the real AnnotatedPi family and + constructor metadata and gives `outParam` its correct polymorphic type as + an opaque constant. Family/constructor staging therefore reaches the + recursive candidate, but the ordinary checker cannot prove + `outParam Prop` definitionally equal to the syntactically consumed + `Prop`; `buildNormalizationCandidate` returns the dedicated binder-domain + error before any semantic package or transaction exists. Keep this with + the four leaf annotation positives, exact non-defeq leaf rejection, + truncated-view rejection, and positive AnnotatedPi transaction so the + failing phase remains unambiguous. + - [x] Add the generic proof-carrying consumer boundary and route two + non-identity packages through it. Theory's `GenerationCertificate` owns an + exact generation and `GenerationChecked.WF`; `VEnv.addInductCertified` + erases the proof and computes through `addInductGeneration`, with exact + trace, atomicity, and WF theorems. Verify's + `GenerationCandidatePackage` retains the exact kernel source, candidate, + normalization, generation, and semantic run; `.certificate` is the + ix-facing erasure, and `.addInductTrace` prevents metadata replay from + receiving an unrelated generation/WF pair. AliasFormer and AnnotatedPi + both exercise the package, public certified transaction, and checked + replay. Keep `VEnv.addInduct` as the identity compatibility wrapper until + kernel parity and downstream migration are green. + - [x] Instantiate the exact whole-call producer boundary on real positive + metadata. AliasFormer and AnnotatedPi prove + `buildNormalizationCandidate ... = .ok package.candidate` through the + exact family-declaration and constructor-check contexts, constructs + `ProducedGenerationCandidatePackage`, and routes both its public certified + transaction and checked metadata replay through that produced value. The + proof retains exact source-indexed candidate equality, not candidate + erasure equality or a hand-selected view, and exact guards expose every + inherited cache/platform dependency. + - [ ] **L4L-01A–L4L-01E (01A–01B complete; 01U active before 01C):** generalize exact produced-package construction to + arbitrary strengthened singleton metadata runs. The executable seam now + covers `IndexedVec`'s family telescope, parameter, index, and ordered + two-constructor list; generic identity replay and the concrete + identity-spine witnesses feed a complete dependent semantic package and E1 + replay. Automatic semantic hierarchy assembly is complete once exact + verified per-position inputs are supplied. L4L-01A consolidates that + repeated input assembly over two explicitly verified stages. L4L-01B + derives the post-family stage from the family validator. L4L-01U reconciles + current upstream before L4L-01C and L4L-01D retain and interpret + constructor validation. L4L-01E alone applies the already generic + generation alignment and deletes the temporary fixture view-WF proofs. + Bare outer-producer success remains insufficient. + + - [x] Abstract exact executable family-type, constructor, and complete + family-list assembly into arbitrary-length dependent `Produced` + witnesses. Route AliasFormer, AnnotatedPi, and the two-constructor + `IndexedVec` regression through their generic `.normalize` theorems, with + exact standard-baseline axiom guards. + - [x] Add the generic outer singleton constructor + `GenerationCandidateRun.producedPackage`. It requires an exact successful + `buildNormalizationCandidate` equation indexed by the same kernel source + and dependent candidate as the semantic run, so it cannot attach + executable provenance to another view or reordered list. Route + AliasFormer, AnnotatedPi, and `IndexedVec` through it and guard its exact + inherited `[propext, sorryAx, Classical.choice, Quot.sound]` closure. + - [x] Introduce generic retained semantic ownership. + `CandidateExprSemanticRootRun` owns the exact recursive run and its + checker-selected view; `.root` and `.spine` feed normalization and + generation from that same value. Source-indexed semantic constructor + lists, families, and singleton normalization candidates preserve every + position. AliasFormer, AnnotatedPi, and `IndexedVec` now use this hierarchy + instead of parallel root/run/spine records. + - [x] Combine the operational list witnesses with automatic construction + of the retained semantic family/constructor hierarchy. + `CandidateExprSemanticRootInput`, the dependent constructor and family + inputs, and `NormalizationCandidateSemanticInput.exists_ofProduced` + invoke the retained checker interpreter at every exact source position + and return `Nonempty ProducedNormalizationCandidateSemanticRun`. + `CandidateFamilySemanticGenerationRun`, + `CandidateSemanticNormalizedCtorListRun`, and + `GenerationCandidateSemanticRun` make those same roots and spines own the + generation path. Exact generic and fixture axiom guards are live; + `IndexedVec` proves exact constructor order and rejects a reordered view. + - [x] Derive view telescopes and terminal typing instead of accepting them + from fixture generation records. `Checked.type_eq` and + `GenerationChecked.viewCtorType_eq` expose exact accepted family and + constructor shape at the standard Theory axiom baseline. + `GenerationCandidateRun.familyView_eq` fixes the singleton candidate view; + family terminal sort typing follows from the checked result level; the + raw family constant is typed once in the post-family environment; and + `GenerationChecked.checkedResultTarget_hasType` plus exact telescope + context transport derives every constructor target judgment. + AliasFormer, AnnotatedPi, and `IndexedVec` now omit `viewTel` and + `rightType`; the two circular `IndexedVec` right-typing helpers are gone. + Exact guards cover all new Theory and Verify roots. + - [x] Retain exact dependent analyzer provenance and derive its immediate + semantic consequences. `GenerationCandidateRun` and + `GenerationCandidateSemanticRun` store + `normalization.generation? = some generation` instead of an unrelated + normalization equality. Theory proves successful `check?` and + `generation?` retain the analyzed normalization; Verify derives + post-family environment WF from the verified pre-family context, + raw/view equality, checked family typing, and exact insertion. + AliasFormer, AnnotatedPi, and `IndexedVec` now provide neither + `normalization_eq` nor `typeEnv_wf`, and exact axiom guards cover every + new public root. + - [x] Derive analyzer-owned component and dependent-list alignment from a + minimal semantic generation shape. `GenerationCandidateSemanticShapeRun` + retains checked WF, exact analysis, and only stored-spine/total-length + shape data. Singleton indices recover the raw family and complete checked + family view; analyzer maps recover every normalized constructor pair and + exact source order; total length determines raw telescope/results; and + exact checked shape determines view terminals. Its public `.run` + reconstructs `GenerationCandidateSemanticRun`. AliasFormer, AnnotatedPi, + and `IndexedVec` no longer select pairs or provide component equations. + - [x] Consolidate checked-WF and per-position shape derivation behind one + strengthened executable generation-readiness result. + `normalizationCandidateGenerationShape` checks the complete singleton + family and source-indexed constructor list, including stored emitted + spines and total raw telescope lengths, and rejects list mismatch in both + directions. `ProducedGenerationShapeCandidate` retains the exact ordinary + producer equation without pretending that equation proves the stronger + gate. `GenerationCandidateSemanticRun.ofGenerationShape` uses exact + dependent analysis and WF of the analyzer-owned view declaration to + derive checked WF and expand the successful Boolean into every dependent + shape record. All three fixtures use this boundary and exact axiom guards + show no trust-budget increase. + - [x] **L4L-01A:** add one source-indexed staged-input owner over explicitly + verified pre-family and post-family candidate contexts, strict family and + constructor source translations, exact insertion alignment, and the + existing dependent `Produced` traversals. Its only semantic output is + `Nonempty ProducedNormalizationCandidateSemanticRun`. Migrate all three + positives to this owner and delete their per-root + `CandidateExprSemanticRootInput` and constructor-list input definitions. + Because this output is intentionally `Nonempty`, the existing explicit + downstream semantic-run/package witnesses and one fixture-level `viewWF` + remain permitted and visibly temporary until L4L-01E; do not extract data + with `Classical.choice`. Complete at source checkpoint `7c792209`: all + three positives use the staged owner, exact constructor order is retained, + the repeated old input definitions are absent, and focused/universal gates + pass without changing the axiom frontier. + - [x] **L4L-01B:** interpret the exact singleton family-validation run from + one verified entry context. Derive the candidate view parameter/index + telescope, terminal sort typing, raw-family constant WF through the + candidate's semantic defeq, the exact raw-family insertion, and the + verified post-family candidate stage. Remove the second independently + verified stage and the three fixture-specific post-family `VEnvs.WF` + reconstructions. Do not inspect or prove constructor validity here. + Complete at source checkpoint `da45b536`: the exact singleton validator + derives parameter/index views, terminal/raw-family WF, exact insertion, + and the post-family candidate stage; none of the three positives retains + an independent post-family `VEnvs`/context; constructors remain + uninterpreted; family-phase negatives remain sharp; exact axiom guards + and universal gates pass. + - [x] **L4L-01U:** completed at source checkpoint + `7f864b459e4a6062b468d6e5416688feac0f9f99`. It merges digama + `upstream/master` through `ef849dfbd94a` into origin `jcb/induct` + without rewriting the published checkpoints or moving either master. + The source reconciles the overlapping + inductive/checker/Verify/level and replay/CI/Experimental changes, + upgrades Lean and lean4-nix to v4.31, retains the fork's Nix and ix-facing + certificate surfaces, and removes upstream's four now-proved + cached-`Expr` axioms plus the obsolete hand-declared `mkAppRangeAux` + equation. The exact inventory is 29 custom axioms and 22 non-Experimental + sorries. `NormLevel.isEquiv_wf` is assigned to L4L-02B and `addDecl.WF` + to L4L-19B; neither enlarges a supported-root allowlist. Completion + evidence includes the upstream tip as a source parent, passing + L4L-01A/L4L-01B regressions and universal Lean/Nix gates, and publication + of only origin `jcb/induct`. The isolated ix v4.31 probe + is diagnostic evidence, not an ix pin: merged Lean4Lean replay and ix + runtime modules pass, while ix-owned proof/API migration is deferred to + the next pin. Keep this checkpoint integration-only; constructor traces + belong to L4L-01C. + - [ ] **L4L-01C (active):** retain the complete successful singleton constructor + validator as dependent operational data: duplicate/closedness checks, + closed root `checkType`, parameter equalities, field `ensureType` and + universe comparisons, positivity/recursive-target traversals, and the + final family application. Prove decomposition/recomposition with the + actual `checkConstructors = .ok ()` execution. This milestone makes no + Theory WF claim and must preserve failure-phase diagnostics. + - [ ] **L4L-01D:** interpret the L4L-01C trace using the verified checker and + the retained candidate normalization. Derive every accepted view field's + `fieldsWF`, every constructor result `SpineWF`, and therefore WF of the + exact analyzer-owned view declaration. This is soundness for the + currently accepted normalization/validation subset, not the later + acceptance-breadth work of L4L-03/L4L-05. Remove all three fixture + `viewDecl_wf` proofs and guard the generic roots at their exact inherited + axiom closures. + - [ ] **L4L-01E:** combine the L4L-01A–L4L-01D owner, exact dependent + analysis, and `ProducedGenerationShapeCandidate` into an exact + `Nonempty ProducedGenerationCandidatePackage`. The theorem must retain + the successful ordinary producer equation but may not infer the + strengthened gate or Theory meaning from that equation. It must not + accept a view or view-WF premise. Raw/view pairing, component equations, + checked WF, per-position shape records, dependent-list alignment, view + telescopes, terminal typing, normalization identity, and post-family WF + remain derived. AliasFormer, AnnotatedPi, and `IndexedVec` use only this + theorem; missing/extra/reordered/truncated/non-defeq negatives remain + sharp. Mutual/nested generalization begins only after L4L-07. + + AliasFormer, AnnotatedPi, and `IndexedVec` remain the terminal-alias, + nested annotated-Π, and parameter/index/multi-constructor regressions. Do + not weaken the boundary to erasure equality or an assumed normalization + theorem; the opaque-`outParam` whole-candidate rejection must stay green + and fail before package construction. + - [x] Make `AddInduct.to_addInduct`, `.le`, `Aligned.addInduct`, + `TrEnv'.wf`, and `TrEnv'.aligned` consume the normalized Theory success + certificate instead of converting back to legacy raw artifacts. + - [x] Replay Nat, Eq, `IndexedVec`, `Acc`, `AliasFormer`, and `AliasRec` + from actual metadata. For every case pin source/view data, recursor + universes, raw binder syntax, all rule RHSs, final environment equality, + lookup uniqueness, WF, and alignment. + - [ ] **L4L-11:** export the ix-facing oracle ingredients only after the normalized + trace has exact axiom guards and no `sorryAx` beyond the separately tracked + projection relation. The API should expose generation/lookup/pattern facts, + not a normalization oracle or kernel implementation object. +- [ ] **L4L-03:** match the remaining singleton environment-sensitive behavior of + `checkInductiveTypes`/`checkConstructors`: `checkType` before declaration, + fuel- and transparency-appropriate WHNF-driven Pi/result-sort peeling, + WHNF-driven recursive-target traversal, and definitional rather than + syntactic constructor-parameter agreement. Add a positive constructor + parameter case whose domains differ syntactically but are definitionally + equal, paired with a genuinely non-defeq negative and exact kernel outcome. + Result-level equivalence across different family types belongs to I3, not + this singleton milestone. +- [ ] **L4L-04:** complete the normalization differential matrix before calling this + sub-slice done. Cover aliases at family results, parameter/index domains, + ordinary fields, direct recursive targets, and recursive targets hidden + behind a Pi-producing alias; include beta/let reduction where real metadata + can retain it, irreducible/opaque or otherwise non-defeq counterexamples, + and the checker fuel boundary. For each accepted case compare the raw + constant payloads, normalized descriptor, recursive positions, recursor + type, and every rule RHS with the kernel, then replay it through E1. Add + generic axiom guards for the paired-block preservation and transaction roots, + not only the two concrete fixture witnesses. +- [ ] **L4L-05:** complete positivity and constructor checks: nested negative occurrences, + non-recursive fields mentioning the family, dependent fields, recursive + functions, proof-valued fields, and constructor universe bounds. The last + obligation is already represented semantically in `Checked.WF`; this task + connects it to kernel acceptance and differential tests. Every rejection + branch gets a fixture whose nearest kernel analogue is also rejected; the + checker remains an underapproximation until agreement is demonstrated. +- [ ] **L4L-06A:** implement `isLargeEliminator`, `getElimLevel`, `getRecLevels`, and + `getRecLevelParams` faithfully. Make `ElimMode.small` constructible and + parameterize motive/recursor generation by it, so Or/And are accepted with + Prop-only recursors while Eq-like and never-zero families retain legitimate + large elimination. +- [ ] **L4L-06B:** add `isKTarget` data to the descriptor and reproduce the kernel's Eq-like + K flag/behavior without using K as a shortcut for invalid large elimination. + Verify the exact universe ordering rather than normalizing away meaningful + permutations. +- [ ] **L4L-06C:** cover empty and singleton-constructor families and prove exact recursor + binder ordering, minor ordering, field counts, recursive-argument metadata, + rule counts, and iota RHSs. Refactor the preservation proof one generated + component at a time; no new case may bypass `Checked` or add a proof-only + premise that real kernel metadata does not supply. +- [ ] **L4L-07:** replay every newly accepted family through E1 immediately. Theory parity + without actual `ConstantInfo` translation is insufficient for ix, because + `InductiveOracle` needs both semantic generation and environment alignment. + +The fixed positive matrix is Nat, Bool, List, Option, Prod, Unit, Empty, Or, +And, Eq, HEq, Fin, Vector, and Acc, plus the focused alias-normalization cases +listed above. For each, compare acceptance, raw stored type, type and +constructor names, parameter/index counts, field/recursive-argument metadata, +universe lists, elimination level, K flag where relevant, recursor type, rule +count, and every iota RHS with the real kernel. The paired negative matrix must +cover loose variables, duplicate/internal and pre-existing names, bad universe +levels, malformed result applications, parameter mismatch, non-defeq +normalization views, negative recursion, illegal recursive targets, and invalid +elimination. I2 exits only when both matrices, the E1 replay subset, exact axiom +guards, sorry audit, Theory/Verify build, and full flake gate are green. + +The current negative matrix already covers the closure, generated-name, +universe-annotation, self-reference, raw result-shape, parameter-count, +universe-count, transaction-collision, recursive-Pi domain, changed-target +parameter, and recursive-index-family branches. I2's remaining negative work +is therefore concentrated on rejecting semantically invalid raw/view pairs, +nested positivity beyond this one-family recursive target, constructor field +universes at the acceptance boundary, and elimination/K behavior rather than +duplicating completed cases. + +### I3 — mutual blocks (L4L-08A–L4L-08C) + +- [ ] **L4L-08A — mutual checked representation.** Replace singleton + destructuring in analysis with dependent lists over `decl.types`; represent + shared parameters, per-family indices/results, ordered constructors, and + cross-family recursive targets. Compute checked Tree/TreeList and one mutual + indexed descriptor, but do not generate or insert constants yet. +- [ ] **L4L-08B — mutual validation and normalization.** Generalize the + L4L-01C/L4L-01D validator traces and semantic interpretations to shared parameter + agreement, equal result universes, all-family staging before constructor + validation, cross-type recursive occurrences, and recursive Pi arguments. + Produce the exact mutual semantic package and sharp mismatch/reordering + negatives; no generator theorem is part of this checkpoint. +- [ ] **L4L-08C — mutual generation, preservation, and replay.** Generate one + motive and recursor per family, flatten all constructor minors in kernel + order, and route each recursive call to the correct motive/recursor. Add all + type constants before constructors, all constructors before recursors, and + all recursors before rules; prove `Ordered`, lookups, and preservation through + the chain. Tree/TreeList and the mutual indexed fixture compare every + `inductInfo`, `ctorInfo`, `recInfo`, and rule and replay through E1. No + singleton destructuring remains on the public path. + +### I4 — nested inductives (L4L-09A–L4L-09C) + +- [ ] **L4L-09A — nested representation decision.** Audit how translated + `inductInfo` represents flattened nested auxiliaries even though the producer + receives `numNested` and `VInductDecl` does not. Commit a design note plus + executable metadata probes. Choose an additive metadata/checked-block type or + proved pre-flattening relation; change existing `VInductDecl` fields only if + neither can express real output, with ix compatibility evidence first. This + checkpoint changes no acceptance behavior. +- [ ] **L4L-09B — nested transformation and positivity.** Implement the chosen + pre-flattening/auxiliary relation, the kernel nested transformation, and its + positivity/validation obligations. Pin the transformed family and auxiliary + descriptors for a rose tree through List and one nested indexed family, + including rejection differentials, but do not yet claim generated recursors + or E1 replay. +- [ ] **L4L-09C — nested generation and replay.** Generate every auxiliary + declaration, recursor, and rule; prove preservation and insertion order; and + round-trip both fixtures through real `Inductive.Add.run`, generic packaging, + and E1. The exit compares all raw metadata and rule RHSs rather than a + hand-authored declaration. + +### I5 — generated-pattern package (L4L-10A/L4L-10B, ix-critical) + +- [ ] **L4L-10A — generated iota pattern core.** Construct every generated iota + LHS through `SimplePattern.iota` or prove exact equality to its `Pattern`. + Prove match inversion, rule-index/constructor recovery, rule distinctness, + pairwise non-intersection, and the `Params.pat_uniq`/ + `pat_app_l_uniq`/`pat_app_uniq` obligations for one certified block. Port the + implementation-independent ix helpers `HeadConst`, `HeadConstN`, + `of_varN_matches`, `RecursorIotaPattern`, and `matches_shape` into + `Theory/Typing/Pattern.lean`. +- [ ] **L4L-10B — pattern soundness and environment assembler.** Prove + `pat_wf`: successful match/check instantiates the LHS/RHS defeq registered by + `addInduct`. Add a block-local assembler for an environment whose defeq set + consists of generated inductive rules plus separately certified extension + rules. Do not install a global `Params` instance for an open environment. + +## 7. Track E — Verify environment alignment and ix's inductive oracle + +### E1 — replace the empty `AddInduct` path (L4L-01A–L4L-01E/L4L-07/L4L-11) + +- **Status: core normalized relation/proof path, actual-metadata Nat, Eq, + index-changing `IndexedVec`, recursive-Pi `Acc`, `AliasFormer`, and + `AliasRec` replays, plus the pre-existing-value regression, are complete. + The first verified WHNF-to-normalization certificate producer is complete + and instantiated on both aliases. Automatic candidate traversal, dependent + semantic packaging, and the proof-carrying public non-identity transaction + are complete for AliasFormer and AnnotatedPi; both additionally have exact + whole-call produced packages in their real pre-/post-family environments. + Published checkpoint `cf3d5a47` extends the same complete path to + `IndexedVec`, including its parameter/index family, ordered `nil`/`cons` + candidate list, + producer-selected semantic package, certified transaction, and checked E1 + replay. Generic arbitrary-metadata whole-call package construction and the + remaining I2-I4 + breadth matrix remain.** +- [x] Introduce reusable fold witnesses for typed metadata constants and defeq + rules. `AddInductConstants` and `AddDefEqs` expose fold realization, output + lookup/rule membership, input freshness, and `VEnv.LE`; the map-side lemmas + additionally preserve `SMap.WF` and show that new metadata cannot fabricate + a value-bearing declaration. Quot's fixed four-step CPS chain remains the + small fixed-shape analogue. +- [x] Define proposition-valued `AddInduct` as the nonemptiness of an internal + data-bearing `AddInductTrace` that aligns one Stage-3 `inductInfo`, the + ordered `ctorInfo` list, one `recInfo`, and all generated iota rules with the + corresponding Theory operations. This preserves the original public + `AddInduct … : Prop` shape while the hidden trace retains intermediate + maps/environments so proofs do not reconstruct a `foldlM` execution. The + trace now carries the exact dependent `GenerationChecked decl` and + `GenerationChecked.WF` certificate and derives its raw family, constructor, + recursor, and rule payload from that single normalized artifact instead of + duplicating Stage-3 acceptance and generation fields. +- [x] Prove `AddInduct.to_addInduct`, `AddInduct.le`, and + `Aligned.addInduct`; remove both vacuous `nomatch` proofs. Complete the + formerly impossible `TrEnv'.of_value` inductive case by proving that + inductive metadata has `value? = none` and pulling old value lookups back + through every insertion. +- [x] Add compile-time closure guards for `AddInduct.to_addInduct` and + `Aligned.addInduct`. Their present `sorryAx` is inherited from the sorried + `TrProj` in `TrExprS`; E1 adds no axiom declaration. P0-P2 must make these + guards fail and then be tightened to a non-`sorryAx` closure. +- [x] Add a reusable replay/translation layer. `TrTypeExpr` separates the + structural metadata translation from typing, and `to_trExprS` obtains the + latter from the real Theory `WF` derivation. The elaborator fixture quotes + `ConstantInfo` records from Lean rather than hand-building lookalikes. +- [x] Complete the Nat vertical slice: quote `inductInfo`, both `ctorInfo`s, + and `recInfo`; prove their translations in the exact intermediate + environments; construct `AddInduct`; execute `TrEnv'.induct`; and check + `TrEnv'.wf`, `TrEnv'.aligned`, final replay equality, and recursor lookup + uniqueness. Guard the fixture's exact transitional axiom closure. +- [x] Prepend a concrete value-bearing definition and prove that + `TrEnv'.of_value` still translates it after the Nat inductive transaction. + This must force the proof through the inductive branch; a quantified or + impossible metadata-value premise is not an adequate test. The fixture does + so with the actual `defnInfo` for `ReplaySeed`, and guards the resulting + closure. +- [x] Repeat the actual-metadata transaction for Eq, including its + parameter/index telescope, Prop recursor, universe permutation, final + replay equality, `WF`, alignment, and recursor lookup uniqueness. Guard the + exact closure and require it to equal Nat's rather than merely contain no + newly declared axiom. +- [x] Repeat the actual-metadata transaction for `IndexedVec` over the actual + Nat replay, and exercise type, changing-index constructor, and recursor + lookup uniqueness. The fixture deliberately spells its indices as + `Nat.zero` and `Nat.succ n`. The notation form exposed `OfNat.ofNat`, + `instOfNatNat`, `HAdd.hAdd`, `instHAdd`, and `instAddNat` (and transitively + `Nat.add`), which tests generic prelude-definition replay rather than the + inductive transaction. Record this as a reduced dependency claim, not as + evidence that the full notation-generated prefix has been replayed. +- [x] Repeat the actual-metadata transaction for `Acc`. Check the real metadata + counts and recursive rule fields, translate the declarations in their exact + intermediate environments, prove final replay equality/WF/alignment and + lookup uniqueness, and pin the quoted kernel `RecursorRule.rhs` + definitionally to the generalized Theory rule. Guard the fixture at the same + exact transitional closure as the other E1 replay roots. +- [x] Migrate `AddInductTrace` to I2's paired raw/view generation block and + replay the family-result and recursive-field alias declarations from actual + metadata. Both replays include their actual alias definitions, exact + intermediate environments, all kernel rule RHSs, final equality/WF/alignment, + and lookup uniqueness. +- [ ] **L4L-11:** extend L4L-01E's generic automatic candidate/package + construction across I2-I4's complete fixture matrix, + keeping every dependency environment explicit and checking type, every + constructor role needed by the family, and recursor lookup uniqueness. + Separately add a notation-heavy prelude replay fixture before claiming + whole-environment coverage; do not hide that prefix behind a hand-built + Theory-only environment. Abstract witness-only tests are not sufficient. + +### E2 — expose an oracle-construction theorem for ix (L4L-11) + +Provide consumer-neutral lemmas from which ix can fill every +`InductiveOracle` field: + +- `after` and `envLE` from `addInduct`/`addInduct_le`; +- `blockWF` from `VDecl.WF.induct` and `addInduct_WF`; +- translated type/constructor/recursor lookups from E1; +- `recursorFacts` from generated rule membership and registered defeqs; +- `recursorPatterns` from I5. + +Ix remains responsible for address/catalog membership, freshness of KIds, and +the `nameOf` bridge. If any semantic oracle field cannot be produced without a +new assumption, strengthen lean4lean's checked-block API rather than weakening +the ix theorem. + +## 8. Track L — move consumer-neutral APIs into Theory + +This track can proceed independently once compatibility imports are designed. + +### L1 — Theory API extraction (L4L-12A) + +- Split `VLocalDecl` and its VExpr-only operations/WF/defeq lemmas from the + `FVarId`-specific `VLCtx` layer into `Theory/LocalContext.lean`. +- Move `VExpr.boolLit`, `natLit`, `listCharLit`, `trLiteral`, + `VEnv.ContainsLits`, the implementation-independent part of + `VEnv.HasPrimitives`, and their lift/inst/instL lemmas into + `Theory/Literals.lean`. +- Keep `TrExprS` and all `Lean.Expr`/`Literal.toConstructor` traversal in + Verify. Re-export old names so upstream code does not break during migration. + +### L2 — prove literal/prelude readiness, not an invalid containment shortcut (L4L-12B) + +`ContainsLits` says only that names occur in the environment; it does not imply +their types. Define a Theory-level readiness predicate combining `Ordered` +with the exact Nat/Bool/Char/List/String constant types and required iota +rules. Prove: + +- readiness + `ContainsLits l` gives + `VExpr.WF env U [] (VExpr.trLiteral l)` (ix's `literalWF`/`hlit`); +- direct `trLiteral` meaning agrees with the Verify translation of + `Literal.toConstructor`; +- readiness is monotone under `VEnv.LE` and is preserved by unrelated + declarations. + +Then change ix's `WhnfTheory.literalWF` field into a derived theorem from its +world/prelude contract. + +### L3 — finish the Theory-only ix import surface (L4L-15C) + +Audit the three remaining Verify imports after L1/L2 and Track P. Add Theory +equivalents for genuinely mathematical lemmas, flip ix imports, build, and +only then remove compatibility shims. The target is zero +`import Lean4Lean.Verify.*` lines under `Ix/Tc/Verify/`. + +## 9. Track P — projection semantics and structures + +The old companion recommends a recursor encoding, but the current API needs a +design gate first. `TrProj Γ structName idx e e'` has no environment, universe +count, structure descriptor, constructor metadata, or projection-name map; +`TrProj.uniq` is even stated for unrelated `s₁` and `s₂`. A recursor encoding +cannot simply be dropped into that signature. + +### P0 — prove the API is expressible (L4L-13A) + +- Freeze the seven current lemma statements as regression tests, then check + whether a meaningful relation can satisfy them without strengthening their + premises. In particular test structure-name dependence, parameter offsets, + dependent fields, universe instantiation, and uniqueness. +- If the signature is inadequate, add a Theory-level env-indexed API such as a + `VStructureView` plus `VEnv.TrProj U Γ view idx e e'`. Change Verify's + `TrExprS.proj` through a compatibility wrapper. Do not encode the missing + metadata as unconstrained existential witnesses. +- Coordinate the additive API with ix's `RawProjRel`; ix can close over its + concrete `VEnv` when constructing `TrProjOK`. + +### P1 — choose and define the semantics (L4L-13B) + +Default to a recursor encoding because it reuses generated iota rules and is +consumer-neutral. Compare it against the alternative of applying a registered +projection-function constant, which matches Lean metadata more directly but +requires a projection-name map in Theory. Choose the representation that makes +all of the following derivable from one `VStructureView`: + +- projection field type (including dependencies on earlier projections); +- constructor projection/iota behavior; +- congruence under defeq and environment extension; +- lift, substitution, and universe instantiation; +- structure eta and zero-field/unit-like behavior, or a precise statement of + what additional Theory rule is required. + +### P2 — structural law package (L4L-14) + +Prove the seven upstream obligations—weakening, inverse weakening, +context-defeq transport, WF, uniqueness, term substitution, and universe +instantiation—and expose a bundled theorem matching ix's `TrProjOK`. Preserve +the individual compatibility theorem names for upstream Verify. + +### P3 — projection checker verification (L4L-15A) + +Use the same structure view to prove: + +- `inferProj.WF`; +- `reduceProj.WF` for constructor applications and strings; +- the projection branches of WHNF and translation congruence. + +### P4 — structure eta and unit-like comparison (L4L-15B) + +Prove the semantic theorem needed by `tryEtaStructCore.WF` and +`isDefEqUnitLike.WF`. First attempt derivation from the recursor/iota package, +proof irrelevance, and projection uniqueness. If Lean's structure eta requires +a new primitive Theory defeq rule, write a design note covering subject +reduction, injectivity, confluence, and ix impact, and obtain upstream agreement +before changing `IsDefEq`. This is a metatheory change, not a local checker +lemma. + +### P5 — ix handoff (L4L-14) + +Instantiate ix's `RawProjRel`, derive `TrProjOK`, remove the `TrProj` sorry +origin from both audit manifests, and add projection-bearing end-to-end +fixtures. `RawProjRel.none` remains useful only for explicitly projection-free +worlds. + +## 10. Track M — finish the live metatheory + +These results are scheduled completion work, while still requiring +coordination with Mario because upstream has active research branches. + +### MT1 — route selection and sort inversion closure (L4L-16) + +Evaluate two routes in a small, focused proof branch: + +1. finish and bridge the fetched `logrel@upstream` approach + (`ShapeLogRel`, adequacy, and `Experimental/UniqueTyping`) into live VExpr + judgments; or +2. complete the current stratified `HasTypeStrong` proof directly. + +The spike must list every remaining assumption in the chosen route and close +the existing public `IsDefEqU.sort_inv` statement. Merge only that proof, its +necessary generic lemmas, and the documented route decision. Do not merge the +whole experimental branch: it changes unrelated implementation and pattern +code and still contains adequacy sorries. + +### MT2 — close remaining injectivity and weakening inversion (L4L-17) + +Building on L4L-16's completed `IsDefEqU.sort_inv`, prove the remaining public +statements: + +- `IsDefEqU.forallE_inv_stratified`; +- `IsDefEqU.sort_forallE_inv`; +- `IsDefEqU.weakN_iff` in `UniqueTyping.lean`. + +Re-run `IsDefEq.uniq`/`uniqU`, context inversion, and all downstream +`#print axioms` checks. This milestone removes ix's two remaining upstream +metatheory sorry origins. + +### MT3 — close Church-Rosser's two `.extra` cases (L4L-18A) + +The holes in `NormalEq.parRed` are the constant/application cases where a +parallel step meets a user defeq-pattern step. Use the generic `Params` +interface, L4L-10B's match inversion/non-overlap library, and rule RHS congruence to +prove the commuting diagrams. Keep the theorem generic in `[Params]`; concrete +environment assembly is a separate theorem. + +Consume the concrete `Params` package already closed by L4L-10B and check that +`ParRed.church_rosser`, normal-form +uniqueness, and the live Standardization/HeadReduction endpoint contain no +hidden placeholder assumptions. + +### MT4 — stabilize the `.extra` extension contract (L4L-18B) + +Document `.extra` as the supported hook for consumer-certified defeqs and add +the missing monotonicity/transport lemmas under `VEnv.LE`. State exactly what +an ix `NativeOracle` must prove (typedness, symmetry/closure as needed, pattern +compatibility) and what lean4lean does not trust automatically. + +## 11. Track V — finish Verify after the specifications exist + +### V1 — independent level-normalizer proofs (L4L-02A/L4L-02B) + +First prove `NormLevel.subsumption_eval` in L4L-02A. Ix's sorry-free level +normalizer uses a different representation but offers a proof decomposition to +port. Then prove the v4.31-added `NormLevel.isEquiv_wf` in L4L-02B from the +normalizer evaluation/subsumption facts and close its downstream list theorem. +Keeping these as two commits gives each upstream placeholder one exact removal +and prevents the small algorithmic invariant proof from being hidden inside a +larger checker patch. Neither proof has a technical dependency on inductive +APIs, but publication remains serialized after L4L-01E so §13 has one active +checkpoint at a time. + +### V2 — recursor reduction (L4L-19A) + +After I5 and E1, prove `reduceRecursor.WF` for Quot and inductive rules. The +proof must obtain the selected rule, match, checks, RHS translation, and result +typing from the generated/translated metadata—not from a global oracle. + +### V3 — projection/eta checker roots (L4L-15A/L4L-15B) + +Track P discharges `inferProj.WF`, `reduceProj.WF`, +`tryEtaStructCore.WF`, and `isDefEqUnitLike.WF`. Re-run the enclosing +`inferType`, `whnfCore`, and `isDefEq` theorems so the absence of a local sorry +also removes it from every exported root. + +### V4 — complete environment-to-checker theorem (L4L-19B) + +Build `TrEnv` for fixture environments containing ordinary declarations, Quot, +single/mutual/nested inductives, literals, structures, and extension defeqs. +State and audit the final executable-checker soundness theorem over this full +environment class. + +## 12. Track T — trust closure, release engineering, and upstreaming + +### T1 — make the sorry frontier shrink to zero (L4L-19C) + +Keep the token-aware script exact. Every proof PR deletes entries; no PR may +rename/move a sorry and merely update the allowlist. At zero, invert the script +to reject every live sorry without an allowlist. + +### T2 — audit and retire custom axioms (L4L-20A) + +Treat the inventory in §2.3 as an initial declaration audit, then generate the +actual transitive closure for every supported root. At minimum the root set +contains: + +- `Checked.analysis_accepted`, its closure/level/name/anatomy consequences, + `Checked.wf_of_decl`, `Checked.to_declWF`, + `VInductDecl.wf_iff_exists_checked`, `VEnv.addInduct_success`, + `VEnv.addInduct_checked`, `VEnv.addInduct_WF`, the recursive-Pi + recursor/rule-preservation roots, and every later checked-inductive/projection + API exported to ix; +- the unique-typing, Church-Rosser, standardization, and head-reduction + endpoints used downstream; +- `TypeChecker.whnf.WF`, `inferType.WF`, `checkType.WF`, `isDefEq.WF`, the + remaining public checker operations, and the final executable-checker + soundness theorem; +- every theorem name imported by ix's audit manifests. + +Generate the report rather than hand-maintaining it. Each row must record the +root, layer (`Theory`, `Verify`, or ix), standard Lean axioms, project-specific +axioms, classification from §2.3, pinned Lean revision, and disposition. Keep +normalized output under version control or as a deterministic CI artifact so +that a dependency change produces a reviewable diff. + +The first Theory rows are already enforced locally: all exported checked +structural facts, the three semantic compatibility bridges, the success/exact +analysis/collision transaction facts, and `VEnv.addInduct_success` close over +exactly `propext` and `Quot.sound`; `VEnv.addInduct_WF` and the six +recursive-Pi preservation roots additionally reach `Classical.choice`. +Compile-time `#guard_msgs` checks pin those results. No custom axiom was added +for either `Checked`, `Checked.WF`, or generalized inductive preservation. +Generalize this mechanism into the generated multi-root report rather than +replacing the local guards. + +Use four acceptance states: + +1. **Logical baseline:** `propext`, `Classical.choice`, and `Quot.sound` (usually + a subset) are accepted where required. +2. **Platform contract:** an unavoidable runtime property may remain only when + narrowly stated, named in the platform manifest, version-pinned, covered by + differential and adversarial tests, and absent from Theory roots. +3. **Transitional bridge:** a plausible opaque/reference equation has a removal + issue and may support intermediate Verify work, but cannot silently become a + release assumption. +4. **Forbidden:** an equation known false on a supported toolchain, or not yet + proved after the relevant implementation changed, may not occur in any + supported root, even if the kernel cannot reduce the opaque/native function + far enough to derive `False` internally. + +Retire the classes in risk order: + +1. Finish the cache-equation retirement started by L4L-01U. Five declarations + are gone; remove the remaining three from reachable proofs, then prove the + corrected v4.31 contracts, make the checker execute proved structural + functions, prove sufficient reachable-input invariants, or weaken the + refinement claim honestly. Merely deleting `[simp]` reduces accidental use + but does not discharge an assumption. +2. Convert the thirteen reference equations into logical definitions with + `@[implemented_by]` only when the replacement is known extensionally + correct; otherwise use the reference implementation in the verified path. +3. Replace the five collection and five opaque/layout equations with upstream + theorems or narrowly bounded/WF lemmas. Do not assume equality on malformed + states when only constructor-reachable states are needed. +4. Decide the final platform budget explicitly. The expected candidates are the + two pointer-equality implications and, if it cannot be eliminated, + `Level.instLawfulBEqLevel`; retention is a reviewed decision, not a default. + +CI must reject a new unclassified project axiom, any project axiom in a Theory +root, any forbidden axiom in a supported root, or a retained platform contract +without its manifest entry and tests. It must also reject attaching `[simp]` to +a project-specific axiom: simplifier reachability is too implicit for a bridge +contract. T2 is complete only when the report can be regenerated from a green +build and every remaining dependency is in an accepted state. + +### T3 — differential adequacy (L4L-20B) + +Add a test harness that elaborates fixture declarations with Lean, translates +the resulting raw environment metadata, constructs the justified analysis +view, and compares it with Theory generation. Run it over the fixed fixture +matrix in CI and over ix's declaration corpus at pin time. Compare failures as +data: accepted/rejected, raw/view normalization stage, generated constants, +universe lists, field counts, recursive positions, K flag, rule count, and +every RHS. + +### T4 — upstream PR series (L4L-20C) + +Keep semantic patches reviewable and dependency ordered: + +1. level-normalizer proof and small generic lemmas; +2. Theory API extraction with compatibility re-exports; +3. Stage-1/2 inductive vertical slice and fixtures; +4. indexed/normalization/small-elimination/recursive-argument support; +5. mutual and nested support; +6. pattern package and Verify `AddInduct` alignment; +7. projection structure view, laws, and checker proofs; +8. injectivity/Church-Rosser completion; +9. remaining checker and axiom-minimization work. + +Do not rewrite the published `jcb/induct` checkpoints. L4L-01U merges current +upstream into that development line once; each later upstream PR series is +then extracted onto a fresh review branch rebased on its current upstream +target. Do not mix the large Nix/fork-infrastructure delta into proof PRs +unless upstream asks for it. Record every PR and downstream pin in the +divergence ledger. + +## 13. Milestones and gates + +This is the sole status-bearing execution ladder. Exactly one milestone may be +`active`; all earlier milestones must be `complete`, and all later milestones +remain `queued`. A milestone becomes complete only when its entire deliverable +and every applicable gate below pass on one committed checkpoint. Earlier +partial implementation counts as a prerequisite, never as partial milestone +credit. A suffixed identifier such as L4L-01A is a full checkpoint with its own +commit and gates; completing L4L-01A does not confer partial completion on +L4L-01B or permit work to skip directly to L4L-01E. L4L-01U is the mandatory +upstream-integration checkpoint inserted after L4L-01B; the physical row order +is authoritative, and L4L-01C may not start before L4L-01U is complete. + +| Milestone | Status | Exact deliverable | Completion evidence and ix result | +|---|---|---|---| +| **L4L-00 — published generation-readiness baseline** | **complete** | Stabilized fork infrastructure; one generalized source/view artifact path; proof-carrying non-identity transaction; retained semantic hierarchy; complete executable generation-shape gate; AliasFormer, AnnotatedPi, and `IndexedVec` checkpoints. | Source `bbb45e0e`, ledger child `c4fd62b2`, all gates green. Ix Pin A remains the separately recorded `5e5bb767`/`1f73f5c0` pair and has removed the three former inductive sorry origins without making an oracle claim. | +| **L4L-01A — staged semantic-input consolidation** | **complete** | Introduce one source-indexed builder over explicitly verified pre-family/post-family candidate stages, strict family/constructor translations, exact raw-family insertion alignment, and the existing dependent `Produced` traversals. Return the existing `Nonempty ProducedNormalizationCandidateSemanticRun`; make no view-WF or generation-package claim. | Source `7c792209`. AliasFormer, AnnotatedPi, and `IndexedVec` use the builder; their per-root semantic-input definitions are gone and exact constructor order is retained. Existing explicit downstream witnesses and one `viewWF` proof per positive are marked temporary until L4L-01E; no choice extractor was added; focused and universal gates pass. | +| **L4L-01B — family-validation semantics and staging** | **complete** | Interpret the exact singleton `checkInductiveTypes`/family-candidate run from one verified entry context. Derive view telescope and terminal-sort WF, raw-family constant WF through candidate defeq, exact insertion, and the verified post-family candidate stage. | Source `da45b536`. Exact singleton validation semantics derive the parameter/index view split, terminal/raw-family WF, exact insertion, and post-family candidate stage. AliasFormer, AnnotatedPi, and `IndexedVec` supply no independent post-family `VEnvs`/context; family terminal, annotation, fuel, and non-sort negatives remain phase-sharp; constructors remain uninterpreted; exact guards and universal gates pass. | +| **L4L-01U — upstream v4.31 reconciliation** | **complete** | Merge digama `upstream/master` through `ef849dfbd94a` without rewriting fork checkpoints or moving either master. Retain the v4.31 proof/API ports, upstream's five custom-axiom removals, the fork's Nix/CI and certificate surfaces, and the exact classifications of `NormLevel.isEquiv_wf` (L4L-02B) and `addDecl.WF` (L4L-19B). Add no constructor-trace work. | Source `7f864b459e4a6062b468d6e5416688feac0f9f99`. The 154-job Lake build, `nix build`, current-host six-check flake build, all-system no-build evaluation, formatter, CLI replay, exact 22-entry sorry guard, and exact 29-declaration axiom inventory pass. Root guards show no supported-root trust growth. The isolated ix v4.31 probe is diagnostic only; ix migration is deferred. The source and ledger are published on origin `jcb/induct`, and only that branch moved. | +| **L4L-01C — retained constructor-validation trace** | **active** | Add dependent operational evidence for the complete successful singleton `checkConstructors` traversal: duplicate/closedness/root-check, parameter equality, field type/universe, positivity/recursive-target, and terminal-family-application steps. Prove decomposition and recomposition with the executable result. | The trace is source ordered and exact; missing/extra/reordered and each validation-phase negative remain sharp; successful trace equivalence has only the executable baseline closure and makes no Theory-WF claim. | +| **L4L-01D — constructor-validation semantics and view WF** | queued | Interpret the L4L-01C trace with verified checker refinements and retained candidate normalization. Derive `fieldsWF`, constructor result `SpineWF`, and WF of the exact analyzer-owned view declaration for the currently accepted singleton subset. | All three fixture `viewDecl_wf` proofs are deleted; no `Checked.WF`, view, or view-WF premise is renamed or reintroduced; exact axiom guards pass; no normalization or validation breadth is widened. | +| **L4L-01E — generic singleton package closure** | queued | Combine the L4L-01A–01D owner, exact dependent analysis, and `ProducedGenerationShapeCandidate` into `Nonempty ProducedGenerationCandidatePackage`, retaining the exact ordinary producer equation without granting it shape or Theory authority. | All three positives use only the generic closure theorem; missing/extra/reordered/truncated/non-defeq regressions remain sharp; no manual semantic-input/view-WF scaffolding remains; universal gates pass. | +| **L4L-02A — level subsumption evaluation** | queued | Prove `NormLevel.subsumption_eval` with its existing statement and remove exactly that sorry-frontier entry. Keep the patch independent of inductive APIs. | Focused Level and full builds pass; the theorem's exact axiom closure is accepted; the frontier drops from 22 to 21; the change is a small upstream-ready commit. | +| **L4L-02B — level equivalence soundness** | queued | Prove the v4.31-added `NormLevel.isEquiv_wf` from the evaluator/subsumption library and close the dependent list-level soundness path without changing the executable normalizer. | Focused Level and full builds pass; exact root guards add no custom axiom; the frontier drops from 21 to 20; the change is a separate upstream-ready commit. | +| **L4L-03 — singleton environment-sensitive validation parity** | queued | Complete remaining singleton `checkInductiveTypes`/`checkConstructors` acceptance behavior: pre-declaration `checkType`, transparency/fuel-correct WHNF Pi/result peeling, WHNF recursive-target traversal, and definitional constructor-parameter agreement. | A syntactically different but definitionally equal positive and a genuinely non-defeq negative match kernel outcomes and traverse the L4L-01E package/E1 path. Result-level equality across mutual families remains excluded. | +| **L4L-04 — singleton normalization differential matrix** | queued | Cover family-result, parameter/index-domain, ordinary-field, direct-recursive, and Pi-hidden recursive aliases, including beta/let, opacity/non-defeq, and fuel boundaries. | Every case compares raw payload, normalized descriptor, recursive positions, recursor, and all rules with kernel metadata and replays through E1; generic rather than fixture-only axiom guards pass. | +| **L4L-05 — singleton positivity and constructor-validity parity** | queued | Extend acceptance/rejection to the kernel matrix for nested-negative occurrences, family mentions in nonrecursive/dependent/proof fields, recursive functions, and constructor universe bounds. | Each branch has the nearest-kernel differential; all accepted cases use L4L-01E and replay through E1; no proof-only premise or oracle broadens acceptance. This is breadth/completeness, distinct from L4L-01D soundness. | +| **L4L-06A — elimination mode and recursor levels** | queued | Implement `isLargeEliminator`, `getElimLevel`, `getRecLevels`, and `getRecLevelParams`; make `ElimMode.small` constructible and drive motive/recursor generation. | Or/And have exact Prop-only recursors; Eq-like and never-zero families retain legitimate large elimination; level parameter order matches kernel metadata and all rules. | +| **L4L-06B — K-target parity** | queued | Add `isKTarget` data and generation behavior without using K to bypass invalid elimination. | Eq-like positive and non-K negative fixtures match the kernel flag, recursor, universe order, and rules; L4L-06A regressions stay green. | +| **L4L-06C — empty and singleton edge shapes** | queued | Cover empty families and zero-/one-constructor behavior, including recursor/minor/rule edge cases. | Unit/Empty and focused edge fixtures match binder/minor ordering, field counts, recursive metadata, rule count, and every RHS; preservation uses the common checked path. | +| **L4L-07 — complete one-family parity** | queued | Integrate L4L-01A through L4L-06C into the fixed I2 positive/negative matrix, remove obsolete singleton staging seams, and replay every accepted family through E1. | Nat, Bool, List, Option, Prod, Unit, Empty, Or, And, Eq, HEq, Fin, Vector, Acc, and normalization cases match all recorded kernel fields. Only one public artifact path is live; all fixture/default/Nix gates pass; L4L-11 remains queued. | +| **L4L-08A — mutual checked representation** | queued | Generalize checked analysis to dependent lists of families with shared parameters, per-family indices/results/constructors, and cross-family recursive targets. | Tree/TreeList and a mutual indexed descriptor compute with exact source order; no generation or environment insertion is claimed. | +| **L4L-08B — mutual validation and normalization** | queued | Generalize validator traces, semantic interpretation, all-family staging, normalization, and package construction to mutual blocks. | Shared-parameter/result-universe positives and mismatch/reorder negatives match kernel phases; both fixtures obtain exact semantic packages; no generated recursor claim is made. | +| **L4L-08C — mutual generation and replay** | queued | Generate/preserve all motives, flattened minors, per-family recursors, and rules; insert types, constructors, recursors, and rules in kernel order. | Both mutual fixtures round-trip actual metadata, every RHS, `Ordered`, lookups, and E1 alignment; no singleton destructuring remains public. | +| **L4L-09A — nested representation decision** | queued | Audit `numNested`/flattened auxiliary metadata and commit an additive representation or proved pre-flattening relation with executable probes and ix compatibility evidence. | The design is sufficient for real rose-tree and nested-indexed metadata; no acceptance behavior or public field is changed without demonstrated need. | +| **L4L-09B — nested transformation and positivity** | queued | Model the chosen nested transformation, auxiliary descriptors, and validation/positivity obligations. | Rose-tree/List and nested-indexed transformed descriptors plus nearest negatives match kernel acceptance; recursor generation is not yet claimed. | +| **L4L-09C — nested generation and replay** | queued | Generate/preserve auxiliary declarations, recursors, and rules and replay the nested packages. | Both fixtures round-trip real `Inductive.Add.run` output through generic packaging and E1, comparing every metadata field and RHS. | +| **L4L-10A — generated iota pattern core** | queued | Express generated LHSs as `SimplePattern.iota`; prove inversion, recovery, distinctness/nonintersection, and uniqueness obligations; port consumer-neutral shape helpers. | A certified block supplies the complete generic pattern facts with standard Theory axiom closure; no open-environment instance is installed. | +| **L4L-10B — pattern soundness and assembler** | queued | Prove `pat_wf` and assemble block-local `Params` for generated rules plus separately certified extensions. | The assembler is generic over certified extensions, has no global open-environment instance, and exposes exactly the helpers ix and Church–Rosser consume. | +| **L4L-11 — inductive oracle handoff** | queued | Generalize E1 replay to the complete I2-I4 matrix and a notation-heavy prelude environment; expose E2's consumer-neutral after/LE/WF/lookup/rule/pattern theorem; adapt ix's existing staged E2b construction to the advertised full block class. | Lean4Lean and ix are green at one recorded Pin B pair; ix constructs `InductiveOracle` from ordinary semantic world/certified block evidence for that class and removes the superseded assumed block interface where possible. No Verify state or normalization oracle crosses the Theory boundary. | +| **L4L-12A — Theory API extraction** | queued | Move VExpr-only local-declaration and literal syntax/readiness interfaces into Theory modules with compatibility re-exports; keep `FVarId`, `Lean.Expr`, and traversal in Verify. | Lean4Lean and ix build through compatibility names; no semantic assumption is removed yet; import-direction and exact axiom gates pass. | +| **L4L-12B — literal and prelude readiness** | queued | Define the exact Ordered/type/rule readiness predicate and prove literal WF, Verify-translation agreement, monotonicity, and preservation. | Ix derives and removes `literalWF`/`hlit` assumptions; notation-heavy fixtures pass; no invalid name-containment shortcut is used. | +| **L4L-13A — projection expressibility decision** | queued | Freeze seven obligations, test the current `TrProj` signature, and commit the minimal env-indexed structure-view API if required. | Real parameterized/dependent/universe fixtures demonstrate representability; missing metadata is not hidden in unconstrained existentials; ix API compatibility is recorded. | +| **L4L-13B — projection semantics** | queued | Choose recursor- or projection-constant semantics and define one faithful relation for field types, constructor reduction, congruence, lift/substitution/levels, and eta requirements. | The representation computes on real structures and makes every L4L-14 premise expressible; no structural law or checker proof is claimed early. | +| **L4L-14 — projection structural laws and Ix Pin C** | queued | Prove weakening, inverse weakening, context transport, WF, uniqueness, term substitution, and universe instantiation; bundle them as ix's `TrProjOK` and preserve compatibility theorem names. | Ix instantiates concrete `RawProjRel`/`TrProjOK`, projection fixtures pass, and the `TrProj` sorry origin is removed from both ix audit manifests at a recorded Pin C pair. | +| **L4L-15A — projection checker verification** | queued | Prove `inferProj.WF`, `reduceProj.WF`, and projection WHNF/congruence branches from the L4L-13B view and L4L-14 laws. | Focused structure/string fixtures and enclosing checker roots pass with exact axiom closures; eta/unit-like roots remain queued. | +| **L4L-15B — structure eta and unit-like comparison** | queued | Derive `tryEtaStructCore.WF` and `isDefEqUnitLike.WF`, or complete an approved metatheory change if a primitive eta rule is truly necessary. | Both roots are sorry-free and audited; any Theory-rule change has subject-reduction/injectivity/confluence and ix impact evidence. | +| **L4L-15C — Theory-only ix imports** | queued | Migrate remaining consumer-neutral lemmas and remove Verify imports from ix after L4L-12B/L4L-15B. | `rg '^import Lean4Lean.Verify' Ix/Tc/Verify` is empty; compatibility shims are removed only after both repos build. | +| **L4L-16 — metatheory route selection and sort inversion** | queued | Timebox and compare the logrel and stratified routes; enumerate all assumptions; select one route; and close the existing public `IsDefEqU.sort_inv` theorem on a focused committed checkpoint without importing the unfinished experimental branch wholesale. | The public sorry is removed with an exact accepted axiom closure; only the necessary proof and generic lemmas are merged; the chosen and discarded routes are documented with concrete remaining obligations. | +| **L4L-17 — remaining injectivity and weakening inversion** | queued | Building on L4L-16's `sort_inv`, close `forallE_inv_stratified`, `sort_forallE_inv`, and `weakN_iff`, then re-audit unique typing and context inversion. | Ix removes its two remaining Lean4Lean metatheory sorry origins at a recorded Pin D pair; affected Theory and checker roots have exact accepted closures. | +| **L4L-18A — Church–Rosser `.extra` cases** | queued | Prove both generic `NormalEq.parRed` commuting cases using L4L-10B inversion/nonoverlap and RHS congruence. | Church–Rosser, normal-form uniqueness, and live standardization/head-reduction endpoints contain no placeholder; extension-policy work remains queued. | +| **L4L-18B — extension contract** | queued | Stabilize `.extra` monotonicity/transport under `VEnv.LE` and state the exact consumer `NativeOracle` typedness/closure/pattern contract. | Generic lemmas and ix boundary build; no external defeq is trusted automatically or smuggled through generated `Params`. | +| **L4L-19A — recursor reduction verification** | queued | Prove `reduceRecursor.WF` for Quot and certified inductive rules from selected rule/match/check/RHS metadata. | Quot, singleton, mutual, and nested recursor reductions pass without a global oracle; enclosing WHNF roots have exact guards. | +| **L4L-19B — environment-to-checker closure** | queued | Prove remaining nonprojection checker refinements and full `TrEnv` over ordinary declarations, Quot, all supported inductives, literals, structures, and extension defeqs; close the executable-checker theorem. | The complete environment corpus and final checker root build with exact closures; only the mechanical zero-sorry policy switch remains. | +| **L4L-19C — zero-sorry gate** | queued | Remove every remaining supported Theory/Verify sorry and invert the frontier script to reject any new one. | Token-aware frontier is zero, no allowlist remains, full gates pass, and ix audits shrink accordingly. | +| **L4L-20A — axiom reachability and retirement** | queued | Generate transitive root manifests, classify every dependency, and eliminate all forbidden/transitional project/platform contracts. | No project axiom reaches Theory; every retained platform contract is explicitly accepted and tested; both repos' audits agree. | +| **L4L-20B — complete differential corpus** | queued | Automate actual Lean metadata translation/comparison across the fixed inductive, projection, prelude, extension, and ix declaration corpus, including failures as data. | CI compares acceptance phase, metadata, generated constants, universes, recursive positions, flags, rules, and every RHS; all supported cases pass. | +| **L4L-20C — upstream series and release** | queued | Submit dependency-ordered semantic PRs, publish coherent Lean4Lean/ix final pins, and resolve every divergence-ledger entry. | Both repos are green at final pins; each fork delta is upstreamed or has an owner, issue, and removal condition; final release artifacts and manifests are reproducible. | + +Every milestone must pass all applicable gates: + +```text +perl .github/scripts/check_sorry_frontier.pl +nix develop --command lake build Lean4Lean.Theory Lean4Lean.Verify +nix develop --command lake build +nix build +nix flake check --all-systems --no-build --accept-flake-config +nix flake check --accept-flake-config --print-build-logs +nix fmt -- --check . +git diff --check +``` + +The flake is authoritative: milestone evidence must use the pinned Nix +toolchain and dependencies. Elan or a host `lake` invocation may be used only +as a non-authoritative diagnostic and never substitutes for either Nix-wrapped +Lake build, `nix build`, or the flake checks above. + +Additionally: + +- all new fixtures build in a default proof target; +- new theorem roots have checked `#print axioms` output; +- every named root satisfies the boundary-specific axiom threshold in §2.3, + with no `sorryAx` or project-specific dependency in a Theory root; +- `rg '^import Lean4Lean.Verify' Lean4Lean/Theory` is empty; +- every source/view pair accepted by the public checked transaction is + generated and preserved by the same artifact path; temporary + direct/generalized or raw/normalized migration functions are not both + semantically live at a checkpoint; +- touched existing Theory names are grepped in ix before merge; +- the kernel differential matrix is green for inductive/projection changes; +- at an ix pin, `lake update lean4lean`, full `lake build IxTcVerify`, and both + audit executables pass with shrink-only sorry-origin edits. + +The retired C0-C8 grouping maps to this ladder as follows: C0 = L4L-00; +C1 = L4L-01A through L4L-07; C2 = L4L-08A through L4L-09C; C3 = +L4L-10A/L4L-10B/L4L-11; C4 = L4L-12A/L4L-12B plus L4L-15C; C5 = +L4L-13A through L4L-15C; C6 = L4L-16 through L4L-18B; C7 = L4L-02A/L4L-02B plus +L4L-19A through L4L-19C; and C8 = L4L-20A through L4L-20C. These mappings are +historical cross-references, not alternative completion gates. + +## 14. Ix pin and migration protocol + +Pin A is complete and belongs to L4L-00. Pin B is the exit of L4L-11, Pin C +the exit of L4L-14, and Pin D the exit of L4L-17. L4L-12A/L4L-12B and +L4L-15A–L4L-15C also require ix migrations, but they shrink API/import debt +rather than create a new numbered semantic pin. L4L-20C records the final +release pair. + +L4L-01U is an upstream/toolchain integration checkpoint, not a numbered ix +pin. Its isolated v4.31 probe establishes that merged Lean4Lean modules replay +and the consumer-facing runtime modules elaborate; it does not require this +repository to port ix's own ByteArray, Batteries `RBTree`, or proof-library +APIs. Perform that migration in ix at the next authorized pin and keep its +worktree, lockfile, and branch out of Lean4Lean commits. + +For every Pin A-D: + +1. Publish a green lean4lean commit and record its full hash. +2. Set ix's lean4lean dependency to that exact fork hash (or the equivalent + upstream hash once merged), update the lockfile, and record the manifest + pair. Do not assume the preceding pin or remote still names the intended + source tree. +3. Build the complete verification target, not only `lake build ix`. +4. Inspect audit diffs. Delete disappeared sorry origins; investigate any new + axiom before allowlisting it. +5. Add the new API usage and compatibility import in ix. +6. Only after both repos are green, delete ix-side copies/assumptions and old + lean4lean shims. +7. Record the known-good revision pair and the remaining demand-ledger rows. + +The following stay in ix: `KExpr`/addresses/Blake3/collision freedom, +`KVLCtx`, K-expression substitution and universe instantiation, the `TcM` +Hoare layer, `Methods` knot, catalog/cache/world provenance, execution proofs, +and `NativeOracle`. Move proof *techniques* or VExpr-generic lemmas, not +consumer-specific state. + +## 15. Principal risks and decision points + +- **Checkpoint/pin drift.** The generalized one-family generator, + recursive-Pi proof, public transaction, `Acc` replay, paired normalization + boundary, complete mixed preservation, public artifact switch, normalized + Verify trace, checked normalization/type-check producers, complete checked + alias generation certificates, six actual-metadata replays, context-indexed + candidate provenance, existential checker-output translation recovery, + exact verified candidate root/binder contexts, and annotation-complete + recursive certification, singleton candidate-list normalization, generic + candidate-spine extraction, dependent generation assembly, and the complete + AnnotatedPi recursive-Pi annotation replay, plus the certified public + non-identity consumer boundary and exact whole-call produced packages for + both AliasFormer and AnnotatedPi, plus generic parameter/index family + validation, the exact real `IndexedVec` family/constructor candidates, its + complete outer producer equation, generic exact identity replay, complete + produced semantic package, certified transaction, and checked E1 replay are + joined by generic arbitrary-length operational list assembly, a generic + source/candidate-indexed outer produced-package constructor, automatic + source-ordered semantic hierarchy assembly under `Nonempty`, and + semantic-owned generation/package projections. Exact checked decomposition, + singleton family-view recovery, one post-family constant typing proof, and + checked constructor-result spines now derive every view telescope and + terminal typing judgment without fixture oracles. Exact analyzer success now + also determines normalization identity, and retained semantic evidence + reconstructs post-family WF; no fixture supplies either fact. Exact analysis + plus minimal stored-spine/count shapes now also determine raw/check family + identity, normalized pair identity and source order, all raw + telescope/results and view terminals, and the complete dependent constructor + list. The consolidated generation-readiness gate now checks this complete + hierarchy at runtime, rejects missing or extra raw constructors, and lets + exact dependent analysis plus analyzer-owned view WF derive checked WF and + every per-position shape record. `IndexedVec` proves the automatic hierarchy + retains both constructors in exact source order and that a swapped view fails + the computational normalization-shape gate. All three fixtures retain exact + strengthened-producer results without treating bare producer success as + semantic authority. L4L-01A additionally consolidates the staged semantic + inputs while retaining the exact source order and intentionally returning + the hierarchy only under `Nonempty`. L4L-01B derives raw-family WF, exact + insertion, and the post-family candidate stage from the singleton family + validator, so no positive supplies an independent post-family context. The + current source is the L4L-01U merge + `7f864b459e4a6062b468d6e5416688feac0f9f99`, whose parent pair and + publication evidence are recorded in §13 and this ledger child on + `jcb/induct`. The exact + 22-entry sorry-frontier check, 154-job default Lake build, default Nix build, + all six current-host flake checks, all-system no-build evaluation, formatter, + CLI replay, and whitespace checks were rerun on 2026-08-04 over that source. + Exact compile-time guards show that the new generic and fixture roots add no + axiom; their broad Verify closure remains explicitly transitional. Pin A + uses the earlier certificate-bearing `5e5bb767` checkpoint, paired with local + ix snapshot `1f73f5c0`; keep that pair and this later producer checkpoint + recoverable, require the corresponding Linux/Darwin CI builds at a pin or + release boundary, and record any replacement hash in both roadmaps. +- **A subset masquerading as the spec.** A sorry-free `stageN` definition can + still be incomplete. Final acceptance is kernel coverage plus negative + agreement, not the absence of sorries. +- **Analyzer/artifact drift.** This failure mode is now guarded rather than + present for the raw-normal-form subset: recursive-Pi analysis, public + `Checked` accessors, preservation, transaction output, and Verify metadata + all use the generalized artifacts. `NormalizedChecked` now pairs the raw + singleton payload and view classification; constructor-level raw field + pairing, the complete mixed generator, the public identity specialization, + and normalized Verify replay now close the artifact/transaction part of this + risk. The checked equality/type/certificate layer, generic candidate + generation assembler, and candidate-derived AliasFormer and `AnnotatedPi` + transactions are live, and the staged whole-candidate non-defeq rejection is + pinned. AliasFormer and AnnotatedPi exact whole-call results now select their + produced semantic packages. Published checkpoint `cf3d5a47` does the same + for `IndexedVec`'s parameter/index/two-constructor declaration and carries + the certificate through checked E1 replay. Automatic produced semantic + hierarchy assembly and semantic-owned package projections now close the next + ownership seam. The strengthened hierarchy gate now derives checked WF and + all structural generation alignment; constructing the verified per-position + inputs and analyzer-owned view WF from a general verified outer context and + its exact traversals remains. + Retain public `Acc` checks, + every actual-rule-RHS equality, and the + alias fixtures as regressions; older direct/raw-only definitions must remain + compatibility specifications only or be removed after migration. +- **Normalization as an accidental oracle.** Shape equality alone does not + justify a rewritten declaration, and whole-type defeq alone does not identify + the raw binder positions needed by generation. Require `Normalization.WF`, + a structural raw/view pairing, and derivation from ordinary checker or + consumer defeq evidence. A runtime comparison with opaque + `consumeTypeAnnotations` is a producer consistency check, not a theorem and + not semantic authority. Never accept an arbitrary view supplied by Verify or + ix, and never repair a missing reduction theorem with a custom axiom. +- **Raw de Bruijn scaling.** Indexed, mutual, and recursive-Pi rules multiply + lift/inst arithmetic. The shared checked descriptor is now consumed by one + generalized public path. Preserve that architecture while adding + broader WHNF/defeq witnesses, complete positivity, and mutual recursion; continue + moving normalized evidence into the descriptor and telescope lemmas rather + than duplicating index calculations. +- **Projection API insufficiency.** The present `TrProj` signature may make a + faithful, functional semantics impossible. Resolve P0 explicitly instead of + hiding metadata in an oracle or preserving a false “frozen statement” rule. +- **Structure eta may change Theory.** A new defeq constructor would affect + injectivity, confluence, standardization, and ix. Require a design proof and + upstream agreement before adding it. +- **Research-branch optimism.** `logrel@upstream` is evidence of a viable path, + not a drop-in solution. Measure its remaining adequacy/bridge debt with the + exact live theorem as the spike gate. +- **Unsound bridge axioms.** Some current cache equations are documented false. + Zero sorries is not a soundness claim until final-root axiom reachability is + clean. +- **Fork/consumer drift.** The published `jcb/induct` development branch is + ahead of both master and ix's recorded Pin A checkpoint at `5e5bb767`. Keep + pinning coherent checkpoints and recording revision pairs; do not wait for + the final research milestone. +- **Upstream collision.** L4L-01U reconciles the 2026-08-03 + `upstream/master` tip `ef849dfbd94a` as a real merge parent, including the + overlapping inductive/checker/Verify/level files. Repeat the ancestry and + overlap check at every later milestone boundary; if upstream advances again, + insert another explicit integration checkpoint rather than hiding merge work + inside a semantic milestone. Retain this roadmap's fixtures, consumer + contracts, and trust gates when adapting overlapping upstream work. +- **Scope leakage from Experimental.** Experiments are useful sources, but no + supported root may import them. Promote a proof only after removing its + experimental sorries and giving it a stable API. + +L4L-01A and L4L-01B are complete at `7c792209` and `da45b536` +respectively. The repeated semantic-input plumbing sits behind one +source-indexed staged owner, and exact family-validation semantics derive its +post-family stage; all three positives use it and the result deliberately +stops at `Nonempty ProducedNormalizationCandidateSemanticRun`. L4L-01U +reconciled live upstream and Lean v4.31 without starting semantic constructor +work. Active milestone L4L-01C now retains the constructor-validation execution +without making a Theory-WF claim; constructor-validator semantics/view WF and +produced-package closure remain L4L-01D and L4L-01E. +`VEnv.addInductGeneration`, its exact data-bearing trace and stable +consequences, normalized preservation, environment histories, the ordered +identity bridge, delegated public success/WF roots, all six earlier +actual-metadata replays, and the `AnnotatedPi` recursive-Pi annotation replay +are green and exactly guarded. The generic candidate layer now also +extracts family/constructor telescopes and results and assembles +`GenerationChecked.WF`: `CandidateExprRun.spineEvidence` preserves exact raw +emitted binders, `TelResultDefEqEvidence.replacePrefix` handles the +declared/emitted constructor parameter bridge, and `GenerationCandidateRun` +folds the exact dependent family/constructor evidence. AliasFormer's real +candidate and AnnotatedPi's nested candidate supply complete checked generation +certificates and `AddInductTrace`/`TrEnv'` replays through this path. AliasFormer +now additionally proves the exact whole executable call and supplies both +consumers from `aliasFormerProducedGenerationCandidatePackage`. +AnnotatedPi additionally pins the generated recursor and iota rule while +retaining the raw annotation syntax. AliasRec remains the +compositional constructor-normalization specification until its candidate +list is migrated; neither fixed alias is authority for arbitrary metadata. +The published `IndexedVec` result selects the exact parameter/index family and +ordered `nil`/`cons` traces. Its recursive identity witnesses and +`spineOfIdentity` bridge assemble their `GenerationCandidateRun`, produced +package, certified transaction, and checked E1 replay without a second +executable producer implementation. + +The executable candidate producer and the exact AliasFormer, AnnotatedPi, and +`IndexedVec` operational proofs are the base for L4L-01A through L4L-01E. +`AddInductive.normalizeCandidateExpr` traverses arbitrary metadata with the +same configured checker full check, WHNF, and inductive fuel, including Pi +domains and bodies under the exact annotation-consumed local declarations +used by the kernel. Each position is fully checked before WHNF. Every Pi also +retains a structural annotation path and an exact successful raw-to-consumed +`isDefEq` run before its body context is extended. The producer separately +checks runtime agreement with Lean's executable but opaque +`consumeTypeAnnotations`; the retained certificate does not treat that test as +semantic evidence. `CandidateExpr` retains the complete +checker context, source, inferred type, WHNF result, Pi-domain/body position, +and all three kinds of exact checker-run equality; dependent lists retain +source family and constructor positions. +`buildNormalizationCandidate` repeats the existing family/constructor checks, +computes families in the input environment, inserts the raw family +declarations, and computes constructors only in the resulting post-family +environment. Its source-indexed result is still untrusted. Such a candidate +becomes a Theory normalization only after exact root translations, +verified contexts, and positional list runs are supplied. The actual +`AliasFormer` and `AnnotatedPi` family and constructor metadata prove their +whole calls equal the candidates enclosed by their checked semantic packages; +`IndexedVec` encloses the corresponding exact whole candidate equality in its +semantic package and routes both consumers through it. All three retain operational regressions +against verified checker runs, with inherited axiom closures guarded. +`CandidateWhnfStep.innerRun` recovers the erased final checker state, and +`WhnfRun.ofCandidateStep` attaches the matching verified context and strict +translations; the AliasFormer family certificate now exercises this complete +adapter. `CheckTypeRun.ofCandidateStep` supplies the parallel bridge for every +retained full check, and the AliasFormer pre-family and post-family checks now +exercise it. `IsDefEqRun.ofCandidateStep` supplies the third bridge for every +consumed binder domain and refines the exact successful run to Theory +`IsDefEqU`. + +The generic semantic half is now explicit as well. Pi traces are recursively +context- and source-indexed at the raw domain and exact instantiated body; the +body index fixes the actual annotation-consumed local-context extension and +generated free variable. `candidateTypeAnnotation_exists_translation` +extracts the consumed domain's strict translation from the raw wrapper +application, and the exact `IsDefEqRun` relates their Theory endpoints. +`CandidateNodeRun.ofCandidate` pairs each retained full check and WHNF, while +`CandidateNodeRun.exists_ofCandidate` extracts both returned +translations from the verifier refinements after receiving only the matching +context and root source translation. `CandidateExprRun.evidence` folds +terminal and Pi nodes into the existing `DefEqEvidence` language, transporting +body typing and equality between raw and consumed binder contexts before +forming congruence over the raw Pi syntax. Its Pi case also uses unique typing +and explicit type transport, so checker-inferred aliases need only be +definitionally equal to the structural sorts rather than syntactically +identical to them. +`CandidateExprRun.source_tr` and `.view_tr` tie both endpoints back to kernel +syntax; the Pi case abstracts the retained free variable and transports the +body translation across the definitionally equal raw, consumed, and +normalized binder contexts. Exact guards pin the construction, +interpretation, and translation closures. `CandidateExprTrace.storedSpine` +additionally requires each raw emitted Pi to survive as the same outer Pi; +`spineEvidence` then accumulates pointwise binder equality, the terminal +result, and exact telescope length. AliasFormer's actual candidate trace now +supplies both its `NormalizationRun` and complete candidate-derived +`GenerationRun` through this interpreter. AnnotatedPi exercises the same +interpreter recursively through a raw `outParam Prop` domain, its consumed +`Prop` view, and the nested recursive target. +`CandidateExprIdentity` and `CandidateExprRun.exists_ofIdentity` now provide a +second, stricter interpretation for traces whose raw and normalized syntax are +identical at every recursive position. The current `IndexedVec` work proves +that invariant for the family and both constructors and turns the resulting +root runs into generation-ready spine evidence. + +Singleton candidate-list normalization and generation assembly are now +complete. `CandidateList.singleton` +eliminates only the source-indexed singleton shape; `CandidateExprRootRun` +relates explicitly named raw/view endpoints to the exact recursive candidate; +`CandidateConstructorListRun` folds every constructor position into +`List.Forall₂`; and `NormalizationCandidateRun` constructs both the Theory +`Normalization` and its semantic `NormalizationRun`. AliasFormer reuses one +verified pre-family root and the exact post-family verified constructor root, +its resulting view passes dependent checked analysis, and its previously +hand-assembled normalization run now delegates to this generic boundary. A +truncated constructor view is rejected by `normalization?` before transaction +construction. `CandidateFamilyGenerationRun` aligns the family components; +`CandidateNormalizedCtorRun` derives both declared and emitted constructor +paths; `CandidateNormalizedCtorListRun` preserves every source position; and +`GenerationCandidateRun.wf` produces the existing Theory certificate. Every +new structural, operational, and semantic root has an exact axiom guard. +AnnotatedPi now proves this boundary scales past AliasFormer's terminal alias: +its constructor has a nonempty emitted telescope, a recursive target below a +Pi, and an actual `outParam` binder domain. The ordinary checker full-check, +WHNF, and raw-to-consumed equality traces pass `storedSpine`, yield the nested +telescope/result evidence, assemble `GenerationCandidateRun.wf`, and replay +the final environment, recursor, and iota rule. + +The matching whole-candidate negative is now green. It reuses the actual +AnnotatedPi family/constructor metadata in an environment where `outParam` has +the correct type but is opaque. Metadata staging reaches candidate traversal; +the raw/consumed equality check then returns the dedicated binder-domain error +before any semantic package or transaction exists. Retain it with the four +leaf annotation positives, exact non-defeq leaf negative, truncated-view +rejection, and positive AnnotatedPi replay so the failure phase remains sharp. + +The dependent consumer package and public transaction are now complete. +`GenerationCandidatePackage` contains the exact source-indexed candidate, +successful normalization/dependent analysis, `GenerationCandidateRun`, and +resulting `GenerationChecked.WF`; it alone supplies both the Theory +`GenerationCertificate` and Verify `AddInductTrace`. AliasFormer proves the +terminal-alias consumer is adequate and AnnotatedPi proves the nested +recursive-Pi/annotation consumer is adequate. `addInductCertified` is the +proof-erased non-identity Theory path, while `addInduct` remains the identity +compatibility theorem. + +The first three outer producer instances are complete. AliasFormer and +AnnotatedPi explicitly reduce `checkInductiveTypes`, preserve the exact module +header while inserting the raw family, validate their constructors in the +post-family environment, and assemble dependent singleton lists. AnnotatedPi +additionally traverses a nested recursive Π and consumes an `outParam` +annotation under exact raw-to-consumed definitional equality. `IndexedVec` +extends the same path through one parameter, one index, and an ordered +dependent `nil`/`cons` list using exact recursive identity witnesses. Each +`ProducedGenerationCandidatePackage` encloses the semantic package assembled +from those same retained runs, and its Theory certificate plus Verify replay +both project from it. The proofs use exact candidate equality rather than a +coercion or erasure equality. Separate guards cover whole-call computation, +the combined produced packages, semantic certification, and the public +transactions. + +The operational ordered-list subproblem is now generalized. The +former public reduction seam, +`checkInductiveTypes_singleton_zero_of_whnf_sort`, handled only a +zero-parameter singleton whose family immediately WHNFs to a sort. The generic +`checkInductiveTypes_singleton_of_candidate` theorem now replays arbitrary +parameter/index splits from a source-indexed candidate spine, and the real +`IndexedVec` family proves the one-parameter/one-index case. The exact +post-family `nil`/`cons` candidate list, complete outer producer equation, +semantic run, produced package, and E1 replay are published. Generic dependent +`Produced` witnesses now reconstruct family-type lists, arbitrary ordered +constructor lists, and complete family lists from exact per-position results; +all three outer fixtures use them, and `IndexedVec` demonstrates a list of +length two. `GenerationCandidateSemanticRun.producedPackage` now generically +performs the final outer packaging step from the same semantic owner, and all +three fixtures use it. `CandidateExprSemanticRootInput`, the dependent semantic +constructor/family/normalization inputs, and `.exists_ofProduced` automatically +assemble the complete source-ordered hierarchy from the operational `Produced` +witnesses plus exact verified per-position contexts/translations, returning it +under `Nonempty`. Semantic family/constructor generation wrappers project from +that hierarchy rather than accepting parallel roots or spines. View telescopes +and terminal typing are now derived from exact checked shape, one family +constant typing proof, and checked constructor result spines. Exact dependent +analyzer success now derives normalization alignment, and the retained verified +context plus raw/view equality and exact insertion derive post-family WF. +`GenerationCandidateSemanticShapeRun` now additionally derives raw/check family +identity, every normalized constructor pair and its exact source order, raw +telescope/results, view terminals, and the dependent constructor list from +analysis plus minimal stored-spine/count shapes. The consolidated +generation-readiness checkpoint now checks all of those shapes once over the +complete family/constructor hierarchy, retains the gate with the exact ordinary +producer equation, and derives checked WF plus every dependent shape record +from exact analysis and analyzer-owned view WF. L4L-01A consolidated verified +per-position inputs over two verified stages; L4L-01B derived the second stage +from family validation; L4L-01U reconciled and published the live-upstream +merge; active milestone L4L-01C now +retains constructor validation; L4L-01D derives analyzer-owned view WF; and +L4L-01E combines the +result with the strengthened gate to return the complete produced package +without fixture-specific alignment. Only +Theory-level generation, lookup, +ordering, pattern, and semantic facts—not checker state or a normalization +oracle—should be exposed to ix. + +After L4L-01E, follow §13 without skipping: close the two isolated level proofs +in L4L-02A and L4L-02B; complete singleton environment-sensitive validation, +normalization, +positivity, elimination, K, and integration in L4L-03 through L4L-07; then +advance through mutual L4L-08A–08C, nested L4L-09A–09C, pattern +L4L-10A/L4L-10B, and oracle handoff L4L-11. The identity and alias kernel equalities remain the computational +regression gate, and every newly accepted family replays through E1 in its +own milestone. The completed generalized public path, `Acc` +transaction/replay, recursive-Pi kernel-rejection differentials, +environment-free universe/result/name/collision matrix, semantic `Checked.WF` +and `GenerationChecked.WF` bridges, and exact axiom closures remain regression +gates. + +The current formalization source is the L4L-01U merge +`7f864b459e4a6062b468d6e5416688feac0f9f99` of +`da45b536220a3eff5ed78cf2f5afcf5e7491c40f` and upstream +`ef849dfbd94a`; this publication ledger child records the immutable source hash +on `argumentcomputer/lean4lean`'s `jcb/induct` branch. Neither local `master` +nor `origin/master` is moved by this work. On top of automatic produced +semantic-hierarchy assembly and +semantic-owned generation/package projections, it derives exact family and +constructor shape, candidate view telescopes, family terminal typing, and all +constructor result-target typing generically. AliasFormer, AnnotatedPi, and +`IndexedVec` no longer supply `viewTel`, `rightType`, `normalization_eq`, or +`typeEnv_wf`: their exact dependent analyzer equations determine normalization +identity, and verified context/equality/insertion evidence reconstructs the +post-family environment. They also no longer supply normalized pairs, raw +telescope/results, view terminals, or dependent-list alignment: exact analysis +and minimal stored-spine/count shapes determine all of those generically. Exact +analysis and WF of the analyzer-owned view declaration now derive checked WF +and all per-position shape records from one complete executable hierarchy gate; +the fixtures no longer supply either class of evidence. Missing and extra raw +constructor lists are rejected. Exact axiom guards pin the executable roots to +the standard logical baseline and the semantic roots to the existing +transitional sets. Completed milestones L4L-01A and L4L-01B consolidate the +verified staged semantic inputs and derive the post-family stage from exact +family-validation semantics. Completed L4L-01U reconciles the current +upstream/toolchain/axiom delta without beginning constructor work. Active L4L-01C +retains the exact constructor-validation trace without making a Theory-WF +claim; the temporary fixture view-WF proofs remain until L4L-01D, and the +complete produced package is intentionally deferred to L4L-01E. No stage may infer +shape or Theory meaning from bare producer success. Ix Pin A is complete at the +recorded pair Lean4Lean `5e5bb767b3491d21a71908d4c58bcbaa007283bb` +and local ix snapshot `1f73f5c016907eadb8ed0dc86ac65b07eb24a145`. +Pin B is exactly the L4L-11 exit and therefore waits for L4L-01U and L4L-01A +through L4L-10B, including full single/mutual/nested breadth and the +generated-pattern +package. No intervening milestone may paper over a gap with a new oracle +assumption or broaden the accepted axiom budget. diff --git a/upstream-divergence.md b/upstream-divergence.md index 1832e1c2..3bfd20f1 100644 --- a/upstream-divergence.md +++ b/upstream-divergence.md @@ -4,29 +4,126 @@ This file tracks every deliberate semantic, API, build, or verification delta from `upstream/master` that must either be upstreamed or explicitly retained. It is the tracked counterpart to `plans/roadmap.md`. -Audit baseline (2026-07-30): +Audit baseline after the generation-readiness checkpoint (2026-08-03): - upstream: `0c38ab8` -- committed local checkpoint: `efb2a2b2eb95` (12 commits ahead) -- active worktree: green Stage-3 direct-indexed inductives, the current I2 - structural and semantic checked descriptor, the I1 Theory transaction API, - E1 core Verify alignment, and replay-driven Nat/Eq/index-changing-`IndexedVec` - environment fixtures; not yet committed or published +- published semantic checkpoint: + `cf3d5a47d35867e0e6ebe023c0803982e3e36cd1` (33 commits ahead of upstream) +- first published documentation child: + `d35a2f6c94212faae20d5a03341b138bb0e22d36` + (`docs: record IndexedVec semantic checkpoint`; 34 commits ahead of + upstream). It changes only this ledger relative to `cf3d5a47`. +- source-indexed list checkpoint: + `c9e4ae2d26f28e0adb0c21ffde0e11b42bb691c2` + (`feat: generalize candidate list production`; 35 commits ahead of upstream; + 32 files changed, 38,205 insertions, and 59 deletions) +- generic produced-package checkpoint: + `a7d101b5e16f1258c6f5c2a7ea08e55f45eb17f1` + (`feat: generalize produced candidate packaging`; 37 commits ahead of + upstream; 3 files changed, 49 insertions, and 30 deletions) +- retained semantic-hierarchy checkpoint: + `f0caf16c5788d094fdbf1e990884c0c061d6fc75` + (`feat: retain candidate semantic hierarchy`; 39 commits ahead of upstream; + 3 files changed, 432 insertions, and 111 deletions) +- produced semantic-hierarchy checkpoint: + `e3cf22d293b081ba11be63e910d0d1e1510a042f` + (`feat: assemble produced semantic hierarchy`; 41 commits ahead of upstream; + 3 files changed, 608 insertions, and 39 deletions) +- semantic-hierarchy ownership checkpoint: + `7e5f4f7715cf71be8d09a583f0ec0d8f7aa02e72` + (`feat: harden semantic hierarchy ownership`; 42 commits ahead of upstream; + 3 files changed, 670 insertions, and 25 deletions) +- structural generation-evidence checkpoint: + `2b1d802fc6796e7317ec1d24708a3ebdda416655` + (`feat: derive structural generation evidence`; 44 commits ahead of upstream; + 4 files changed, 445 insertions, and 100 deletions) +- generation analyzer-provenance checkpoint: + `a64fe982bc2a7f1c6c34ec82565ec5fe1c26350b` + (`feat: derive generation analyzer provenance`; 46 commits ahead of upstream; + 4 files changed, 138 insertions, and 22 deletions) +- generation shape-alignment checkpoint: + `5aa9ab69fce1c7dab3f4ca357f6ed8f349fd9397` + (`feat: derive generation shape alignment`; 48 commits ahead of upstream; + 3 files changed, 458 insertions, and 180 deletions) +- consolidated generation-readiness checkpoint: + `bbb45e0e950724cdbbd405d75e304e2020cecf82` + (`feat: consolidate generation readiness`; 50 commits ahead of upstream; + 3 files changed, 701 insertions, and 98 deletions) +- fixed fork master: `1fb7d6ef9042c5a80b2de9320c88ac0f3ce404cb` + on local and `origin/master` +- audited source checkpoint: `bbb45e0e` builds on the exact arbitrary-length + producer witnesses and source-indexed semantic inputs that return a + `Nonempty ProducedNormalizationCandidateSemanticRun`. The retained checker + selects every Theory view; callers provide verified contexts and strict + source translations, never a view. Semantic generation wrappers project + family and constructor spines from that same hierarchy, so normalization, + generation, packaging, and produced packaging cannot substitute parallel + roots. AliasFormer, AnnotatedPi, and `IndexedVec` all use this ownership path. + `IndexedVec` additionally proves that automatic assembly preserves its exact + `nil`/`cons` order and rejects a swapped view at the computational shape + gate. Exact compile-time guards cover the generic constructors, projections, + and fixture roots. Exact checked family/constructor shape now recovers every + candidate view telescope; the checked family result level supplies family + terminal typing; and one typed post-family family constant plus each checked + constructor-result spine supplies every constructor target judgment. + AliasFormer, AnnotatedPi, and `IndexedVec` no longer provide `viewTel` or + `rightType`; the former circular `IndexedVec` terminal-typing helpers are + deleted. `GenerationCandidateRun` now retains the exact successful dependent + `generation?` equation instead of a fixture-provided normalization equality. + Theory proves that successful `check?` and `generation?` results retain their + analyzed normalization, so the candidate/analyzer normalization equality is + derived generically. Verify also reconstructs post-family `VEnv.WF` from the + verified pre-family context, candidate raw/view definitional equality, + checked family typing, and exact raw-family insertion. AliasFormer, + AnnotatedPi, and `IndexedVec` therefore provide neither `normalization_eq` nor + `typeEnv_wf`; each supplies only its exact analyzer-success equation. The new + reduced generation-shape boundary also prevents fixtures from choosing + normalized constructor pairs or supplying raw/view component equations. + Exact analysis determines the raw family, checked family view, complete + normalized constructor list, and every positional raw/view pairing. A total + stored-spine count then determines each raw telescope and result, while + checked shape determines each view terminal. The source-indexed recursive + assembler preserves the analyzer's full constructor order without `zip`, + lookup defaults, truncation, or reordering. AliasFormer, AnnotatedPi, and + `IndexedVec` no longer supply checked WF or any per-family/per-constructor + shape records. A strengthened executable producer retains the exact ordinary + producer equation together with one complete generation-spine check over + the family and constructors. Exact dependent analysis plus WF of the + analyzer-owned view declaration derives checked WF, and the one Boolean gate + derives every + positional stored-spine/count record without `zip` or truncation. Bare + producer success is deliberately not treated as semantic or spine-shape + authority. The exact 20-sorry frontier, focused direct compiles, 157-job + default Lake build, 124-job Theory/Verify and Nix proof builds, default Nix + build, all six current-host flake checks, all-system no-build evaluation, + formatter, Theory import-boundary, and whitespace checks pass at that + checkpoint. Use the branch ref, not a detached Git `HEAD`, for published-fork + comparisons. -Status vocabulary: `local-committed`, `worktree`, `submitted`, `upstreamed`, -or `intentional-fork`. An entry is removed only after its removal condition is -met and every consumer has moved to the replacement. +Status vocabulary: `worktree`, `local-committed`, `published-fork`, `submitted`, +`upstreamed`, or `intentional-fork`. `published-fork` means pushed to an +Argument Computer fork branch but not yet submitted upstream. An entry is +removed only after its removal condition is met and every consumer has moved +to the replacement. ## D001 — Nix packaging and downstream artifacts -- **Status:** local-committed -- **Commits:** `e4c46ec`, `29d017f`, `5ad48f9`, `ae43b7b` +- **Status:** published-fork +- **Commits:** `e4c46ec`, `29d017f`, `5ad48f9`, `ae43b7b`, plus the + all-system evaluation repair in `5e5bb76` - **Delta:** flake packaging, full Lake dependency artifacts, downstream - consumer/CLI checks, lock deduplication, and Linux/Darwin CI. + consumer/CLI checks, lock deduplication, and Linux/Darwin CI. The current + flake reuses `inputs.self.outPath` for the Lake source so evaluation never + depends on an unrealized nested `fileset.toSource` store path. - **Ix impact:** supplies the proof-bearing artifact needed by `IxTcVerify` and makes a pinned fork reproducible in Nix. -- **Tests:** `nix flake check --accept-flake-config --print-build-logs`; +- **Tests:** + `nix flake check --all-systems --no-build --accept-flake-config`; + `nix flake check --accept-flake-config --print-build-logs`; `downstream-consumer`, `cli-smoke`, `cli-smoke-external`, and `cli-noarg`. +- **Remaining local debt:** restore narrow source invalidation without + reintroducing an evaluation-time unrealized path. This is a build-efficiency + optimization, not a correctness or ix-pin blocker. - **Upstream issue/PR:** TBD; split packaging and CI into independently reviewable PRs. - **Removal condition:** upstream publishes equivalent full dependency and @@ -34,7 +131,7 @@ met and every consumer has moved to the replacement. ## D002 — replay teardown safety -- **Status:** local-committed +- **Status:** published-fork - **Commit:** `4a55f8d` - **Delta:** avoid the `replayFromImports` teardown segfault. - **Ix impact:** makes executable environment replay reliable when ix or its @@ -46,7 +143,7 @@ met and every consumer has moved to the replacement. ## D003 — multi-part olean replay deduplication -- **Status:** local-committed +- **Status:** published-fork - **Commit:** `7c9ed2c` - **Delta:** skip constants already imported while replaying multi-part oleans. - **Ix impact:** prevents false duplicate-name failures when constructing an @@ -58,7 +155,7 @@ met and every consumer has moved to the replacement. ## D004 — case-insensitive current-module inference -- **Status:** local-committed +- **Status:** published-fork - **Commit:** `d81fd04` - **Delta:** infer the current module without a case-sensitive path/name assumption. @@ -71,8 +168,8 @@ met and every consumer has moved to the replacement. ## D005 — exact sorry-frontier enforcement -- **Status:** local-committed, wording updated in worktree -- **Commit:** `c8a9ef8` +- **Status:** published-fork +- **Commits:** `c8a9ef8`, with the current Stage-3 wording in `472a6f0` - **Delta:** token-aware, declaration-attributed allowlist excluding `Experimental/`, wired into Nix and CI. - **Ix impact:** guarantees that upstream proof debt can only shrink at pin @@ -85,23 +182,25 @@ met and every consumer has moved to the replacement. ## D006 — staged computational inductive semantics -- **Status:** Stage 1/2 local-committed; Stage 3 worktree -- **Commits:** `71f2eae`, `06e904d`, `201c12f`, `efb2a2b`; Stage-3 delta is - currently uncommitted. -- **Delta:** replace the three placeholder inductive declarations with a real - `VInductDecl.WF`, computational `VEnv.addInduct`, generated recursor/iota - rules, and a sorry-free `addInduct_WF`. Stage 3 supports one family with - parameters, indices, direct recursive fields, never-zero or syntactically - subsingleton large elimination, typed index spines, closed metadata, and - pairwise-distinct generated names. Acceptance is now descriptor existence; - see D009 for the shared analysis API. +- **Status:** published-fork +- **Commits:** `71f2eae`, `06e904d`, `201c12f`, `efb2a2b`, and the generalized + single-family integration in `472a6f0` +- **Delta:** replace the three placeholder inductive declarations with real + `VInductDecl.WF`, computational generation, generated recursor/iota rules, + and sorry-free preservation for the accepted class. The published + single-family path supports parameters, indices, index-changing recursion, + recursive targets below positive Pi telescopes, raw/view normalization, + mixed raw-syntax-preserving artifacts, and a traced normalized transaction. + Acceptance is the dependent descriptor from D009. This remains an + underapproximation: full positivity, small elimination, K, mutual blocks, + nested inductives, and the complete differential matrix are not implemented. - **Ix impact:** discharges ix gap A1's three upstream `sorryAx` origins and is the semantic basis for constructing `InductiveOracle`; current breadth is not yet enough for all ix blocks. -- **Tests:** exact Nat, Bool, List, Prod, Option, Eq, HEq, and index-changing - `IndexedVec` recursor/iota fixtures; negative Or, duplicate-name, and - loose-variable fixtures; Theory/Verify build; full flake check; - `VEnv.addInduct_WF` axiom guard. +- **Tests:** exact Nat, Bool, List, Prod, Option, Eq, HEq, index-changing + `IndexedVec`, and recursive-Pi `Acc` recursor/iota fixtures; the structured + rejection matrix; Theory/Verify build; full flake check; exact axiom guards + for `VEnv.addInduct_WF` and the normalized preservation roots. - **Upstream issue/PR:** TBD; submit in the staged PR sequence described in the roadmap rather than as one proof mega-diff. - **Removal condition:** upstream exposes kernel-complete checked inductive @@ -109,48 +208,51 @@ met and every consumer has moved to the replacement. ## D007 — consumer-facing inductive transaction API -- **Status:** worktree -- **Delta:** `VEnv.AddInductSuccess`, `addInduct_le`, generated - type/constructor/recursor lookup theorems, rule-membership theorems, - input-name freshness, atomic success/failure, and early-rejection lemmas. - Generic `addConst_fresh` and absence-under-growth facts support the API. +- **Status:** published-fork +- **Commits:** the normalized core in `472a6f0` and the proof-carrying + non-identity API in `6a77882` +- **Delta:** `VEnv.AddInductSuccess`, `AddInductGenerationTrace`, + `addInductGeneration`, `GenerationCertificate`, and + `addInductCertified`, with generated type/constructor/recursor lookups, + rule membership, freshness, monotonicity, atomic success/failure, and + `Ordered` preservation. The legacy `VEnv.addInduct` is an exact identity-view + compatibility wrapper; the certified API erases its proof and computes + through the same normalized transaction. - **Ix impact:** lets `InductiveOracle` consume checked block results without - unfolding `Option` binds or `foldlM` implementation details. -- **Tests:** consumer-style `IndexedVec` fixture, type-name collision fixture, - Theory/Verify build, full flake check, and a dedicated axiom guard for - `addInduct_success` (`propext`, `Quot.sound`). + unfolding `Option` binds or `foldlM`, and gives ix a Theory-only + non-identity certificate boundary without importing Verify. +- **Tests:** identity and non-identity transaction fixtures, consumer-style + `IndexedVec`, `Acc`, AliasFormer, and AnnotatedPi transactions, collision and + atomicity fixtures, Theory/Verify and flake gates, and exact axiom guards for + the public trace/WF roots. - **Upstream issue/PR:** TBD; submit after or with the Stage-3 preservation PR. - **Removal condition:** equivalent stable postconditions are upstream and ix no longer imports the fork-only names. ## D008 — Verify inductive-environment alignment -- **Status:** worktree -- **Delta:** replace the empty `AddInduct` relation with typed witnesses for - `inductInfo`, ordered `ctorInfo` insertions, `recInfo`, and the generated - defeq-rule fold. Add fold realization, lookup, freshness, environment - monotonicity, map-WF/value-preservation, real `Aligned.addInduct`, and the - formerly impossible `TrEnv'.of_value` inductive case. Add `TrTypeExpr` to - recover metadata translation typing premises from real Theory WF evidence, - then quote and replay Lean's actual Nat, Eq, and index-changing `IndexedVec` - metadata through `TrEnv'.induct`. The indexed replay is layered over the - real Nat transaction and uses explicit `Nat.zero`/`Nat.succ` indices to keep - its dependency claim semantic rather than notation-instance-driven. - Replay an actual value-bearing `defnInfo` first and verify that - `TrEnv'.of_value` recovers it through the subsequent Nat transaction. The - trace carries the exact dependent `VInductDecl.Checked` value and derives - its type/recursor/rules from that shared analysis rather than restating them. +- **Status:** published-fork +- **Commits:** initial alignment in `472a6f0`, extended through `a1d8943`, + `6a77882`, and `bc37d43` +- **Delta:** replace the empty `AddInduct` relation with a data-bearing trace + for `inductInfo`, ordered `ctorInfo` insertion, `recInfo`, and the generated + defeq fold. Fold realization, lookup, freshness, monotonicity, + map-WF/value-preservation, `Aligned.addInduct`, and the formerly impossible + `TrEnv'.of_value` inductive case are live. Actual Lean metadata for Nat, Eq, + index-changing `IndexedVec`, recursive-Pi `Acc`, AliasFormer, and AliasRec is + replayed through final equality, WF, alignment, and lookup uniqueness. + AnnotatedPi adds a seventh focused replay whose raw constructor retains + `outParam Prop` beneath a recursive Pi and whose generated recursor/iota rule + is pinned. The normalized trace owns the exact generation and its semantic + certificate instead of restating artifacts. - **Ix impact:** establishes the implementation-to-Theory environment bridge needed to translate checked inductive blocks and eventually construct `InductiveOracle`; later I2-I4 replay fixtures plus the I5 pattern package are still required before that oracle is constructible. - **Tests:** `lake build Lean4Lean.Verify.Environment.InductiveFixtures`; - concrete Nat, Eq, and `IndexedVec` - final-WF/alignment/replay-equality/lookup-uniqueness checks and a pre-Nat - definition value-preservation regression; - full Theory/Verify and flake gates; compile-time axiom guards for - `TrTypeExpr.to_trExprS`, `AddInduct.to_addInduct`, `Aligned.addInduct`, and - the concrete `nat_trEnv'`, `eq_trEnv'`, and `indexedVec_trEnv'` witnesses. + all actual-metadata replay roots and rule-RHS equalities; the pre-Nat value + preservation regression; full Theory/Verify and flake gates; compile-time + axiom guards for generic alignment and every concrete checked replay. - **Axiom note:** the guarded roots currently inherit `sorryAx` through `TrConstVal → TrExprS → TrProj`, plus the standard logical baseline. E1 declares no new axiom. The concrete fixture additionally reaches the three @@ -165,7 +267,8 @@ met and every consumer has moved to the replacement. ## D009 — shared checked inductive descriptor -- **Status:** worktree +- **Status:** published-fork +- **Commit:** introduced and integrated in `472a6f0` - **Delta:** add dependent `VInductDecl.Checked`, normalized constructor and recursive-argument records, and the computational `checked?` analyzer. Define public Stage-3 acceptance as descriptor existence. Route recursor/rule @@ -175,8 +278,11 @@ met and every consumer has moved to the replacement. result-shape, and generated-name `Nodup` checks plus a centralized proof API. Add `Checked.WF env` for normalized telescope/field/result-spine semantics, prove both compatibility directions and an iff with `VInductDecl.WF`, and - make `addInduct_WF` consume it. Retain the exact analyzer result in - `AddInductSuccess` and expose stable constructor/recursor collision rejection. + make preservation consume it. `NormalizedChecked`, `GenerationChecked`, and + their WF contracts retain the raw singleton block, checked view, mixed + generation layout, ordered constructor pairing, and exact analyzer result. + Stable constructor/recursor collision rejection and identity compatibility + remain part of the public proof API. - **Ix impact:** creates the stable, consumer-neutral analysis object that E2 can use to assemble `InductiveOracle` without duplicating raw declaration or de Bruijn analysis. The semantic certificate gives ix an environment-indexed @@ -189,7 +295,8 @@ met and every consumer has moved to the replacement. internal/pre-existing name collisions, self-referential parameters, invalid levels, malformed results/spines, parameter counts, and universe-count mismatches; exact Theory/Verify build; 20-sorry audit; Theory import boundary; - formatter; all nine flake checks. + formatter; all six current-host flake checks; and all-system no-build + evaluation. - **Axiom note:** the analyzer and descriptor are computational and declare no axiom. Compile-time guards pin every exported structural fact, the three `Checked.WF` compatibility roots, transaction success/exact-analysis facts, @@ -202,11 +309,253 @@ met and every consumer has moved to the replacement. and downstream consumers share an equivalent checked block result, and ix no longer imports the fork-only descriptor API. +## D010 — executable normalization and certified producer boundary + +- **Status:** published-fork +- **Commits:** `1fb7d6e`, `9fde4c6`, `b283912`, `a84aa19`, `c2b1c4f`, + `a1d8943`, `6a77882`, `bc37d43`, `5e5bb76`, `33b99f4`, `a3ff992`, + `9a865ea`, `a627362`, `6732659`, `c40a471`, `c739d41`, `82f4a54`, + `d553930`, `cf3d5a4`, `c9e4ae2`, `a7d101b`, `f0caf16`, `e3cf22d`, + `7e5f4f7`, `2b1d802`, `a64fe98`, `5aa9ab6`, and `bbb45e0` +- **Delta:** retain exact ordinary-checker full-check, WHNF, and `isDefEq` + executions in source- and context-indexed candidate traces; interpret them + into Theory normalization and generation certificates; assemble dependent + family/constructor lists without truncation; and package the exact generation + with its semantic WF proof. `ProducedGenerationCandidatePackage` adds the + stronger equation that the executable whole metadata call produced that + same candidate. AliasFormer and AnnotatedPi are complete positive instances + and each supplies its Theory transaction and Verify replay from its produced + package. AnnotatedPi's outer operational proof now covers exact family and + constructor validation, freshness, transparent recursion and positivity + traversals, raw-family declaration, annotation consumption, nested-Π + candidate traversal, dependent family/constructor list assembly, and the + complete successful `buildNormalizationCandidate` equation. The executable + boundary now also covers Lean's real universe-polymorphic `IndexedVec`: + exact parameter/index family validation, post-family `nil` and dependent + recursive `cons` candidates, ordered constructor-list assembly, and the + complete successful outer producer equation. Generic recursive identity + replay retains caller-selected Theory endpoints for identity-normalizing + traces. The executable list layer now exposes arbitrary-length dependent + `CandidateFamilyTypeListProduced`, `CandidateConstructorListProduced`, and + `CandidateFamilyListProduced` witnesses whose `.normalize` theorems recover + the exact list results without erasure, truncation, reordering, or unchecked + positional lookup. AliasFormer and AnnotatedPi use singleton instances; + `IndexedVec` exercises the ordered two-constructor instance. + `GenerationCandidateRun.producedPackage` now supplies the generic outer + singleton step: given an already verified semantic run and the exact + successful whole-call equation indexed by its same source and candidate, it + constructs `ProducedGenerationCandidatePackage`. All three fixtures use this + constructor instead of fixture-specific record assembly. + `CandidateExprSemanticRootRun` now retains the exact recursive semantic run + behind each root, derives the normalization-facing root and generation-facing + spine from that one value, and can existentially select the view from a + verified context plus strict source translation. Dependent semantic + constructor-list, family, and singleton-normalization structures preserve the + same source order through the complete hierarchy. AliasFormer, AnnotatedPi, + and `IndexedVec` have been migrated to that ownership model. + `CandidateExprSemanticRootInput`, dependent constructor/family inputs, and + `NormalizationCandidateSemanticInput.exists_ofProduced` now combine those + verified inputs with the exact operational family-type and family-list + witnesses and return the complete produced semantic hierarchy under + `Nonempty`. `CandidateFamilySemanticGenerationRun`, + `CandidateSemanticNormalizedCtorRun` and its dependent list, and + `GenerationCandidateSemanticRun` make that hierarchy the sole owner of the + recursive runs and spines consumed by generation. Their compatibility, + package, and produced-package projections preserve the existing public API. + The structural generation layer no longer accepts fixture-supplied view + telescopes or terminal typing judgments. `Checked.type_eq` and + `GenerationChecked.viewCtorType_eq` expose exact accepted family/constructor + decomposition. `GenerationCandidateRun.familyView_eq` fixes the singleton + candidate view; family terminal typing follows from the checked result level; + the inserted raw family constant is typed once at the checked family type; + and `GenerationChecked.checkedResultTarget_hasType` applies the checked + parameter/index spines to derive each constructor result target. + `CandidateNormalizedCtorRun.viewTel_eq` and `rightType_ofChecked` transport + these facts through the exact candidate telescope. AliasFormer, AnnotatedPi, + and `IndexedVec` now omit both record fields, and the circular `IndexedVec` + right-typing theorems formerly obtained from a complete identity-generation + WF proof are deleted. + `GenerationCandidateRun` and its semantic owner now store the exact equation + that candidate normalization's dependent `generation?` analysis returned the + retained `GenerationChecked`. Theory's + `Normalization.check?_normalization` and + `Normalization.generation?_normalization` derive normalization identity from + successful analysis. `GenerationCandidateRun.normalization_eq` projects that + result, and `GenerationCandidateRun.typeEnv_wf` reconstructs the post-family + environment from the verified pre-family context, checked family typing, + candidate raw/view equality, and exact raw-family insertion. The three live + fixtures now provide `analysis := rfl` and no independent + `normalization_eq` or `typeEnv_wf` field. + `GenerationCandidateSemanticShapeRun` is the next reduced boundary. Its + source-indexed family and constructor shapes retain only `storedSpine` and + the total traversed-binder count. Exact dependent analysis derives the raw + family identity, complete checked family view, every normalized constructor + pair, and the full ordered pair list; total spine length derives every raw + telescope/result equation, and exact checked shape derives every view + terminal equation. Its `.run` reconstructs the established semantic + generation owner. AliasFormer, AnnotatedPi, and the two-constructor + `IndexedVec` fixture now use this path and no longer hand-assemble normalized + pairs or any raw/view telescope/result equations. + `normalizationCandidateGenerationShape` now performs one executable check + over the complete singleton family and its source-indexed constructor list. + It requires each retained trace to preserve the emitted Pi spine, checks the + full raw telescope length, and rejects constructor-list mismatches in either + direction. `ProducedGenerationShapeCandidate` couples that check to the exact + successful ordinary producer equation, while + `produceGenerationShapeCandidate` rejects a produced candidate that cannot + support mixed raw/view generation. This is intentionally a strengthened + operational boundary: success of `buildNormalizationCandidate` alone does + not imply stored-spine preservation and does not acquire Theory meaning. + `GenerationCandidateSemanticRun.ofGenerationShape` combines the retained + semantic hierarchy, exact dependent analysis, WF of the analyzer-owned view + declaration, and the one complete shape result. It derives the analyzed + checked block's WF and every dependent family/constructor shape record + generically. `ProducedGenerationShapeCandidate.producedPackage` then returns + the existing complete produced package for that same candidate. AliasFormer, + AnnotatedPi, and `IndexedVec` all use this consolidated path; fixtures no + longer provide checked WF or per-position generation-shape structures. +- **Ix impact:** prevents ix from receiving an unrelated hand-selected + normalization or generation witness while keeping checker state out of the + Theory API. This is the proof boundary needed before executable metadata can + be treated as certified inductive generation. +- **Latest checkpoint:** one strengthened executable outer result now retains + the exact ordinary `buildNormalizationCandidate` equation and one complete + raw-family/constructor generation-spine check. The check is source-indexed, + rejects missing or extra constructors explicitly, and is independent of + semantic proofs. Given the retained semantic hierarchy and exact dependent + analysis, `GenerationCandidateSemanticRun.ofGenerationShape` derives checked + WF from the analyzer-owned view declaration and expands the single Boolean + into every dependent family/constructor stored-spine/count certificate. + `ProducedGenerationShapeCandidate.producedPackage` returns the complete + producer-selected semantic package for that same candidate. AliasFormer, + AnnotatedPi, and the two-constructor `IndexedVec` regression all flow through + this boundary. They supply neither checked WF nor per-position shape records; + their certified Theory transactions and checked E1 replays continue to + project from the same source-indexed packages. +- **Current gap:** construct the verified per-position semantic inputs and WF + of the analyzer-owned view declaration generically from one arbitrary + verified outer checker context, strict source translations, and the exact + successful operational traversals. Then expose the singleton theorem that + combines those semantic inputs, exact dependent analysis, and the + strengthened generation-shape result into + `Nonempty ProducedGenerationCandidatePackage` (or an equivalent dependent + result). Bare `buildNormalizationCandidate` success cannot soundly imply the + gate: WHNF may change the visible Pi spine and the ordinary producer does not + test `storedSpine`. It also cannot imply Theory WF. The generic boundary must + therefore either run the strengthened gate or require its successful result, + while verified checker executions remain the sole source of Theory meaning. + Raw/view pairing, component equations, checked WF, dependent list alignment, + and every per-position shape record must remain derived; view-telescope, + terminal-typing, normalization-equality, and post-family-WF premises must not + be reintroduced. + The outer boundary remains singleton-family; + complete the normalization differential matrix before widening it to mutual + and nested blocks. +- **Tests:** exact positive AliasFormer, AnnotatedPi, and `IndexedVec` + whole-call equations; positive semantic/transaction/replay fixtures for the + first two plus the complete checkpoint semantic/transaction/E1 replay for + `IndexedVec`; exact `IndexedVec` family/`nil`/`cons` candidate traces; + opaque-`outParam` whole-candidate rejection; exact axiom guards for the + semantic-input constructors, produced hierarchy, semantic-generation and + reduced-shape projections, the three operational list theorems, and both + outer package constructors; singleton and two-constructor list regressions; + exact `IndexedVec` source-order preservation plus swapped-view rejection; + retained-hierarchy and semantic-generation migrations for all three + fixtures; absence of fixture `viewTel`, `rightType`, `normalization_eq`, + `typeEnv_wf`, checked-WF, per-position generation-shape, normalized-pair, + `rawTel`, `rawResult`, and `viewResult` inputs; exact strengthened-producer + success for all three fixtures; missing-raw and extra-raw constructor-list + rejection; exact analyzer-success replay in all three fixtures; focused + direct compiles, 157-job default Lake build, and 124-job Theory/Verify and Nix + proof builds; 20-sorry frontier check; default Nix build; all six + current-host flake checks; all-system no-build evaluation; formatter; Theory + import-boundary; and whitespace checks. +- **Axiom note:** no normalization oracle, native evaluator, or new axiom was + added. `Checked.type_eq`, `GenerationChecked.viewCtorType_eq`, and + `GenerationChecked.checkedResultTarget_hasType` are exactly guarded at + `propext`/`Quot.sound`. `GenerationCandidateRun.familyView_eq` and + `CandidateNormalizedCtorRun.viewTel_eq` have exactly the small transitional + `propext`/`sorryAx`/`Classical.choice`/`Quot.sound` closure inherited from + their Verify evidence. Family-constant and constructor-target typing inherit + the already recorded full checked-semantic closure and are exactly guarded. + The three operational list theorems are guarded at exactly the + accepted `propext`/`Classical.choice`/`Quot.sound` baseline. The generic outer + constructor has the exactly guarded + `propext`/`sorryAx`/`Classical.choice`/`Quot.sound` closure inherited through + its dependent Verify evidence types; it declares no axiom and does not widen + the producer equation into semantic authority. Concrete Verify producer + roots expose existing checker-refinement, pointer/cache, and projection + dependencies; generic Theory transaction roots retain their narrower + guarded closure. The semantic `spine` projection has exactly the + `propext`/`sorryAx`/`Classical.choice`/`Quot.sound` closure. Semantic input + construction, produced hierarchy assembly, and semantic-generation + projections inherit the already documented checked semantic closure, + including the existing pointer, expression, level, persistent-array/map, and + syntax implementation contracts. They are now exact compile-time guarded; + the AliasFormer and `IndexedVec` roots match that set, while AnnotatedPi adds + only the already documented `Expr.hasFVar_eq` dependency reached by its + annotated free-variable checker trace. Returning semantic existence under + `Nonempty` avoids a choice-based data extractor. No root declares a new + axiom, assumes a normalization oracle, or gives operational production + independent semantic authority. + The new Theory normalization-retention lemmas are exactly guarded at + `propext`/`Quot.sound`. The Verify normalization projection has exactly the + small inherited `propext`/`sorryAx`/`Classical.choice`/`Quot.sound` closure; + reconstructed post-family WF has exactly the already recorded checked + semantic closure. These are derivations from retained analysis/context + evidence, not new axioms or an expansion of the accepted trust budget. + `NormalizationCandidateRun.sourceType_eq` and `familyViewType_eq` are guarded + at exactly `propext`/`sorryAx`/`Classical.choice`/`Quot.sound`, inherited from + their dependent Verify evidence. `GenerationCandidateSemanticShapeRun.run` + has exactly the previously recorded checked semantic set. The structural + list recursion and telescope decomposition introduce no new axiom, and the + public projection does not enlarge the semantic owner's closure. + The complete executable generation-shape functions, strengthened producer, + and its exact-success theorem are guarded at exactly + `propext`/`Classical.choice`/`Quot.sound`; they declare no axiom and contain no + semantic claim. Expanding a successful shape result into the dependent + semantic generation owner, deriving checked WF, and constructing the final + package inherit exactly the already recorded checked semantic closure. Exact + fixture guards expose only their pre-existing checker/pointer/cache and + projection dependencies. +- **Upstream issue/PR:** TBD; submit after the singleton producer interface is + stable enough that the first PR does not freeze fixture-specific APIs. +- **Removal condition:** upstream executable inductive ingestion returns or + derives an equivalently source-indexed certified package, all supported + metadata paths use it, and ix no longer relies on the fork-only producer API. + +## D011 — verified syntactic definitional-equality fast path + +- **Status:** published-fork +- **Commit:** `f0d80f8` +- **Delta:** `TypeChecker.Inner.isDefEq` accepts `Expr.eqv` inputs before + entering `isDefEqCore`. The verified refinement transports the strict source + translation across expression equivalence and proves the ordinary Theory + definitional equality result. The successful fast path leaves checker state + unchanged; non-equivalent inputs retain the existing core behavior. +- **Ix impact:** removes an operational state-mutation obstruction in exact + constructor-candidate replay and makes reflexive executable equality checks + cheaper without changing the Theory API. +- **Tests:** exact-state AliasRec, AnnotatedPi, and `IndexedVec` fixtures; + `TypeChecker.Inner.isDefEq.WF`; focused and full Theory/Verify builds; exact + 20-sorry audit; default Nix build; all-system no-build evaluation; and the + current-host flake check. +- **Axiom note:** no new axiom was declared. The Verify proof reaches the + existing `Expr.eqv_eq` implementation contract; it grants no new Theory + authority and remains part of Track T's platform-contract audit. +- **Upstream issue/PR:** TBD; submit as an isolated checker optimization plus + its refinement theorem and exact-state regressions. +- **Removal condition:** an equivalent verified fast path lands upstream, or + the fork removes this behavior and all candidate-replay fixtures pass against + the upstream state transition instead. + ## Review checklist At each publish or ix pin boundary: -1. Refresh both baseline hashes and `git log upstream/master..HEAD`. +1. Refresh both baseline hashes and + `git log upstream/master..jcb/induct`; do not use a detached `HEAD` as the + published-fork baseline. 2. Add an entry before landing any new semantic/API delta. 3. Record the upstream issue or PR as soon as one exists. 4. Run the tests named by every touched entry.