diff --git a/.github/scripts/check_tc_verify_sorries.pl b/.github/scripts/check_tc_verify_sorries.pl
new file mode 100644
index 00000000..457d2c36
--- /dev/null
+++ b/.github/scripts/check_tc_verify_sorries.pl
@@ -0,0 +1,217 @@
+#!/usr/bin/env perl
+use strict;
+use warnings;
+
+# Enforce the checked-in Ix.Tc verification sorry frontier.
+#
+# This is a source-token audit rather than a raw grep: comments and strings
+# may discuss upstream sorries without enlarging the local trusted frontier.
+# Every real Lean sorry token is attributed to its nearest top-level
+# declaration and compared with the exact allowlist below.
+
+use Cwd qw(abs_path);
+use FindBin qw($RealBin);
+use File::Find qw(find);
+use File::Spec;
+
+my $repo_root = abs_path(File::Spec->catdir($RealBin, '..', '..'));
+my $verify_root = File::Spec->catdir($repo_root, 'Ix', 'Tc', 'Verify');
+
+my %expected = (
+  "Ix/Tc/Verify/Statements.lean\0TcM.whnf.wf"       => 1,
+  "Ix/Tc/Verify/Statements.lean\0TcM.infer.wf"      => 1,
+  "Ix/Tc/Verify/Statements.lean\0TcM.isDefEq.wf"    => 1,
+  "Ix/Tc/Verify/Statements.lean\0TcM.checkConst.wf" => 1,
+);
+
+sub mask_chunk {
+  my ($chunk) = @_;
+  $chunk =~ s/[^\n]/ /g;
+  return $chunk;
+}
+
+sub earliest {
+  my @positions = grep { $_ >= 0 } @_;
+  return -1 unless @positions;
+  my ($first) = sort { $a <=> $b } @positions;
+  return $first;
+}
+
+sub mask_non_code {
+  my ($source, $path) = @_;
+  my $length = length $source;
+  my $index = 0;
+  my $block_depth = 0;
+  my @masked;
+
+  while ($index < $length) {
+    if ($block_depth) {
+      my $open = index($source, '/-', $index);
+      my $close = index($source, '-/', $index);
+      my $next = earliest($open, $close);
+      die "$path: unterminated block comment\n" if $next < 0;
+      push @masked, mask_chunk(substr($source, $index, $next + 2 - $index));
+      if ($next == $open) {
+        ++$block_depth;
+      } else {
+        --$block_depth;
+      }
+      $index = $next + 2;
+      next;
+    }
+
+    my $line_comment = index($source, '--', $index);
+    my $block_comment = index($source, '/-', $index);
+    my $quote = index($source, '"', $index);
+    my $next = earliest($line_comment, $block_comment, $quote);
+
+    if ($next < 0) {
+      push @masked, substr($source, $index);
+      $index = $length;
+      next;
+    }
+
+    push @masked, substr($source, $index, $next - $index);
+    if ($next == $line_comment) {
+      my $newline = index($source, "\n", $next);
+      my $end = $newline < 0 ? $length : $newline;
+      push @masked, mask_chunk(substr($source, $next, $end - $next));
+      $index = $end;
+    } elsif ($next == $block_comment) {
+      push @masked, '  ';
+      $block_depth = 1;
+      $index = $next + 2;
+    } else {
+      my $closing = $next + 1;
+      while (1) {
+        $closing = index($source, '"', $closing);
+        die "$path: unterminated string literal\n" if $closing < 0;
+        my $slashes = 0;
+        my $before = $closing - 1;
+        while ($before > $next && substr($source, $before, 1) eq '\\') {
+          ++$slashes;
+          --$before;
+        }
+        last if $slashes % 2 == 0;
+        ++$closing;
+      }
+      push @masked,
+        mask_chunk(substr($source, $next, $closing + 1 - $next));
+      $index = $closing + 1;
+    }
+  }
+
+  die "$path: unterminated block comment\n" if $block_depth;
+  return join '', @masked;
+}
+
+sub relative_path {
+  my ($path) = @_;
+  my $relative = File::Spec->abs2rel($path, $repo_root);
+  $relative =~ s{\\}{/}g;
+  return $relative;
+}
+
+sub find_sorries {
+  my ($path) = @_;
+  open my $handle, '<:encoding(UTF-8)', $path
+    or die "cannot read $path: $!\n";
+  local $/;
+  my $source = <$handle>;
+  close $handle;
+
+  return () unless $source =~ /\bsorry\b/;
+  my $code = mask_non_code($source, $path);
+  my @commands;
+  while (
+    $code =~
+      m{^[ \t]*(?:(?:private|protected|noncomputable)[ \t]+)*
+        (theorem|lemma|def|opaque|abbrev|instance|inductive|structure|example)
+        [ \t]+([A-Za-z_][A-Za-z0-9_'.?]*)}mgx
+  ) {
+    push @commands, [$-[0], $1, $2];
+  }
+
+  my @found;
+  my $command_index = -1;
+  while ($code =~ /\bsorry\b/g) {
+    my $position = $-[0];
+    while (
+      $command_index + 1 < @commands
+      && $commands[$command_index + 1]->[0] < $position
+    ) {
+      ++$command_index;
+    }
+
+    my $declaration = '<no enclosing declaration>';
+    if ($command_index >= 0) {
+      my ($unused, $kind, $name) = @{$commands[$command_index]};
+      $declaration = $kind =~ /^(?:theorem|lemma)$/ ? $name : "$kind $name";
+    }
+    my $prefix = substr($source, 0, $position);
+    my $line = 1 + ($prefix =~ tr/\n//);
+    push @found, [relative_path($path), $declaration, $line];
+  }
+  return @found;
+}
+
+my @observed_with_lines;
+eval {
+  my @verify_files;
+  find(
+    {
+      no_chdir => 1,
+      wanted => sub {
+        push @verify_files, $File::Find::name
+          if -f $File::Find::name && $File::Find::name =~ /\.lean\z/;
+      },
+    },
+    $verify_root,
+  );
+  for my $path (sort @verify_files) {
+    push @observed_with_lines, find_sorries($path);
+  }
+  1;
+} or do {
+  my $error = $@ || 'unknown scan error';
+  print STDERR "tc-verify sorry audit failed to scan sources: $error";
+  exit 2;
+};
+
+my %observed;
+for my $entry (@observed_with_lines) {
+  ++$observed{"$entry->[0]\0$entry->[1]"};
+}
+
+my $matches = 1;
+for my $key (keys %expected) {
+  $matches = 0 if ($observed{$key} // 0) != $expected{$key};
+}
+for my $key (keys %observed) {
+  $matches = 0 if ($expected{$key} // 0) != $observed{$key};
+}
+
+if (!$matches) {
+  print STDERR "Ix.Tc Verify sorry frontier changed.\n";
+  print STDERR "Expected:\n";
+  for my $key (sort keys %expected) {
+    my ($path, $declaration) = split /\0/, $key, 2;
+    print STDERR "  $expected{$key} x $path :: $declaration\n";
+  }
+  print STDERR "Observed:\n";
+  if (@observed_with_lines) {
+    for my $entry (@observed_with_lines) {
+      print STDERR "  $entry->[0]:$entry->[2] :: $entry->[1]\n";
+    }
+  } else {
+    print STDERR "  <none>\n";
+  }
+  print STDERR
+    "Update the allowlist only when the formal trust frontier intentionally changes.\n";
+  exit 1;
+}
+
+print "Ix.Tc Verify sorry frontier OK:\n";
+for my $entry (@observed_with_lines) {
+  print "  $entry->[0]:$entry->[2] :: $entry->[1]\n";
+}
diff --git a/.github/workflows/ci.yml b/.github/workflows/ci.yml
index 4358e4ee..1c2bc02d 100644
--- a/.github/workflows/ci.yml
+++ b/.github/workflows/ci.yml
@@ -31,6 +31,12 @@ jobs:
       # lean-action builds above — fails CI.
       - name: Build all targets
         run: lake lint -- --wfail -v
+      - name: Check Ix.Tc verification sorry frontier
+        run: perl .github/scripts/check_tc_verify_sorries.pl
+      - name: Check Ix.Tc exported theorem trust manifest
+        run: lake build Ix.Tc.Verify.Audit.Completed Ix.Tc.Verify.Audit.Statements
+      - name: Build Ix.Tc formal verification
+        run: lake build IxTcVerify
       - name: Check codegen'd IxVM kernel is up to date
         run: lake exe ix codegen --check
       # Compile the `.ixe` the zkVM execution gates run the guests over:
diff --git a/Ix/AuxGen/Recursor.lean b/Ix/AuxGen/Recursor.lean
index 3bc1516f..7fe0f220 100644
--- a/Ix/AuxGen/Recursor.lean
+++ b/Ix/AuxGen/Recursor.lean
@@ -1621,8 +1621,9 @@ def computeIsLargeAndK (classes : Array FlatInfo) (nClasses nParams : Nat)
 
   -- WHNF-reduced result sort level via the kernel.
   let resultKuniv ←
-    match ← runTc ((Ix.Tc.RecM.getResultSortLevel firstTyZ
-        (nParams + firstNIndices.toNat)).run Ix.Tc.methods) with
+    match ← runTc (Ix.Tc.TcM.runRec
+        (Ix.Tc.RecM.getResultSortLevel firstTyZ
+          (nParams + firstNIndices.toNat))) with
     | .ok u => pure u
     | .error e =>
       throw (.invalidMutualBlock
@@ -1630,8 +1631,8 @@ def computeIsLargeAndK (classes : Array FlatInfo) (nClasses nParams : Nat)
 {classes[0]!.ind.cnst.name.pretty}: {e}")
 
   let isLarge ←
-    match ← runTc ((Ix.Tc.RecM.isLargeEliminator resultKuniv indInfos).run
-        Ix.Tc.methods) with
+    match ← runTc (Ix.Tc.TcM.runRec
+        (Ix.Tc.RecM.isLargeEliminator resultKuniv indInfos)) with
     | .ok b => pure b
     | .error e =>
       throw (.invalidMutualBlock
diff --git a/Ix/Tc/CanonicalCheck.lean b/Ix/Tc/CanonicalCheck.lean
index 6e44ea0a..0f6c8297 100644
--- a/Ix/Tc/CanonicalCheck.lean
+++ b/Ix/Tc/CanonicalCheck.lean
@@ -123,7 +123,7 @@ instance : Inhabited (KConst m) :=
 
 /-- Structural universe comparison; `param` index is its identity.
     Variant order: zero < succ < max < imax < param. -/
-partial def compareKUniv : KUniv m → KUniv m → SOrd
+def compareKUniv : KUniv m → KUniv m → SOrd
   | .zero _, .zero _ => .eq' true
   | .zero _, _ => .lt' true
   | _, .zero _ => .gt' true
@@ -153,7 +153,7 @@ def compareCtxRef (ctx : KMutCtx) (x y : Address) : SOrd :=
     through binders, ctx-aware for block-local refs. FVars must not appear
     (closed egressed expressions only). Variant order:
     var < sort < const < app < lam < all < letE < nat < str < prj. -/
-partial def compareKExpr (ctx : KMutCtx) (x y : KExpr m) :
+def compareKExpr (ctx : KMutCtx) (x y : KExpr m) :
     Except (TcError m) SOrd := do
   if x.hasFVars || y.hasFVars then
     throw .unexpectedFVarInComparator
@@ -188,8 +188,17 @@ partial def compareKExpr (ctx : KMutCtx) (x y : KExpr m) :
     return (← compareKExpr ctx xt yt).andThen (← compareKExpr ctx xb yb)
   | .all .., _ => return .lt' true
   | _, .all .. => return .gt' true
-  | .letE _ xt xv xb _ _, .letE _ yt yv yb _ _ =>
-    SOrd.zipWithM (compareKExpr ctx) #[xt, xv, xb] #[yt, yv, yb]
+  | .letE _ xt xv xb _ _, .letE _ yt yv yb _ _ => do
+    -- Preserve `zipWithM`'s left-to-right short circuit: later fields must
+    -- not introduce an error after an earlier non-equal decision.
+    let tyOrd ← compareKExpr ctx xt yt
+    if tyOrd.ordering != .eq then
+      return tyOrd
+    let valOrd ← compareKExpr ctx xv yv
+    let head := tyOrd.andThen valOrd
+    if head.ordering != .eq then
+      return head
+    return head.andThen (← compareKExpr ctx xb yb)
   | .letE .., _ => return .lt' true
   | _, .letE .. => return .gt' true
   | .nat xv _ _, .nat yv _ _ => return .ofOrdering (compare xv yv)
@@ -304,35 +313,48 @@ def compareKConst (ctx : KMutCtx) (resolveCtor : ResolveCtor m)
 /-! ### sort_consts port (iterative partition refinement) -/
 
 /-- Stable merge of two sorted arrays (left preferred on ties). -/
-partial def mergeSorted (ctx : KMutCtx) (resolveCtor : ResolveCtor m)
+def mergeSorted (ctx : KMutCtx) (resolveCtor : ResolveCtor m)
     (left right : Array (KId m × KConst m)) :
-    Except (TcError m) (Array (KId m × KConst m)) := do
-  let mut result : Array (KId m × KConst m) :=
-    Array.mkEmpty (left.size + right.size)
-  let mut li := 0
-  let mut ri := 0
-  while li < left.size && ri < right.size do
-    let cmp ← compareKConst ctx resolveCtor left[li]!.2 right[ri]!.2
-    if cmp.ordering == .gt then
-      result := result.push right[ri]!
-      ri := ri + 1
-    else
-      result := result.push left[li]!
-      li := li + 1
-  result := result ++ left.extract li left.size
-  result := result ++ right.extract ri right.size
-  return result
+    Except (TcError m) (Array (KId m × KConst m)) :=
+  go 0 0 (Array.mkEmpty (left.size + right.size))
+    (left.size + right.size)
+where
+  /-- Each comparison consumes exactly one item from `left` or `right`. -/
+  go (li ri : Nat) (result : Array (KId m × KConst m)) : Nat →
+      Except (TcError m) (Array (KId m × KConst m))
+    | 0 =>
+      return result ++ left.extract li left.size ++ right.extract ri right.size
+    | fuel + 1 => do
+      if li < left.size && ri < right.size then
+        let cmp ← compareKConst ctx resolveCtor left[li]!.2 right[ri]!.2
+        if cmp.ordering == .gt then
+          go li (ri + 1) (result.push right[ri]!) fuel
+        else
+          go (li + 1) ri (result.push left[li]!) fuel
+      else
+        return result ++ left.extract li left.size ++
+          right.extract ri right.size
+
+/-- Merge-sort worker. Both halves receive the predecessor budget; for a
+    nontrivial input their sizes are strictly below the caller's size. -/
+def sortByCompareFuel (ctx : KMutCtx) (resolveCtor : ResolveCtor m) :
+    Nat → Array (KId m × KConst m) →
+      Except (TcError m) (Array (KId m × KConst m))
+  | 0, items => return items
+  | fuel + 1, items => do
+    if items.size ≤ 1 then
+      return items
+    let mid := items.size / 2
+    let left ← sortByCompareFuel ctx resolveCtor fuel (items.extract 0 mid)
+    let right ← sortByCompareFuel ctx resolveCtor fuel
+      (items.extract mid items.size)
+    mergeSorted ctx resolveCtor left right
 
 /-- Merge-sort by structural comparison. -/
-partial def sortByCompare (ctx : KMutCtx) (resolveCtor : ResolveCtor m)
+def sortByCompare (ctx : KMutCtx) (resolveCtor : ResolveCtor m)
     (items : Array (KId m × KConst m)) :
-    Except (TcError m) (Array (KId m × KConst m)) := do
-  if items.size ≤ 1 then
-    return items
-  let mid := items.size / 2
-  let left ← sortByCompare ctx resolveCtor (items.extract 0 mid)
-  let right ← sortByCompare ctx resolveCtor (items.extract mid items.size)
-  mergeSorted ctx resolveCtor left right
+    Except (TcError m) (Array (KId m × KConst m)) :=
+  sortByCompareFuel ctx resolveCtor items.size items
 
 /-- Group consecutive equal elements of a sorted array. -/
 def groupConsecutive (ctx : KMutCtx) (resolveCtor : ResolveCtor m)
@@ -367,9 +389,29 @@ def classesEq (a b : Array (Array (KId m × KConst m))) : Bool := Id.run do
         return false
   return true
 
+/-- Bounded partition-refinement worker. A non-fixed pass splits at least one
+    class; at most `members.size - 1` splits and one final equality check are
+    reachable from the singleton initial partition. -/
+def sortKConstsRefineFuel (resolveCtor : ResolveCtor m) :
+    Nat → Array (Array (KId m × KConst m)) →
+      Except (TcError m) (Array (Array (KId m × KConst m)))
+  | 0, classes => return classes
+  | fuel + 1, classes => do
+    let ctx := KMutCtx.fromIdClasses classes
+    let mut newClasses : Array (Array (KId m × KConst m)) := #[]
+    for cls in classes do
+      if cls.size ≤ 1 then
+        newClasses := newClasses.push cls
+      else
+        let sorted ← sortByCompare ctx resolveCtor cls
+        newClasses := newClasses ++ (← groupConsecutive ctx resolveCtor sorted)
+    if classesEq classes newClasses then
+      return newClasses
+    sortKConstsRefineFuel resolveCtor fuel newClasses
+
 /-- Iterative partition refinement with a caller-provided deterministic
     seed/tiebreak key (compile-side seeds by `MutConst.name()`). -/
-partial def sortKConstsWithSeedKey (resolveCtor : ResolveCtor m)
+def sortKConstsWithSeedKey (resolveCtor : ResolveCtor m)
     (seedKey : KId m → KConst m → Address)
     (members : Array (KId m × KConst m)) :
     Except (TcError m) (Array (Array (KId m × KConst m))) := do
@@ -380,20 +422,7 @@ partial def sortKConstsWithSeedKey (resolveCtor : ResolveCtor m)
     | .lt => true
     | .gt => false
     | .eq => Address.cmpBytes a.1.addr b.1.addr == .lt
-  let mut classes : Array (Array (KId m × KConst m)) := #[seed]
-  repeat
-    let ctx := KMutCtx.fromIdClasses classes
-    let mut newClasses : Array (Array (KId m × KConst m)) := #[]
-    for cls in classes do
-      if cls.size ≤ 1 then
-        newClasses := newClasses.push cls
-      else
-        let sorted ← sortByCompare ctx resolveCtor cls
-        newClasses := newClasses ++ (← groupConsecutive ctx resolveCtor sorted)
-    if classesEq classes newClasses then
-      return newClasses
-    classes := newClasses
-  return classes
+  sortKConstsRefineFuel resolveCtor (members.size + 1) #[seed]
 
 /-- Refinement with the identity (address) seed key. -/
 def sortKConsts (resolveCtor : ResolveCtor m)
diff --git a/Ix/Tc/Check.lean b/Ix/Tc/Check.lean
index 148bde95..c884d6d0 100644
--- a/Ix/Tc/Check.lean
+++ b/Ix/Tc/Check.lean
@@ -36,78 +36,80 @@ inductive CheckBlockKind where
 
 namespace RecM
 
-mutual
-
 -- ### Safety lattice
 
 /-- Safe defs must not reference unsafe/partial constants; partial defs must
     not reference unsafe ones. Iterative walk, memoized. -/
-partial def checkNoUnsafeRefs (root : KExpr m)
-    (callerSafety : Ix.DefinitionSafety) : RecM m Unit := do
-  let mut stack : Array (KExpr m) := #[root]
-  let mut seenExprs : HashSet Address := {}
-  let mut seenConsts : HashSet Address := {}
-  while !stack.isEmpty do
-    let e := stack.back!
-    stack := stack.pop
-    if seenExprs.contains e.addr then
-      continue
-    seenExprs := seenExprs.insert e.addr
-    match e with
-    | .var .. | .fvar .. | .sort .. | .nat .. | .str .. => pure ()
-    | .const id _ _ =>
-      if seenConsts.contains id.addr then
-        continue
-      seenConsts := seenConsts.insert id.addr
-      let short := (toString id.addr).take 8 |>.toString
-      match (← TcM.tryGetConst id) with
-      | some (.axio (isUnsafe := true) ..) =>
-        throw (.other s!"safe definition references unsafe axiom {short}")
-      | some (.defn (safety := .unsaf) ..) =>
-        throw (.other s!"safe definition references unsafe definition {short}")
-      | some (.defn (safety := .part) ..) =>
-        if callerSafety == .safe then
-          throw (.other s!"safe definition references partial definition {short}")
-      | some (.recr (isUnsafe := true) ..) =>
-        throw (.other s!"safe definition references unsafe recursor {short}")
-      | some (.indc (isUnsafe := true) ..) =>
-        throw (.other s!"safe definition references unsafe inductive {short}")
-      | some (.ctor (isUnsafe := true) ..) =>
-        throw (.other s!"safe definition references unsafe constructor {short}")
-      | _ => pure ()
-    | .app f a _ =>
-      stack := stack.push f |>.push a
-    | .lam _ _ ty body _ | .all _ _ ty body _ =>
-      stack := stack.push ty |>.push body
-    | .letE _ ty val body _ _ =>
-      stack := stack.push ty |>.push val |>.push body
-    | .prj _ _ val _ =>
-      stack := stack.push val
+def checkNoUnsafeRefs (root : KExpr m)
+    (callerSafety : Ix.DefinitionSafety) : RecM m Unit :=
+  go [root] {} {}
+where
+  /-- LIFO order matches the former Array stack. -/
+  go (stack : List (KExpr m)) (seenExprs seenConsts : HashSet Address) :
+      RecM m Unit :=
+    match stack with
+    | [] => pure ()
+    | e :: stack => do
+      if seenExprs.contains e.addr then
+        return (← go stack seenExprs seenConsts)
+      let seenExprs := seenExprs.insert e.addr
+      match e with
+      | .var .. | .fvar .. | .sort .. | .nat .. | .str .. =>
+        go stack seenExprs seenConsts
+      | .const id _ _ =>
+        if seenConsts.contains id.addr then
+          return (← go stack seenExprs seenConsts)
+        let seenConsts := seenConsts.insert id.addr
+        let short := (toString id.addr).take 8 |>.toString
+        match (← TcM.tryGetConst id) with
+        | some (.axio (isUnsafe := true) ..) =>
+          throw (.other s!"safe definition references unsafe axiom {short}")
+        | some (.defn (safety := .unsaf) ..) =>
+          throw (.other s!"safe definition references unsafe definition {short}")
+        | some (.defn (safety := .part) ..) =>
+          if callerSafety == .safe then
+            throw (.other s!"safe definition references partial definition {short}")
+        | some (.recr (isUnsafe := true) ..) =>
+          throw (.other s!"safe definition references unsafe recursor {short}")
+        | some (.indc (isUnsafe := true) ..) =>
+          throw (.other s!"safe definition references unsafe inductive {short}")
+        | some (.ctor (isUnsafe := true) ..) =>
+          throw (.other s!"safe definition references unsafe constructor {short}")
+        | _ => pure ()
+        go stack seenExprs seenConsts
+      | .app f a _ => go (a :: f :: stack) seenExprs seenConsts
+      | .lam _ _ ty body _ | .all _ _ ty body _ =>
+        go (body :: ty :: stack) seenExprs seenConsts
+      | .letE _ ty val body _ _ =>
+        go (body :: val :: ty :: stack) seenExprs seenConsts
+      | .prj _ _ val _ => go (val :: stack) seenExprs seenConsts
+  termination_by exprWorkSize stack
+  decreasing_by
+    all_goals simp [exprWorkSize, KExpr.treeSize, KExpr.treeSize_pos] <;> omega
 
 -- ### Quotient validation
 
 /-- Count leading foralls (whnf-peeled, opened with fresh fvars). -/
-partial def countForalls (ty : KExpr m) : RecM m Nat := do
+def countForalls (ty : KExpr m) : RecM m Nat := do
   let saved := (← get).lctx.size
-  let mut n := 0
-  let mut cur := ty
-  repeat
+  runBounded (fun (cur, n) => do
     let w ← whnf cur
     match w with
     | .all name bi dom body _ =>
-      n := n + 1
       let fvId ← TcM.freshFVarId (m := m)
       let fv ← TcM.intern (.mkFVar fvId name)
       modify fun s => { s with lctx := s.lctx.push fvId (.cdecl name bi dom) }
-      cur ← TcM.runIntern (instantiateRev body #[fv])
+      let cur ← TcM.runIntern (instantiateRev body #[fv])
+      return .next (cur, n + 1)
     | _ =>
       modify fun s => { s with lctx := s.lctx.truncate saved }
-      return n
-  return n
+      return .done n) maxWhnfFuel.toNat (ty, 0)
+
+mutual
 
 /-- `Eq` must exist with 1 universe param, 2 params, and `Eq.refl` as its
     single constructor (prerequisite for sound quot reduction). -/
-partial def checkEqType : RecM m Unit := do
+def checkEqType : RecM m Unit := do
   let p ← prims
   let eqC? := (← get).env.consts.fold (init := none)
     fun acc id c => if id.addr == p.eq.addr then some c else acc
@@ -128,7 +130,7 @@ partial def checkEqType : RecM m Unit := do
 /-- Quot structure: address ↔ kind consistency against the primitive table,
     universe counts (1/1/2/1), Eq shape for `lift`, and minimum forall
     counts (2/3/6/5). -/
-partial def checkQuot (id : KId m) (kind : Ix.QuotKind) (lvls : UInt64)
+def checkQuot (id : KId m) (kind : Ix.QuotKind) (lvls : UInt64)
     (ty : KExpr m) : RecM m Unit := do
   let p ← prims
   let expectedKind ←
@@ -158,7 +160,7 @@ partial def checkQuot (id : KId m) (kind : Ix.QuotKind) (lvls : UInt64)
 
 -- ### Block classification / coordination
 
-partial def classifyBlock (members : Array (KId m)) :
+def classifyBlock (members : Array (KId m)) :
     RecM m CheckBlockKind := do
   if members.isEmpty then
     throw (.other "empty check block")
@@ -179,14 +181,14 @@ partial def classifyBlock (members : Array (KId m)) :
   | _, _, _ =>
     throw (.other "unsupported mixed check block: expected only definitions, only inductives/constructors, or only recursors")
 
-partial def coordinatedBlockIfKind (block : KId m)
+def coordinatedBlockIfKind (block : KId m)
     (expected : CheckBlockKind) : RecM m (Option (KId m)) := do
   let some members ← TcM.tryGetBlock block | return none
   match (← try? (classifyBlock members)) with
   | some kind => if kind == expected then return some block else return none
   | none => return none
 
-partial def coordinatedBlockFor (c : KConst m) : RecM m (Option (KId m)) := do
+def coordinatedBlockFor (c : KConst m) : RecM m (Option (KId m)) := do
   match c with
   | .defn (block := block) .. => coordinatedBlockIfKind block .defn
   | .indc (block := block) .. => coordinatedBlockIfKind block .inductive'
@@ -199,7 +201,7 @@ partial def coordinatedBlockFor (c : KConst m) : RecM m (Option (KId m)) := do
   | .axio .. | .quot .. => return none
 
 /-- Whole-block check key for batch schedulers. -/
-partial def coordinatedCheckBlockForConst (id : KId m) :
+def coordinatedCheckBlockForConst (id : KId m) :
     RecM m (Option (KId m)) := do
   let some c ← TcM.tryGetConst id | return none
   coordinatedBlockFor c
@@ -208,7 +210,7 @@ partial def coordinatedCheckBlockForConst (id : KId m) :
 
 /-- Type-check a single constant (block-coordinated when applicable; results
     memoized in `blockCheckResults` so failures replay per member). -/
-partial def checkConst (id : KId m) : RecM m Unit := do
+def checkConst (id : KId m) : RecM m Unit := do
   let c ← TcM.getConst id
   if let some block ← coordinatedBlockFor c then
     if let some result := (← get).env.blockCheckResults[block]? then
@@ -228,12 +230,12 @@ partial def checkConst (id : KId m) : RecM m Unit := do
     | .error e => throw e
   checkConstMemberFresh id
 
-partial def checkConstMemberFresh (id : KId m) : RecM m Unit := do
+def checkConstMemberFresh (id : KId m) : RecM m Unit := do
   TcM.reset (m := m)
   let c ← TcM.getConst id
   checkConstMember id c
 
-partial def checkConstMember (id : KId m) (c : KConst m) : RecM m Unit := do
+def checkConstMember (id : KId m) (c : KConst m) : RecM m Unit := do
   if Mode.F.hasDups c.levelParams then
     throw (.other "duplicate universe level parameter")
   validateConstWellScoped c
@@ -271,7 +273,7 @@ partial def checkConstMember (id : KId m) (c : KConst m) : RecM m Unit := do
     let _ ← ensureSortDirect t
     checkCtorAgainstInductiveMember id induct
 
-partial def checkBlockBody (block : KId m) (requested : KId m) :
+def checkBlockBody (block : KId m) (requested : KId m) :
     RecM m Unit := do
   let members := (← TcM.tryGetBlock block).getD #[requested]
   let kind ← classifyBlock members
@@ -294,21 +296,21 @@ partial def checkBlockBody (block : KId m) (requested : KId m) :
 
 -- ### Inductive machinery (validation and recursor generation in Ix.Tc.Inductive)
 
-partial def checkInductiveMember (id : KId m) : RecM m Unit :=
+def checkInductiveMember (id : KId m) : RecM m Unit :=
   checkInductiveMemberImpl id
 
-partial def checkCtorAgainstInductiveMember (id induct : KId m) :
+def checkCtorAgainstInductiveMember (id induct : KId m) :
     RecM m Unit :=
   checkCtorAgainstInductiveMemberImpl id induct
 
-partial def checkInductiveBlock (block : KId m) (members : Array (KId m)) :
+def checkInductiveBlock (block : KId m) (members : Array (KId m)) :
     RecM m Unit :=
   checkInductiveBlockImpl block members
 
-partial def checkRecursorMember (id : KId m) : RecM m Unit :=
+def checkRecursorMember (id : KId m) : RecM m Unit :=
   checkRecursorMemberImpl id
 
-partial def checkRecursorBlock (block : KId m) (members : Array (KId m)) :
+def checkRecursorBlock (block : KId m) (members : Array (KId m)) :
     RecM m Unit :=
   checkRecursorBlockImpl block members
 
@@ -319,9 +321,14 @@ end RecM
 namespace TcM
 
 /-- Public entry: type-check one constant (per-constant state reset inside;
-    block coordination + memoized block results). -/
+    block coordination + memoized block results).
+
+    A failed pending check may have populated reduction or block-generation
+    caches before discovering the error. `isolateCheckErrors` removes those
+    subject-dependent entries at the public boundary, while preserving lazy
+    loads, interning, fuel consumption, and cached block failures. -/
 def checkConst (id : KId m) : TcM m Unit :=
-  (RecM.checkConst id).run methods
+  isolateCheckErrors (runRec (RecM.checkConst id))
 
 end TcM
 
diff --git a/Ix/Tc/DefEq.lean b/Ix/Tc/DefEq.lean
index ab0e3e76..07e189bb 100644
--- a/Ix/Tc/DefEq.lean
+++ b/Ix/Tc/DefEq.lean
@@ -37,6 +37,12 @@ inductive LazyDeltaStep where
   | unknown
   deriving BEq, Repr, Inhabited
 
+/-- Result of the bounded Tier-4 delta loop: either a final equality answer,
+    or the pair on which the post-delta tiers must continue. -/
+inductive LazyDeltaLoopResult (m : Mode) where
+  | answer (result : Bool)
+  | stopped (a b : KExpr m)
+
 /-- Canonically ordered address pair (byte-lexicographic). -/
 def canonicalPair (a b : Address) : Address × Address :=
   if a.cmpBytes b != .gt then (a, b) else (b, a)
@@ -53,11 +59,89 @@ def headConstId (e : KExpr m) : Option (KId m) :=
 
 namespace RecM
 
+/-! ### Non-recursive definitional-equality helpers -/
+
+/-- Lexicographic rank comparison ((class, height) tuples). -/
+def compareRank (a b : Nat × Nat) : Ordering :=
+  match compare a.1 b.1 with
+  | .eq => compare a.2 b.2
+  | o => o
+
+def isNatLike (e : KExpr m) : RecM m Bool := do
+  let p ← prims
+  match e with
+  | .nat .. => return true
+  | .const id _ _ => return id.addr == p.natZero.addr
+  | .app f _ _ =>
+    match f with
+    | .const id _ _ => return id.addr == p.natSucc.addr
+    | _ => return false
+  | _ => return false
+
+def isNatZero (e : KExpr m) : RecM m Bool := do
+  let p ← prims
+  match e with
+  | .nat v _ _ => return v == 0
+  | .const id _ _ => return id.addr == p.natZero.addr
+  | _ => return false
+
+def natSuccOf (e : KExpr m) : RecM m (Option (KExpr m)) := do
+  let p ← prims
+  match e with
+  | .nat v _ _ =>
+    if v == 0 then
+      return none
+    return some (← TcM.intern (natExprFromValue (v - 1) : KExpr m))
+  | .app f arg _ =>
+    match f with
+    | .const id _ _ =>
+      if id.addr == p.natSucc.addr then
+        return some arg
+      return none
+    | _ => return none
+  | _ => return none
+
+def isBoolTrue (e : KExpr m) : RecM m Bool := do
+  match e with
+  | .const id us _ =>
+    return us.isEmpty && id.addr == (← prims).boolTrue.addr
+  | _ => return false
+
+/-- Is the constant delta-reducible (Definition/Theorem)? -/
+def isDelta (id : KId m) : RecM m Bool := do
+  match (← TcM.tryGetConst id) with
+  | some (.defn (kind := kind) ..) =>
+    match kind with
+    | .defn | .thm => return true
+    | .opaq => return false
+  | _ => return false
+
+/-- Regular reducibility hints (guards the same-head-spine attempt). -/
+def isRegular (id : KId m) : RecM m Bool := do
+  match (← TcM.tryGetConst id) with
+  | some (.defn (hints := .regular _) ..) => return true
+  | _ => return false
+
+/-- Reducibility rank `(class, height)`, lexicographic; higher unfolds
+    first. Opaque/Theorem/unknown `(0,0)`; `Regular h` `(1,h)`;
+    `Abbrev` `(2,0)`. -/
+def defRankId (id : KId m) : RecM m (Nat × Nat) := do
+  match (← TcM.tryGetConst id) with
+  | some (.defn (kind := kind) (hints := hints) ..) =>
+    match kind with
+    | .opaq | .thm => return (0, 0)
+    | .defn =>
+      match hints with
+      | .opaque => return (0, 0)
+      | .regular h => return (1, h.toNat)
+      | .abbrev => return (2, 0)
+  | _ => return (0, 0)
+
 mutual
 
 /-- Definitional equality entry point: fast paths, equiv-manager, caches
     (with cheap-mode routing), fuel/depth accounting, then the tiers. -/
-partial def isDefEq (a b : KExpr m) : RecM m Bool := do
+def isDefEq (a b : KExpr m) : RecM m Bool := do
   TcM.stepTrace (m := m) "deq" fun _ =>
     s!"{TcM.addr8 a.addr} ~ {TcM.addr8 b.addr}"
   TcM.bumpStats (m := m) fun s => { s with deqCalls := s.deqCalls + 1 }
@@ -160,7 +244,7 @@ partial def isDefEq (a b : KExpr m) : RecM m Bool := do
       defEqCache := s.env.defEqCache.insert cacheKey ok } }
   return ok
 
-partial def isDefEqInner (a b : KExpr m) : RecM m Bool := do
+def isDefEqInner (a b : KExpr m) : RecM m Bool := do
   -- Tier 1: quick structural.
   if (← quickDefEq a b) then
     return true
@@ -186,8 +270,8 @@ partial def isDefEqInner (a b : KExpr m) : RecM m Bool := do
     return true
   if (← quickDefEq ca cb) then
     return true
-  let mut wa ← whnfNoDeltaForDefEq a
-  let mut wb ← whnfNoDeltaForDefEq b
+  let wa ← whnfNoDeltaForDefEq a
+  let wb ← whnfNoDeltaForDefEq b
   if wa.addr == wb.addr then
     return true
   if (← quickDefEq wa wb) then
@@ -196,30 +280,29 @@ partial def isDefEqInner (a b : KExpr m) : RecM m Bool := do
   if (← tryProofIrrel wa wb) then
     return true
   -- Tier 4: iterative lazy delta.
-  let mut fuel := maxWhnfFuel
-  let mut broke := false
-  repeat
-    if fuel == 0 then
-      throw .maxRecDepth
-    fuel := fuel - 1
+  let step (state : KExpr m × KExpr m) :
+      RecM m (BoundedStep (KExpr m × KExpr m) (LazyDeltaLoopResult m)) := do
+    let (wa0, wb0) := state
+    let mut wa := wa0
+    let mut wb := wb0
     -- Nat offset comparison at the top of the loop.
     if let some result ← tryDefEqOffset wa wb then
-      return result
+      return .done (.answer result)
     -- Nat primitives gated on closed terms (or eagerReduce).
     let natOk := (!wa.hasFVars && !wb.hasFVars) || (← get).eagerReduce
     if natOk then
       if let some wa2 ← tryReduceNat wa then
-        return (← isDefEq wa2 wb)
+        return .done (.answer (← isDefEqCall wa2 wb))
       if let some wb2 ← tryReduceNat wb then
-        return (← isDefEq wa wb2)
+        return .done (.answer (← isDefEqCall wa wb2))
     if let some wa2 ← tryReduceNative wa then
-      return (← isDefEq wa2 wb)
+      return .done (.answer (← isDefEqCall wa2 wb))
     if let some wb2 ← tryReduceNative wb then
-      return (← isDefEq wa wb2)
+      return .done (.answer (← isDefEqCall wa wb2))
     if let some wa2 ← tryReduceDecidable wa then
-      return (← isDefEq wa2 wb)
+      return .done (.answer (← isDefEqCall wa2 wb))
     if let some wb2 ← tryReduceDecidable wb then
-      return (← isDefEq wa wb2)
+      return .done (.answer (← isDefEqCall wa wb2))
     let aHead := headConstId wa
     let bHead := headConstId wb
     let aDelta ← match aHead with
@@ -229,17 +312,14 @@ partial def isDefEqInner (a b : KExpr m) : RecM m Bool := do
       | some h => isDelta h
       | none => pure false
     if !aDelta && !bDelta then
-      broke := true
-      break
+      return .done (.stopped wa wb)
     -- Before unfolding, try reducing projection apps on the other side.
     if aDelta && !bDelta then
       if let some wb2 ← tryUnfoldProjApp wb then
-        wb := wb2
-        continue
+        return .next (wa, wb2)
     else if bDelta && !aDelta then
       if let some wa2 ← tryUnfoldProjApp wa then
-        wa := wa2
-        continue
+        return .next (wa2, wb)
     if aDelta && bDelta then
       let waW ← match aHead with
         | some h => defRankId h
@@ -255,7 +335,7 @@ partial def isDefEqInner (a b : KExpr m) : RecM m Bool := do
             let failureKey := (flo, fhi, ← TcM.defEqCtxKey wa wb)
             if !(← get).env.defEqFailure.contains failureKey then
               if let some result ← trySameHeadSpine wa wb then
-                return result
+                return .done (.answer result)
               -- Attempted and failed — record.
               modify fun s => { s with env := { s.env with
                 defEqFailure := s.env.defEqFailure.insert failureKey } }
@@ -271,65 +351,57 @@ partial def isDefEqInner (a b : KExpr m) : RecM m Bool := do
         | none, some ub =>
           wb ← whnfNoDeltaForDefEq ub
         | none, none =>
-          broke := true
-          break
+          return .done (.stopped wa wb)
       else if compareRank waW wbW == .gt then
         match (← deltaUnfoldOne wa) with
         | some ua => wa ← whnfNoDeltaForDefEq ua
         | none =>
-          broke := true
-          break
+          return .done (.stopped wa wb)
       else
         match (← deltaUnfoldOne wb) with
         | some ub => wb ← whnfNoDeltaForDefEq ub
         | none =>
-          broke := true
-          break
+          return .done (.stopped wa wb)
     else if aDelta then
       match (← deltaUnfoldOne wa) with
       | some ua => wa ← whnfNoDeltaForDefEq ua
       | none =>
-        broke := true
-        break
+        return .done (.stopped wa wb)
     else
       match (← deltaUnfoldOne wb) with
       | some ub => wb ← whnfNoDeltaForDefEq ub
       | none =>
-        broke := true
-        break
+        return .done (.stopped wa wb)
     if wa.addr == wb.addr then
-      return true
+      return .done (.answer true)
     if (← quickDefEq wa wb) then
+      return .done (.answer true)
+    return .next (wa, wb)
+  match ← runBounded step maxWhnfFuel.toNat (wa, wb) with
+  | .answer result => return result
+  | .stopped wa wb =>
+    -- Tier 4b: post-delta structural congruence.
+    if (← tryStructuralCongruence wa wb) then
       return true
-  let _ := broke
-  -- Tier 4b: post-delta structural congruence.
-  if (← tryStructuralCongruence wa wb) then
-    return true
-  -- Tier 4c: second structural pass — whnfCore, NOT full whnf.
-  let waCore ← whnfCore wa
-  let wbCore ← whnfCore wb
-  let waChanged := waCore.addr != wa.addr
-  let wbChanged := wbCore.addr != wb.addr
-  if waChanged || wbChanged then
-    return (← isDefEq waCore wbCore)
-  if waCore.addr == wbCore.addr then
-    return true
-  if (← quickDefEq waCore wbCore) then
-    return true
-  -- Tier 4d: app-spine comparison.
-  if (← tryDefEqApp waCore wbCore) then
-    return true
-  isDefEqWhnf waCore wbCore
-
-/-- Lexicographic rank comparison ((class, height) tuples). -/
-partial def compareRank (a b : Nat × Nat) : Ordering :=
-  match compare a.1 b.1 with
-  | .eq => compare a.2 b.2
-  | o => o
+    -- Tier 4c: second structural pass — whnfCore, NOT full whnf.
+    let waCore ← whnfCore wa
+    let wbCore ← whnfCore wb
+    let waChanged := waCore.addr != wa.addr
+    let wbChanged := wbCore.addr != wb.addr
+    if waChanged || wbChanged then
+      return (← isDefEqCall waCore wbCore)
+    if waCore.addr == wbCore.addr then
+      return true
+    if (← quickDefEq waCore wbCore) then
+      return true
+    -- Tier 4d: app-spine comparison.
+    if (← tryDefEqApp waCore wbCore) then
+      return true
+    isDefEqWhnf waCore wbCore
 
 /-- Tier-1 quick structural: same ctor, same children (binders open both
     bodies with the SAME fresh fvar — the common-fvar trick). -/
-partial def quickDefEq (a b : KExpr m) : RecM m Bool := do
+def quickDefEq (a b : KExpr m) : RecM m Bool := do
   match a, b with
   | .sort u1 _, .sort u2 _ => return univEq u1 u2
   | .lam name bi ty1 body1 _, .lam _ _ ty2 body2 _ =>
@@ -338,9 +410,9 @@ partial def quickDefEq (a b : KExpr m) : RecM m Bool := do
     quickBinder name bi ty1 body1 ty2 body2
   | _, _ => return false
 
-partial def quickBinder (name : m.F Name) (bi : m.F Lean.BinderInfo)
+def quickBinder (name : m.F Name) (bi : m.F Lean.BinderInfo)
     (ty1 body1 ty2 body2 : KExpr m) : RecM m Bool := do
-  if !(← isDefEq ty1 ty2) then
+  if !(← isDefEqCall ty1 ty2) then
     return false
   let saved := (← get).lctx.size
   let fvId ← TcM.freshFVarId (m := m)
@@ -350,7 +422,7 @@ partial def quickBinder (name : m.F Name) (bi : m.F Lean.BinderInfo)
   let b2Open ← TcM.runIntern (instantiateRev body2 #[fv])
   let r ←
     try
-      let r ← isDefEq b1Open b2Open
+      let r ← isDefEqCall b1Open b2Open
       pure (Except.ok r)
     catch e =>
       pure (Except.error e)
@@ -361,7 +433,7 @@ partial def quickBinder (name : m.F Name) (bi : m.F Lean.BinderInfo)
 
 /-- Both are `C us args` with the same head: compare spines without
     unfolding. `none` means "not applicable / spine differs". -/
-partial def trySameHeadSpine (a b : KExpr m) : RecM m (Option Bool) := do
+def trySameHeadSpine (a b : KExpr m) : RecM m (Option Bool) := do
   let (aHead, aArgs) := a.collectSpine
   let (bHead, bArgs) := b.collectSpine
   let .const aId aUs _ := aHead | return none
@@ -374,12 +446,12 @@ partial def trySameHeadSpine (a b : KExpr m) : RecM m (Option Bool) := do
     if !univEq u v then
       return none
   for (ai, bi) in aArgs.zip bArgs do
-    if !(← isDefEq ai bi) then
+    if !(← isDefEqCall ai bi) then
       return none
   return some true
 
 /-- Tier 5: full structural + eta / struct-eta / unit / proof irrelevance. -/
-partial def isDefEqWhnf (a b : KExpr m) : RecM m Bool := do
+def isDefEqWhnf (a b : KExpr m) : RecM m Bool := do
   match a, b with
   | .sort u1 _, .sort u2 _ => return univEq u1 u2
   | .var i _ _, .var j _ _ =>
@@ -395,8 +467,8 @@ partial def isDefEqWhnf (a b : KExpr m) : RecM m Bool := do
     -- PROOF: comparing proof pairs whose value pair already failed forces
     -- unbounded proof normalization (e.g. materializing `Nat.le`
     -- derivations — the `minEntry!_eq_get!_minEntry?` OOM).
-    if (← isDefEq f1 f2) then
-      if (← isDefEq a1 a2) then
+    if (← isDefEqCall f1 f2) then
+      if (← isDefEqCall a1 a2) then
         return true
   | .lam name bi ty1 body1 _, .lam _ _ ty2 body2 _ =>
     if (← quickBinder name bi ty1 body1 ty2 body2) then
@@ -407,15 +479,15 @@ partial def isDefEqWhnf (a b : KExpr m) : RecM m Bool := do
   | .letE name ty1 v1 body1 _ _, .letE _ ty2 v2 body2 _ _ =>
     -- Normally zeta-reduced before reaching here; push LDecl in case.
     -- Short-circuit like the app case (Rust `&&` semantics).
-    if (← isDefEq ty1 ty2) then
-      if (← isDefEq v1 v2) then
+    if (← isDefEqCall ty1 ty2) then
+      if (← isDefEqCall v1 v2) then
         let saved := (← get).lctx.size
         let fvId ← TcM.freshFVarId (m := m)
         let fv ← TcM.intern (.mkFVar fvId name)
         modify fun s => { s with lctx := s.lctx.push fvId (.ldecl name ty1 v1) }
         let b1Open ← TcM.runIntern (instantiateRev body1 #[fv])
         let b2Open ← TcM.runIntern (instantiateRev body2 #[fv])
-        let r ← isDefEq b1Open b2Open
+        let r ← isDefEqCall b1Open b2Open
         modify fun s => { s with lctx := s.lctx.truncate saved }
         if r then
           return true
@@ -451,21 +523,21 @@ partial def isDefEqWhnf (a b : KExpr m) : RecM m Bool := do
   tryProofIrrel a b
 
 /-- Proof irrelevance: both proofs of the same Prop. -/
-partial def tryProofIrrel (a b : KExpr m) : RecM m Bool := do
-  let some aTy ← try? (TcM.withInferOnly ((← read).infer a)) | return false
+def tryProofIrrel (a b : KExpr m) : RecM m Bool := do
+  let some aTy ← try? (inferOnlyCall a) | return false
   if !(← isPropType aTy) then
     return false
-  let some bTy ← try? (TcM.withInferOnly ((← read).infer b)) | return false
-  isDefEq aTy bTy
+  let some bTy ← try? (inferOnlyCall b) | return false
+  isDefEqCall aTy bTy
 
 /-- Is `ty : Sort 0`? Memoized on `(tyAddr, ctxAddr)`; inner-chain errors
     treated as non-prop. -/
-partial def isPropType (ty : KExpr m) : RecM m Bool := do
+def isPropType (ty : KExpr m) : RecM m Bool := do
   let cacheKey := (ty.addr, ← TcM.ctxAddrForLbr (m := m) ty.lbr)
   if let some cached := (← get).env.isPropCache[cacheKey]? then
     return cached
   let result ← (do
-    match (← try? (TcM.withInferOnly ((← read).infer ty))) with
+    match (← try? (inferOnlyCall ty)) with
     | none => pure false
     | some sort =>
       match (← try? (whnf sort)) with
@@ -477,8 +549,8 @@ partial def isPropType (ty : KExpr m) : RecM m Bool := do
 
 /-- Unit-like (non-recursive, 0 indices, 1 nullary ctor): any two
     inhabitants of the same unit-like type are def-eq. -/
-partial def tryDefEqUnit (a b : KExpr m) : RecM m Bool := do
-  let some aTy ← try? (TcM.withInferOnly ((← read).infer a)) | return false
+def tryDefEqUnit (a b : KExpr m) : RecM m Bool := do
+  let some aTy ← try? (inferOnlyCall a) | return false
   let some aTyW ← try? (whnf aTy) | return false
   let (aHead, _) := aTyW.collectSpine
   let .const aInd _ _ := aHead | return false
@@ -493,90 +565,56 @@ partial def tryDefEqUnit (a b : KExpr m) : RecM m Bool := do
     | _ => return false
   if !isUnit then
     return false
-  let some bTy ← try? (TcM.withInferOnly ((← read).infer b)) | return false
-  isDefEq aTyW bTy
-
-partial def isNatLike (e : KExpr m) : RecM m Bool := do
-  let p ← prims
-  match e with
-  | .nat .. => return true
-  | .const id _ _ => return id.addr == p.natZero.addr
-  | .app f _ _ =>
-    match f with
-    | .const id _ _ => return id.addr == p.natSucc.addr
-    | _ => return false
-  | _ => return false
-
-partial def isNatZero (e : KExpr m) : RecM m Bool := do
-  let p ← prims
-  match e with
-  | .nat v _ _ => return v == 0
-  | .const id _ _ => return id.addr == p.natZero.addr
-  | _ => return false
-
-partial def natSuccOf (e : KExpr m) : RecM m (Option (KExpr m)) := do
-  let p ← prims
-  match e with
-  | .nat v _ _ =>
-    if v == 0 then
-      return none
-    return some (← TcM.intern (natExprFromValue (v - 1) : KExpr m))
-  | .app f arg _ =>
-    match f with
-    | .const id _ _ =>
-      if id.addr == p.natSucc.addr then
-        return some arg
-      return none
-    | _ => return none
-  | _ => return none
+  let some bTy ← try? (inferOnlyCall b) | return false
+  isDefEqCall aTyW bTy
 
 /-- Nat-like comparison: literal fast path, zero/succ peeling. -/
-partial def isDefEqNat (a b : KExpr m) : RecM m Bool := do
+def isDefEqNat (a b : KExpr m) : RecM m Bool := do
   match a, b with
   | .nat va _ _, .nat vb _ _ => return va == vb
   | _, _ => pure ()
   if (← isNatZero a) && (← isNatZero b) then
     return true
   match (← natSuccOf a), (← natSuccOf b) with
-  | some aPred, some bPred => isDefEq aPred bPred
+  | some aPred, some bPred => isDefEqCall aPred bPred
   | _, _ => return false
 
 /-- Nat offset comparison in the lazy delta loop (`isDefEqOffset`). -/
-partial def tryDefEqOffset (a b : KExpr m) : RecM m (Option Bool) := do
+def tryDefEqOffset (a b : KExpr m) : RecM m (Option Bool) := do
   match a, b with
   | .nat va _ _, .nat vb _ _ => return some (va == vb)
   | _, _ => pure ()
   if (← isNatZero a) && (← isNatZero b) then
     return some true
   match (← natSuccOf a), (← natSuccOf b) with
-  | some aPred, some bPred => return some (← isDefEq aPred bPred)
+  | some aPred, some bPred => return some (← isDefEqCall aPred bPred)
   | _, _ => return none
 
 /-- Expand a string literal to ctor form and compare. -/
-partial def tryStringLitExpansion (t s : KExpr m) : RecM m Bool := do
+def tryStringLitExpansion (t s : KExpr m) : RecM m Bool := do
   let .str strVal _ _ := t | return false
   let expanded ← strLitToConstructor strVal
-  isDefEq expanded s
+  isDefEqCall expanded s
 
 /-- Lambda eta: `t` a lambda, `s` not — wrap `s` as `λ(ty). s #0`. -/
-partial def tryEtaExpansion (t s : KExpr m) : RecM m Bool := do
+def tryEtaExpansion (t s : KExpr m) : RecM m Bool := do
   let tIsLam := match t with | .lam .. => true | _ => false
   let sIsLam := match s with | .lam .. => true | _ => false
   if !tIsLam || sIsLam then
     return false
-  let some sTy ← try? (TcM.withInferOnly ((← read).infer s)) | return false
+  let some sTy ← try? (inferOnlyCall s) | return false
   let some sTyWhnf ← try? (whnf sTy) | return false
   let .all name bi ty _ _ := sTyWhnf | return false
   let sLifted ← TcM.runIntern (lift s 1 0)
   let v0 ← TcM.intern (.mkVar 0 anonN : KExpr m)
   let body ← TcM.intern (KExpr.mkApp sLifted v0)
   let sLam ← TcM.intern (.mkLam name bi ty body)
-  isDefEq t sLam
+  isDefEqCall t sLam
 
 /-- Struct eta: `s` a fully-applied ctor of a struct-like type; compare
     `prj i t ≡ s.args[params+i]` per field (types def-eq first; no Prop
     guard here — equality checking, not term construction). -/
-partial def tryEtaStruct (t s : KExpr m) : RecM m Bool := do
+def tryEtaStruct (t s : KExpr m) : RecM m Bool := do
   let tNorm ← (do
     match (← try? (whnfNoDelta t)) with
     | some w => pure w
@@ -591,21 +629,21 @@ partial def tryEtaStruct (t s : KExpr m) : RecM m Bool := do
     return false
   if !(← isStructLike inductId) then
     return false
-  let some sTy ← try? (TcM.withInferOnly ((← read).infer s)) | return false
-  let some tTy ← try? (TcM.withInferOnly ((← read).infer tNorm)) | return false
-  if !(← isDefEq tTy sTy) then
+  let some sTy ← try? (inferOnlyCall s) | return false
+  let some tTy ← try? (inferOnlyCall tNorm) | return false
+  if !(← isDefEqCall tTy sTy) then
     return false
   if let some base ← etaExpansionBase inductId numParams numFields sArgs then
-    if (← isDefEq tNorm base) then
+    if (← isDefEqCall tNorm base) then
       return true
   for i in [0:numFields] do
     let proj ← TcM.intern (.mkPrj inductId i.toUInt64 tNorm)
-    if !(← isDefEq proj sArgs[numParams + i]!) then
+    if !(← isDefEqCall proj sArgs[numParams + i]!) then
       return false
   return true
 
 /-- If every ctor field is `prj i base` of one common base, return it. -/
-partial def etaExpansionBase (inductId : KId m) (numParams numFields : Nat)
+def etaExpansionBase (inductId : KId m) (numParams numFields : Nat)
     (args : Array (KExpr m)) : RecM m (Option (KExpr m)) := do
   let mut base : Option (KExpr m) := none
   for i in [0:numFields] do
@@ -626,7 +664,7 @@ partial def etaExpansionBase (inductId : KId m) (numParams numFields : Nat)
   return base
 
 /-- App-spine comparison (isDefEqApp). -/
-partial def tryDefEqApp (a b : KExpr m) : RecM m Bool := do
+def tryDefEqApp (a b : KExpr m) : RecM m Bool := do
   let aIsApp := match a with | .app .. => true | _ => false
   let bIsApp := match b with | .app .. => true | _ => false
   if !aIsApp || !bIsApp then
@@ -635,51 +673,15 @@ partial def tryDefEqApp (a b : KExpr m) : RecM m Bool := do
   let (bHead, bArgs) := b.collectSpine
   if aArgs.size != bArgs.size then
     return false
-  if !(← isDefEq aHead bHead) then
+  if !(← isDefEqCall aHead bHead) then
     return false
   for (ai, bi) in aArgs.zip bArgs do
-    if !(← isDefEq ai bi) then
+    if !(← isDefEqCall ai bi) then
       return false
   return true
 
-partial def isBoolTrue (e : KExpr m) : RecM m Bool := do
-  match e with
-  | .const id us _ =>
-    return us.isEmpty && id.addr == (← prims).boolTrue.addr
-  | _ => return false
-
-/-- Is the constant delta-reducible (Definition/Theorem)? -/
-partial def isDelta (id : KId m) : RecM m Bool := do
-  match (← TcM.tryGetConst id) with
-  | some (.defn (kind := kind) ..) =>
-    match kind with
-    | .defn | .thm => return true
-    | .opaq => return false
-  | _ => return false
-
-/-- Regular reducibility hints (guards the same-head-spine attempt). -/
-partial def isRegular (id : KId m) : RecM m Bool := do
-  match (← TcM.tryGetConst id) with
-  | some (.defn (hints := .regular _) ..) => return true
-  | _ => return false
-
-/-- Reducibility rank `(class, height)`, lexicographic; higher unfolds
-    first. Opaque/Theorem/unknown `(0,0)`; `Regular h` `(1,h)`;
-    `Abbrev` `(2,0)`. -/
-partial def defRankId (id : KId m) : RecM m (Nat × Nat) := do
-  match (← TcM.tryGetConst id) with
-  | some (.defn (kind := kind) (hints := hints) ..) =>
-    match kind with
-    | .opaq | .thm => return (0, 0)
-    | .defn =>
-      match hints with
-      | .opaque => return (0, 0)
-      | .regular h => return (1, h.toNat)
-      | .abbrev => return (2, 0)
-  | _ => return (0, 0)
-
 /-- Post-delta structural congruence (Const/Var/Prj). -/
-partial def tryStructuralCongruence (a b : KExpr m) : RecM m Bool := do
+def tryStructuralCongruence (a b : KExpr m) : RecM m Bool := do
   match a, b with
   | .const id1 us1 _, .const id2 us2 _ =>
     return id1.addr == id2.addr && us1.size == us2.size
@@ -691,30 +693,24 @@ partial def tryStructuralCongruence (a b : KExpr m) : RecM m Bool := do
     lazyDeltaProjReduction id1 f1 v1 v2
   | _, _ => return false
 
-partial def lazyDeltaProjReduction (structId : KId m) (field : UInt64)
+def lazyDeltaProjReduction (structId : KId m) (field : UInt64)
     (a0 b0 : KExpr m) : RecM m Bool := do
-  let mut a := a0
-  let mut b := b0
-  let mut fuel := maxWhnfFuel
-  repeat
-    if fuel == 0 then
-      throw .maxRecDepth
-    fuel := fuel - 1
-    let (step, a', b') ← lazyDeltaReductionStep a b
-    a := a'
-    b := b'
-    match step with
-    | .equal => return true
-    | .continue' => continue
+  let step (state : KExpr m × KExpr m) :
+      RecM m (BoundedStep (KExpr m × KExpr m) Bool) := do
+    let (a, b) := state
+    let (outcome, a, b) ← lazyDeltaReductionStep a b
+    match outcome with
+    | .equal => return .done true
+    | .continue' => return .next (a, b)
     | .unknown =>
       let pa ← tryProjReduce structId field a
       let pb ← tryProjReduce structId field b
       match pa, pb with
-      | some pa, some pb => return (← isDefEq pa pb)
-      | _, _ => return (← isDefEq a b)
-  return false
+      | some pa, some pb => return .done (← isDefEqCall pa pb)
+      | _, _ => return .done (← isDefEqCall a b)
+  runBounded step maxWhnfFuel.toNat (a0, b0)
 
-partial def lazyDeltaReductionStep (a0 b0 : KExpr m) :
+def lazyDeltaReductionStep (a0 b0 : KExpr m) :
     RecM m (LazyDeltaStep × KExpr m × KExpr m) := do
   let mut a := a0
   let mut b := b0
@@ -774,7 +770,7 @@ partial def lazyDeltaReductionStep (a0 b0 : KExpr m) :
   return (.continue', a, b)
 
 /-- Head-Prj: one whnf-no-delta attempt (tryUnfoldProjApp). -/
-partial def tryUnfoldProjApp (e : KExpr m) : RecM m (Option (KExpr m)) := do
+def tryUnfoldProjApp (e : KExpr m) : RecM m (Option (KExpr m)) := do
   let (head, _) := e.collectSpine
   match head with
   | .prj .. => pure ()
diff --git a/Ix/Tc/Env.lean b/Ix/Tc/Env.lean
index a90043b5..f855304c 100644
--- a/Ix/Tc/Env.lean
+++ b/Ix/Tc/Env.lean
@@ -261,6 +261,63 @@ def clearReductionCaches (env : KEnv m) : KEnv m :=
     natSuccStuck := {}
     isPropCache := {} }
 
+/-- One fold step for error-side block-result restoration. -/
+def restoreBlockCheckResultOnError
+    (before results : Std.HashMap (KId m) (Except (TcError m) Unit))
+    (block : KId m) (result : Except (TcError m) Unit) :
+    Std.HashMap (KId m) (Except (TcError m) Unit) :=
+  match result with
+  | .ok () => results
+  | .error _ =>
+    match before[block]? with
+    | some _ => results
+    | none => results.insert block result
+
+/-- Preserve every old block verdict and add only previously absent errors
+from a failing run. A post-error value can therefore never replace a cached
+success (or a prior deterministic failure). -/
+def restoreBlockCheckResultsOnError
+    (before after : Std.HashMap (KId m) (Except (TcError m) Unit)) :
+    Std.HashMap (KId m) (Except (TcError m) Unit) :=
+  after.fold (init := before) (restoreBlockCheckResultOnError before)
+
+/-- Roll back every cache whose new contents may have been computed from the
+    declaration (or atomic block) currently being checked.
+
+    This is the error-side isolation boundary for `TcM.checkConst`.
+    Reduction caches can contain intermediate facts from a computation that
+    eventually failed; the inductive/recursor caches are even more directly
+    subject-scoped. None of the entries created by that failing computation
+    may become warm input to the next pending declaration. Entries present in
+    `before` are retained: their provenance was established at an earlier
+    successful boundary.
+
+    Non-cache state comes from `after`, preserving lazy loads, interned nodes,
+    the fvar counter, and ingress structure. `blockCheckResults` keeps all old
+    entries plus newly cached *errors*: unlike a cached success, a failure
+    cannot justify acceptance and deterministic replay remains useful. -/
+def restoreCheckCachesOnError (before after : KEnv m) : KEnv m :=
+  { after with
+    whnfCache := before.whnfCache
+    whnfNoDeltaCache := before.whnfNoDeltaCache
+    whnfNoDeltaCheapCache := before.whnfNoDeltaCheapCache
+    whnfCoreCache := before.whnfCoreCache
+    whnfCoreCheapCache := before.whnfCoreCheapCache
+    inferCache := before.inferCache
+    inferOnlyCache := before.inferOnlyCache
+    defEqCache := before.defEqCache
+    defEqCheapCache := before.defEqCheapCache
+    defEqFailure := before.defEqFailure
+    unfoldCache := before.unfoldCache
+    natSuccStuck := before.natSuccStuck
+    isPropCache := before.isPropCache
+    isRecCache := before.isRecCache
+    recursorCache := before.recursorCache
+    recMajorsCache := before.recMajorsCache
+    blockPeerAgreementCache := before.blockPeerAgreementCache
+    blockCheckResults := restoreBlockCheckResultsOnError
+      before.blockCheckResults after.blockCheckResults }
+
 /-- Snapshot of all cache sizes (diagnostics). -/
 def cacheSizes (env : KEnv m) : KEnvCacheSizes where
   consts := env.consts.size
diff --git a/Ix/Tc/Equiv.lean b/Ix/Tc/Equiv.lean
index 006599bf..5048ec75 100644
--- a/Ix/Tc/Equiv.lean
+++ b/Ix/Tc/Equiv.lean
@@ -54,14 +54,23 @@ def nodeForKey (em : EquivManager) (key : EqKey) : Nat × EquivManager :=
       nodeToKey := em.nodeToKey.push key
       keyToNode := em.keyToNode.insert key node })
 
-/-- Find root with path halving (every other node → grandparent). -/
-def find (em : EquivManager) (node : Nat) : Nat × EquivManager := Id.run do
-  let mut parent := em.parent
-  let mut n := node
-  while parent[n]! != n do
-    parent := parent.set! n parent[parent[n]!]!
-    n := parent[n]!
-  return (n, { em with parent })
+/-- Find root with path halving (every other node → grandparent). A
+    well-formed union-find forest reaches a root in fewer than
+    `parent.size` hops; the explicit bound replaces the proof-opaque loop.
+    The zero branch is reachable only for a malformed cyclic table. -/
+def find (em : EquivManager) (node : Nat) : Nat × EquivManager :=
+  let (root, parent) := go em.parent node em.parent.size
+  (root, { em with parent })
+where
+  go (parent : Array Nat) (n : Nat) : Nat → Nat × Array Nat
+    | 0 => (n, parent)
+    | fuel + 1 =>
+      if parent[n]! != n then
+        let parent := parent.set! n parent[parent[n]!]!
+        let n := parent[n]!
+        go parent n fuel
+      else
+        (n, parent)
 
 /-- Union by rank. Returns `true` if the sets were different. -/
 def union (em : EquivManager) (a b : Nat) : Bool × EquivManager := Id.run do
diff --git a/Ix/Tc/Expr.lean b/Ix/Tc/Expr.lean
index 1dcb2691..67de6670 100644
--- a/Ix/Tc/Expr.lean
+++ b/Ix/Tc/Expr.lean
@@ -113,6 +113,21 @@ def info : KExpr m → ExprInfo m
 @[inline] def hasFVars (e : KExpr m) : Bool := e.info.hasFVars
 @[inline] def mdata (e : KExpr m) : m.F (Array MData) := e.info.mdata
 
+/-- Number of expression nodes, ignoring cached metadata. Used as a
+    termination measure for stack-based production traversals; it does not
+    participate in expression hashing or runtime fuel. -/
+def treeSize : KExpr m → Nat
+  | .var .. | .fvar .. | .sort .. | .const .. | .nat .. | .str .. => 1
+  | .app f a _ => f.treeSize + a.treeSize + 1
+  | .lam _ _ ty body _ | .all _ _ ty body _ =>
+    ty.treeSize + body.treeSize + 1
+  | .letE _ ty val body _ _ =>
+    ty.treeSize + val.treeSize + body.treeSize + 1
+  | .prj _ _ val _ => val.treeSize + 1
+
+@[simp] theorem treeSize_pos (e : KExpr m) : 0 < e.treeSize := by
+  cases e <;> simp [treeSize]
+
 /-- The metadata-aware address as a plain `Address` (meta mode; `default`
     is unreachable — every meta node carries one). -/
 @[inline] def metaAddrD (e : KExpr m) : Address :=
@@ -413,11 +428,11 @@ where
 
 /-! ### Display (diagnostics only) -/
 
-/-- Meta mode shows names when available; anon mode shows positional/hash
-    fallbacks. Depth-capped. Mirrors Rust `fmt_expr`. -/
-partial def render (e : KExpr m) (depth : Nat := 0) : String :=
-  if depth > 20 then "..."
-  else match e with
+/-- Total worker for `render`. `fuel = 21 - depth` is exactly the historical
+    `depth > 20` cutoff, made explicit for the recursive calls. -/
+def renderFuel : Nat → KExpr m → Nat → String
+  | 0, _, _ => "..."
+  | fuel + 1, e, depth => match e with
     | .var idx name _ =>
       if MetaDisplay.hasMeta name then MetaDisplay.metaFmt name
       else s!"#{idx.toNat}"
@@ -433,21 +448,32 @@ partial def render (e : KExpr m) (depth : Nat := 0) : String :=
         s!"{base}.\{{lvls}}"
     | .app .. =>
       let (head, args) := collectSpine e
-      let parts := (head :: args.toList).map (render · (depth + 1))
+      let parts := (head :: args.toList).map
+        (fun e => renderFuel fuel e (depth + 1))
       s!"({String.intercalate " " parts})"
     | .lam name _ ty body _ =>
       let n := if MetaDisplay.hasMeta name then MetaDisplay.metaFmt name else "_"
-      s!"(fun ({n} : {render ty (depth + 1)}) => {render body (depth + 1)})"
+      s!"(fun ({n} : {renderFuel fuel ty (depth + 1)}) => \
+        {renderFuel fuel body (depth + 1)})"
     | .all name _ ty body _ =>
       let n := if MetaDisplay.hasMeta name then MetaDisplay.metaFmt name else "_"
-      s!"(({n} : {render ty (depth + 1)}) -> {render body (depth + 1)})"
+      s!"(({n} : {renderFuel fuel ty (depth + 1)}) -> \
+        {renderFuel fuel body (depth + 1)})"
     | .letE name ty val body _ _ =>
       let n := if MetaDisplay.hasMeta name then MetaDisplay.metaFmt name else "_"
-      s!"(let {n} : {render ty (depth + 1)} := {render val (depth + 1)} in {render body (depth + 1)})"
-    | .prj id field val _ => s!"{render val (depth + 1)}.{field.toNat}@{id}"
+      s!"(let {n} : {renderFuel fuel ty (depth + 1)} := \
+        {renderFuel fuel val (depth + 1)} in \
+        {renderFuel fuel body (depth + 1)})"
+    | .prj id field val _ =>
+      s!"{renderFuel fuel val (depth + 1)}.{field.toNat}@{id}"
     | .nat val _ _ => toString val
     | .str val _ _ => reprStr val
 
+/-- Meta mode shows names when available; anon mode shows positional/hash
+    fallbacks. Depth-capped. Mirrors Rust `fmt_expr`. -/
+def render (e : KExpr m) (depth : Nat := 0) : String :=
+  renderFuel (21 - depth) e depth
+
 instance : ToString (KExpr m) := ⟨(render ·)⟩
 
 instance : Repr (KExpr m) := ⟨fun e _ => .text e.render⟩
diff --git a/Ix/Tc/Inductive.lean b/Ix/Tc/Inductive.lean
index a30b89d9..3de498b7 100644
--- a/Ix/Tc/Inductive.lean
+++ b/Ix/Tc/Inductive.lean
@@ -76,72 +76,122 @@ def sortedDedupIds (ids : Array (KId m)) : Array (KId m) := Id.run do
     | none => out := out.push id
   return out
 
+/-- Sum of pending universe constructors in the validation worklist. -/
+def univWorkSize : List (KUniv m) → Nat
+  | [] => 0
+  | u :: stack => u.size + univWorkSize stack
+
+/-- Sum of pending expression nodes in the depth-indexed validation
+    worklist. The depth annotation does not affect termination. -/
+def scopedExprWorkSize : List (KExpr m × UInt64) → Nat
+  | [] => 0
+  | (e, _) :: stack => e.treeSize + scopedExprWorkSize stack
+
+/-- Peel the syntactic forall prefix used when building a rule IH. This is
+    structural: unlike the surrounding reducer-driven telescope scans, no
+    WHNF or binder instantiation occurs between iterations. -/
+def peelRuleIhForalls (root : KExpr m) (flat : Array (FlatBlockMember m)) :
+    Array (KExpr m) × KExpr m :=
+  go root #[]
+where
+  go (inner : KExpr m) (domains : Array (KExpr m)) :
+      Array (KExpr m) × KExpr m :=
+    match inner with
+    | .all _ _ dom body _ =>
+      let (head, _) := inner.collectSpine
+      let isFlatHead := match head with
+        | .const id _ _ => flat.any (·.id.addr == id.addr)
+        | _ => false
+      if isFlatHead then (domains, inner)
+      else go body (domains.push dom)
+    | _ => (domains, inner)
+  termination_by inner.treeSize
+  decreasing_by
+    simp [KExpr.treeSize]
+    omega
+
 mutual
 
 -- ### Well-scopedness validation (check.rs)
 
 /-- Universe params in range, iterative with an addr-keyed seen set. -/
-partial def validateUnivParamsSeen (root : KUniv m) (bound : Nat)
-    (seen : HashSet Address) : RecM m (HashSet Address) := do
-  let mut seen := seen
-  let mut stack : Array (KUniv m) := #[root]
-  while !stack.isEmpty do
-    let u := stack.back!
-    stack := stack.pop
-    if seen.contains u.addr then
-      continue
-    seen := seen.insert u.addr
-    match u with
-    | .zero _ => pure ()
-    | .succ inner _ => stack := stack.push inner
-    | .max a b _ | .imax a b _ =>
-      stack := stack.push a |>.push b
-    | .param idx _ _ =>
-      if idx.toNat ≥ bound then
-        throw (.univParamOutOfRange idx bound)
-  return seen
+def validateUnivParamsSeen (root : KUniv m) (bound : Nat)
+    (seen : HashSet Address) : RecM m (HashSet Address) :=
+  go [root] seen
+where
+  /-- Head-of-list is the old Array stack's back. -/
+  go (stack : List (KUniv m)) (seen : HashSet Address) :
+      RecM m (HashSet Address) :=
+    match stack with
+    | [] => pure seen
+    | u :: stack => do
+      if seen.contains u.addr then
+        return (← go stack seen)
+      let seen := seen.insert u.addr
+      match u with
+      | .zero _ => go stack seen
+      | .succ inner _ => go (inner :: stack) seen
+      | .max a b _ | .imax a b _ => go (b :: a :: stack) seen
+      | .param idx _ _ =>
+        if idx.toNat ≥ bound then
+          throw (.univParamOutOfRange idx bound)
+        go stack seen
+  termination_by univWorkSize stack
+  decreasing_by
+    all_goals simp [univWorkSize, KUniv.size, KUniv.size_pos] <;> omega
 
 /-- Closed at top level; every `param` within the declaration's own level
     arity; const arities match; prj heads known. Iterative, memoized on
     `(addr, depth)`. Mirrors check.rs `validate_expr_well_scoped`. -/
-partial def validateExprWellScoped (root : KExpr m) (rootDepth : UInt64)
-    (lvlBound : Nat) : RecM m Unit := do
-  let mut stack : Array (KExpr m × UInt64) := #[(root, rootDepth)]
-  let mut seenExprs : HashSet (Address × UInt64) := {}
-  let mut seenUnivs : HashSet Address := {}
-  while !stack.isEmpty do
-    let (e, depth) := stack.back!
-    stack := stack.pop
-    if seenExprs.contains (e.addr, depth) then
-      continue
-    seenExprs := seenExprs.insert (e.addr, depth)
-    match e with
-    | .var idx _ _ =>
-      if idx ≥ depth then
-        throw (.varOutOfRange idx depth.toNat)
-    | .sort u _ =>
-      seenUnivs ← validateUnivParamsSeen u lvlBound seenUnivs
-    | .const id us _ =>
-      let c ← TcM.getConst id
-      if c.lvls.toNat != us.size then
-        throw (.univParamMismatch c.lvls us.size)
-      for u in us do
-        seenUnivs ← validateUnivParamsSeen u lvlBound seenUnivs
-    | .app f a _ =>
-      stack := stack.push (f, depth) |>.push (a, depth)
-    | .lam _ _ ty body _ | .all _ _ ty body _ =>
-      stack := stack.push (ty, depth) |>.push (body, depth + 1)
-    | .letE _ ty val body _ _ =>
-      stack := stack.push (ty, depth) |>.push (val, depth)
-        |>.push (body, depth + 1)
-    | .prj id _ val _ =>
-      if !(← TcM.hasConst id) then
-        throw (.unknownConst id.addr)
-      stack := stack.push (val, depth)
-    -- FVars carry no de Bruijn index; leaves.
-    | .fvar .. | .nat .. | .str .. => pure ()
-
-partial def validateConstWellScoped (c : KConst m) : RecM m Unit := do
+def validateExprWellScoped (root : KExpr m) (rootDepth : UInt64)
+    (lvlBound : Nat) : RecM m Unit :=
+  go [(root, rootDepth)] {} {}
+where
+  /-- LIFO order matches the former Array worklist. -/
+  go (stack : List (KExpr m × UInt64))
+      (seenExprs : HashSet (Address × UInt64))
+      (seenUnivs : HashSet Address) : RecM m Unit :=
+    match stack with
+    | [] => pure ()
+    | (e, depth) :: stack => do
+      if seenExprs.contains (e.addr, depth) then
+        return (← go stack seenExprs seenUnivs)
+      let seenExprs := seenExprs.insert (e.addr, depth)
+      match e with
+      | .var idx _ _ =>
+        if idx ≥ depth then
+          throw (.varOutOfRange idx depth.toNat)
+        go stack seenExprs seenUnivs
+      | .sort u _ =>
+        let seenUnivs ← validateUnivParamsSeen u lvlBound seenUnivs
+        go stack seenExprs seenUnivs
+      | .const id us _ =>
+        let c ← TcM.getConst id
+        if c.lvls.toNat != us.size then
+          throw (.univParamMismatch c.lvls us.size)
+        let mut seenUnivs := seenUnivs
+        for u in us do
+          seenUnivs ← validateUnivParamsSeen u lvlBound seenUnivs
+        go stack seenExprs seenUnivs
+      | .app f a _ =>
+        go ((a, depth) :: (f, depth) :: stack) seenExprs seenUnivs
+      | .lam _ _ ty body _ | .all _ _ ty body _ =>
+        go ((body, depth + 1) :: (ty, depth) :: stack) seenExprs seenUnivs
+      | .letE _ ty val body _ _ =>
+        go ((body, depth + 1) :: (val, depth) :: (ty, depth) :: stack)
+          seenExprs seenUnivs
+      | .prj id _ val _ =>
+        if !(← TcM.hasConst id) then
+          throw (.unknownConst id.addr)
+        go ((val, depth) :: stack) seenExprs seenUnivs
+      -- FVars carry no de Bruijn index; leaves.
+      | .fvar .. | .nat .. | .str .. => go stack seenExprs seenUnivs
+  termination_by scopedExprWorkSize stack
+  decreasing_by
+    all_goals
+      simp [scopedExprWorkSize, KExpr.treeSize, KExpr.treeSize_pos] <;> omega
+
+def validateConstWellScoped (c : KConst m) : RecM m Unit := do
   let lvlBound := c.lvls.toNat
   validateExprWellScoped c.ty 0 lvlBound
   match c with
@@ -155,7 +205,7 @@ partial def validateConstWellScoped (c : KConst m) : RecM m Unit := do
 -- ### Sort/eliminator analysis
 
 /-- Result sort after peeling `n` foralls (opened with fresh fvars). -/
-partial def getResultSortLevel (ty : KExpr m) (n : Nat) :
+def getResultSortLevel (ty : KExpr m) (n : Nat) :
     RecM m (KUniv m) := do
   let saved := (← get).lctx.size
   let mut t := ty
@@ -180,7 +230,7 @@ partial def getResultSortLevel (ty : KExpr m) (n : Nat) :
 /-- Large eliminator (can target any universe): non-Prop, or Empty-like
     (0 ctors), or single-ctor Prop whose non-Prop fields all appear among
     the return-type args (lean4lean `isLargeEliminator`). -/
-partial def isLargeEliminator (resultLevel : KUniv m)
+def isLargeEliminator (resultLevel : KUniv m)
     (indInfos : Array (KId m × UInt64 × UInt64 × Array (KId m) × KExpr m)) :
     RecM m Bool := do
   -- isNeverZero (not !isZero) so Param(u) falls through to the check below.
@@ -208,7 +258,7 @@ partial def isLargeEliminator (resultLevel : KUniv m)
       match w with
       | .all _ _ dom body _ =>
         if i ≥ nParams then
-          let domTy ← TcM.withInferOnly ((← read).infer dom)
+          let domTy ← inferOnlyCall dom
           match (← try? (ensureSortDirect domTy)) with
           | some sortLvl =>
             if !univEq sortLvl .mkZero then
@@ -232,7 +282,7 @@ partial def isLargeEliminator (resultLevel : KUniv m)
 
 /-- K-like target: single non-mutual inductive, Prop result (semantic zero),
     exactly one constructor with zero non-param fields. -/
-partial def computeKTarget (indId : KId m) : RecM m Bool := do
+def computeKTarget (indId : KId m) : RecM m Bool := do
   let (indParams, indIndices, ctors, block, ty) ←
     match (← TcM.tryGetConst indId) with
     | some (.indc (params := params) (indices := indices) (ctors := ctors)
@@ -255,7 +305,7 @@ partial def computeKTarget (indId : KId m) : RecM m Bool := do
 
 /-- A1 / S3b: walk the first `nParams` foralls of both types, def-eq the
     domains, and open both bodies with the SAME fvar. -/
-partial def checkParamAgreement (indTy ctorTy : KExpr m) (nParams : Nat) :
+def checkParamAgreement (indTy ctorTy : KExpr m) (nParams : Nat) :
     RecM m Unit := do
   let saved := (← get).lctx.size
   let mut it := indTy
@@ -279,7 +329,7 @@ partial def checkParamAgreement (indTy ctorTy : KExpr m) (nParams : Nat) :
 
 /-- A3: strict positivity — block inductives must not appear in negative
     position in any constructor field. -/
-partial def checkPositivity (ctorTy : KExpr m) (nParams : Nat)
+def checkPositivity (ctorTy : KExpr m) (nParams : Nat)
     (blockAddrs : Array Address) : RecM m Unit := do
   let mut ty := ctorTy
   for _ in [0:nParams] do
@@ -287,20 +337,30 @@ partial def checkPositivity (ctorTy : KExpr m) (nParams : Nat)
     match w with
     | .all _ _ _ body _ => ty := body
     | _ => return ()
-  repeat
+  runBounded (fun ty => do
     let w ← whnf ty
     match w with
     | .all _ _ dom body _ =>
       checkPositivityDomain dom blockAddrs
-      ty := body
-    | _ => break
+      return .next body
+    | _ => return .done ()) maxWhnfFuel.toNat ty
 
 /-- Field-domain positivity: recurse through foralls (negative-position
     mentions reject), then require either a direct block-inductive
     application or a valid nested-inductive application (recursively
     checked with the augmented address set). -/
-partial def checkPositivityDomain (dom : KExpr m)
-    (blockAddrs : Array Address) : RecM m Unit := do
+def checkPositivityDomain (dom : KExpr m)
+    (blockAddrs : Array Address) : RecM m Unit :=
+  checkPositivityDomainFuel maxWhnfFuel.toNat dom blockAddrs
+
+/-- Explicit call-depth bound for nested positivity. The old mutual recursion
+    had no termination guard; exhausting this adversarial-input bound is the
+    same local-loop failure used by bounded reduction. Sibling fields reuse
+    the bound, so this measures nesting depth rather than total work. -/
+def checkPositivityDomainFuel :
+    Nat → KExpr m → Array Address → RecM m Unit
+  | 0, _, _ => throw .maxRecDepth
+  | fuel + 1, dom, blockAddrs => do
   if !exprMentionsAnyAddr dom blockAddrs then
     return ()
   let w ← whnf dom
@@ -314,7 +374,7 @@ partial def checkPositivityDomain (dom : KExpr m)
     let (innerOpen, _) ← TcM.openBinderAnon innerDom innerBody
     let result ←
       try
-        checkPositivityDomain innerOpen blockAddrs
+        checkPositivityDomainFuel fuel innerOpen blockAddrs
         pure (Except.ok ())
       catch e =>
         pure (Except.error e)
@@ -351,16 +411,24 @@ partial def checkPositivityDomain (dom : KExpr m)
         let ctorTy ← match (← TcM.getConst ctorId) with
           | .ctor (ty := ty) .. => pure ty
           | _ => throw (.other "positivity: nested ctor not found")
-        checkNestedCtorFields ctorTy nParams paramArgs us augmented
+        checkNestedCtorFieldsFuel fuel ctorTy nParams paramArgs us augmented
     | _ => throw (.other "positivity: not a valid inductive app")
 
 /-- Nested-inductive field positivity: instantiate universes, strip the
     external inductive's param binders, simultaneously substitute the
     actual (block-mentioning) parameter arguments, then check each
     remaining field domain against the augmented address set. -/
-partial def checkNestedCtorFields (ctorTy : KExpr m) (nParams : Nat)
+def checkNestedCtorFields (ctorTy : KExpr m) (nParams : Nat)
     (paramArgs : Array (KExpr m)) (us : Array (KUniv m))
-    (augmentedAddrs : Array Address) : RecM m Unit := do
+    (augmentedAddrs : Array Address) : RecM m Unit :=
+  checkNestedCtorFieldsFuel maxWhnfFuel.toNat ctorTy nParams paramArgs us
+    augmentedAddrs
+
+def checkNestedCtorFieldsFuel :
+    Nat → KExpr m → Nat → Array (KExpr m) → Array (KUniv m) →
+      Array Address → RecM m Unit
+  | 0, _, _, _, _, _ => throw .maxRecDepth
+  | fuel + 1, ctorTy, nParams, paramArgs, us, augmentedAddrs => do
   let mut ty ← TcM.instantiateUnivParams ctorTy us
   for _ in [0:nParams] do
     let w ← whnf ty
@@ -370,19 +438,25 @@ partial def checkNestedCtorFields (ctorTy : KExpr m) (nParams : Nat)
   -- Var(0) = innermost = LAST param after stripping; simulSubst maps
   -- Var(i) ↦ substs[i], so reverse the param order.
   ty ← TcM.runIntern (simulSubst ty paramArgs.reverse 0)
-  checkNestedCtorFieldsLoop ty augmentedAddrs
+  checkNestedCtorFieldsLoopFuel fuel ty augmentedAddrs
+
+def checkNestedCtorFieldsLoop (ty : KExpr m)
+    (augmentedAddrs : Array Address) : RecM m Unit :=
+  checkNestedCtorFieldsLoopFuel maxWhnfFuel.toNat ty augmentedAddrs
 
-partial def checkNestedCtorFieldsLoop (ty : KExpr m)
-    (augmentedAddrs : Array Address) : RecM m Unit := do
+def checkNestedCtorFieldsLoopFuel :
+    Nat → KExpr m → Array Address → RecM m Unit
+  | 0, _, _ => throw .maxRecDepth
+  | fuel + 1, ty, augmentedAddrs => do
   let w ← whnf ty
   match w with
   | .all _ _ dom body _ =>
-    checkPositivityDomain dom augmentedAddrs
+    checkPositivityDomainFuel fuel dom augmentedAddrs
     let saved := (← get).lctx.size
     let (open', _) ← TcM.openBinderAnon dom body
     let result ←
       try
-        checkNestedCtorFieldsLoop open' augmentedAddrs
+        checkNestedCtorFieldsLoopFuel fuel open' augmentedAddrs
         pure (Except.ok ())
       catch e =>
         pure (Except.error e)
@@ -394,7 +468,7 @@ partial def checkNestedCtorFieldsLoop (ty : KExpr m)
 
 /-- A4: field sort levels ≤ the inductive's result level (Prop inductives
     are exempt). -/
-partial def checkFieldUniverses (ctorTy : KExpr m) (nParams : Nat)
+def checkFieldUniverses (ctorTy : KExpr m) (nParams : Nat)
     (indLevel : KUniv m) : RecM m Unit := do
   if indLevel.isZero then
     return ()
@@ -407,7 +481,7 @@ partial def checkFieldUniverses (ctorTy : KExpr m) (nParams : Nat)
       let (open', _) ← TcM.openBinderAnon dom body
       ty := open'
     | _ => break
-  repeat
+  let _ ← runBounded (fun ty => do
     let w ← whnf ty
     match w with
     | .all _ _ dom body _ =>
@@ -417,12 +491,12 @@ partial def checkFieldUniverses (ctorTy : KExpr m) (nParams : Nat)
         modify fun s => { s with lctx := s.lctx.truncate saved }
         throw (.other "field universe exceeds inductive level")
       let (open', _) ← TcM.openBinderAnon dom body
-      ty := open'
-    | _ => break
+      return .next open'
+    | _ => return .done ()) maxWhnfFuel.toNat ty
   modify fun s => { s with lctx := s.lctx.truncate saved }
 
 /-- A2: constructor return type (see module doc for the exact conditions). -/
-partial def checkCtorReturnType (ctorTy : KExpr m)
+def checkCtorReturnType (ctorTy : KExpr m)
     (nParams nIndices nFields : Nat) (indAddr : Address) (indLvls : UInt64)
     (blockAddrs : Array Address) : RecM m Unit := do
   let saved := (← get).lctx.size
@@ -484,7 +558,7 @@ partial def checkCtorReturnType (ctorTy : KExpr m)
 /-- Validate an inductive and every one of its constructors (S3/S3b peer
     agreement + A1–A4). The Rust tail (recursor-generation trigger) lands
     with P9. -/
-partial def checkInductiveMemberImpl (id : KId m) : RecM m Unit := do
+def checkInductiveMemberImpl (id : KId m) : RecM m Unit := do
   let (params, indices, lvls, ctors, block, isUnsafe, ty) ←
     match (← TcM.getConst id) with
     | .indc (params := params) (indices := indices) (lvls := lvls)
@@ -538,7 +612,7 @@ partial def checkInductiveMemberImpl (id : KId m) : RecM m Unit := do
 
 /-- Standalone-constructor validation: the same per-ctor A1–A4 against the
     declared parent. -/
-partial def checkCtorAgainstInductiveMemberImpl (ctorId inductId : KId m) :
+def checkCtorAgainstInductiveMemberImpl (ctorId inductId : KId m) :
     RecM m Unit := do
   let (ctorTy, ctorFields) ← match (← TcM.getConst ctorId) with
     | .ctor (ty := ty) (fields := fields) .. => pure (ty, fields.toNat)
@@ -562,7 +636,7 @@ partial def checkCtorAgainstInductiveMemberImpl (ctorId inductId : KId m) :
 /-- Validate every inductive and constructor of a homogeneous inductive
     block: per-member well-scopedness + type inference, then the member
     checks. -/
-partial def checkInductiveBlockImpl (block : KId m) (members : Array (KId m)) :
+def checkInductiveBlockImpl (block : KId m) (members : Array (KId m)) :
     RecM m Unit := do
   let mut indIds : Array (KId m) := #[]
   let mut ctorIds : Array (KId m) := #[]
@@ -595,7 +669,7 @@ partial def checkInductiveBlockImpl (block : KId m) (members : Array (KId m)) :
 
 /-- Shifted universe param args: `[param offset, …, param (lvls-1+offset)]`
     (offset 1 for large eliminators). -/
-partial def mkIndUnivs (indLvls offset : UInt64) :
+def mkIndUnivs (indLvls offset : UInt64) :
     RecM m (Array (KUniv m)) := do
   let mut out : Array (KUniv m) := Array.mkEmpty indLvls.toNat
   for i in [0:indLvls.toNat] do
@@ -605,18 +679,17 @@ partial def mkIndUnivs (indLvls offset : UInt64) :
 /-- Core of nested-occurrence detection (early-return style; the caller
     restores the lctx). Structural forall peel — NO whnf (a defn head like
     `IO.Ref` is not a nested occurrence). -/
-partial def tryDetectNestedCore (dom : KExpr m) (blockAddrs : Array Address)
+def tryDetectNestedCore (dom : KExpr m) (blockAddrs : Array Address)
     (flat : Array (FlatBlockMember m))
     (auxSeen : Array (Address × Array Address)) (univOffset : UInt64)
     (paramDepth : Nat) (nRecParams : UInt64) :
     RecM m (Array (FlatBlockMember m) × Array (Address × Array Address)) := do
-  let mut cur := dom
-  repeat
+  let cur ← runBounded (fun cur => do
     match cur with
     | .all _ _ innerDom body _ =>
       let (open', _) ← TcM.openBinderAnon innerDom body
-      cur := open'
-    | _ => break
+      return .next open'
+    | _ => return .done cur) maxWhnfFuel.toNat dom
   let (head, args) := cur.collectSpine
   let some headId := (match head with
       | .const id _ _ => some id
@@ -665,7 +738,7 @@ partial def tryDetectNestedCore (dom : KExpr m) (blockAddrs : Array Address)
 /-- Detect whether `dom` is a nested inductive occurrence; if so append an
     auxiliary entry (dedup by `(extAddr, specParam addrs)`). Returns the
     updated `(flat, auxSeen)`; lctx restored. -/
-partial def tryDetectNested (dom : KExpr m) (blockAddrs : Array Address)
+def tryDetectNested (dom : KExpr m) (blockAddrs : Array Address)
     (flat : Array (FlatBlockMember m))
     (auxSeen : Array (Address × Array Address)) (univOffset : UInt64)
     (paramDepth : Nat) (nRecParams : UInt64) :
@@ -678,7 +751,7 @@ partial def tryDetectNested (dom : KExpr m) (blockAddrs : Array Address)
 
 /-- Build the flat block: originals seeded, then a queue pass over every
     member's ctor fields detecting nested occurrences. -/
-partial def buildFlatBlock (blockInds : Array (KId m))
+def buildFlatBlock (blockInds : Array (KId m))
     (nRecParams univOffset : UInt64) :
     RecM m (Array (FlatBlockMember m)) := do
   let allBlockAddrs := blockInds.map (·.addr)
@@ -698,10 +771,12 @@ partial def buildFlatBlock (blockInds : Array (KId m))
           ctors, lvls, indUs, occurrenceUs := indUs }
     | _ => continue
   -- Queue-based scan (flat grows while iterating).
-  let mut qi := 0
-  while qi < flat.size do
-    let member := flat[qi]!
-    qi := qi + 1
+  runBounded (fun (qi, flat0, auxSeen0) => do
+    if qi ≥ flat0.size then
+      return .done flat0
+    let member := flat0[qi]!
+    let mut flat := flat0
+    let mut auxSeen := auxSeen0
     for ctorId in member.ctors do
       let (ctorFields, ctorTy) ← match (← TcM.tryGetConst ctorId) with
         | some (.ctor (fields := fields) (ty := ty) ..) => pure (fields, ty)
@@ -731,11 +806,12 @@ partial def buildFlatBlock (blockInds : Array (KId m))
           cur := open'
         | _ => break
       modify fun s => { s with lctx := s.lctx.truncate saved }
-  return flat
+    return .next (qi + 1, flat, auxSeen)) maxWhnfFuel.toNat
+      (0, flat, auxSeen)
 
 /-- Rewrite one nested occurrence `Ext spec idx…` to
     `aux blockParams idx…` when the head+params match an aux member. -/
-partial def tryReplaceAuxRefForSort (e : KExpr m)
+def tryReplaceAuxRefForSort (e : KExpr m)
     (aux : Array (FlatBlockMember m)) (auxIds : Array (KId m))
     (blockUs : Array (KUniv m)) (nBlockParams localDepth : UInt64) :
     RecM m (Option (KExpr m)) := do
@@ -775,7 +851,7 @@ partial def tryReplaceAuxRefForSort (e : KExpr m)
 
 /-- Rewrite ALL nested occurrences in `e` to block-local synthetic aux
     references (pre-sort normalization; compile-side `replace_all_nested`). -/
-partial def replaceAuxRefsForSort (e : KExpr m)
+def replaceAuxRefsForSort (e : KExpr m)
     (aux : Array (FlatBlockMember m)) (auxIds : Array (KId m))
     (blockUs : Array (KUniv m)) (nBlockParams localDepth : UInt64) :
     RecM m (KExpr m) := do
@@ -810,7 +886,7 @@ partial def replaceAuxRefsForSort (e : KExpr m)
 
 /-- First `n` Pi binders of the block's first inductive, outermost-first
     (domains stay in the recursor-external telescope context). -/
-partial def extractBlockParamBinders (blockFirstId : KId m)
+def extractBlockParamBinders (blockFirstId : KId m)
     (nBlockParams : UInt64) :
     RecM m (Array (m.F Name × m.F Lean.BinderInfo × KExpr m)) := do
   let indTy ← match (← TcM.tryGetConst blockFirstId) with
@@ -830,7 +906,7 @@ partial def extractBlockParamBinders (blockFirstId : KId m)
 
 /-- `∀ T₀ … Tₙ₋₁, body` from outermost-first binders (compile-side
     `mk_forall`). -/
-partial def wrapWithBlockParamForalls (body : KExpr m)
+def wrapWithBlockParamForalls (body : KExpr m)
     (binders : Array (m.F Name × m.F Lean.BinderInfo × KExpr m)) :
     RecM m (KExpr m) := do
   let mut cur := body
@@ -844,7 +920,7 @@ partial def wrapWithBlockParamForalls (body : KExpr m)
     aux-ref rewritten, block-param wrapped), seed by compiler-shaped name
     rank, run `sortKConstsWithSeedKey`, and return
     `perm[k] = original index of class k's representative`. -/
-partial def canonicalAuxOrder (aux : Array (FlatBlockMember m))
+def canonicalAuxOrder (aux : Array (FlatBlockMember m))
     (nBlockParams : UInt64) (blockUs : Array (KUniv m))
     (all0Name : Option Name) (blockFirstId : Option (KId m)) :
     RecM m (Array Nat) := do
@@ -998,7 +1074,7 @@ partial def canonicalAuxOrder (aux : Array (FlatBlockMember m))
 
 /-- Motive type for a flat member:
     `∀ indices (t : I spec/params indices), Sort elim`. Built at depth 0. -/
-partial def buildMotiveTypeFlat (member : FlatBlockMember m)
+def buildMotiveTypeFlat (member : FlatBlockMember m)
     (nRecParams : Nat) (elimLevel : KUniv m) : RecM m (KExpr m) := do
   let indTy := (← TcM.getConst member.id).ty
   let indTyInst ← TcM.instantiateUnivParams indTy member.occurrenceUs
@@ -1050,25 +1126,24 @@ partial def buildMotiveTypeFlat (member : FlatBlockMember m)
 /-- Recursive-field detection: after peeling foralls, `I_k params args`
     matching a flat member. Aux members additionally def-eq the first
     `ownParams` args against spec_params lifted by `specParamsLiftBy`. -/
-partial def isRecField (dom : KExpr m) (flat : Array (FlatBlockMember m))
+def isRecField (dom : KExpr m) (flat : Array (FlatBlockMember m))
     (specParamsLiftBy : UInt64) : RecM m (Option Nat) := do
-  let mut ty := dom
-  repeat
+  runBounded (fun ty => do
     let w ← whnf ty
     match w with
-    | .all _ _ _ body _ => ty := body
+    | .all _ _ _ body _ => return .next body
     | _ =>
       let (head, args) := w.collectSpine
       let some headAddr := (match head with
           | .const id _ _ => some id.addr
           | _ => none)
-        | return none
+        | return .done none
       for h : idx in [0:flat.size] do
         let mem := flat[idx]
         if mem.id.addr != headAddr then
           continue
         if !mem.isAux then
-          return some idx
+          return .done (some idx)
         let own := mem.ownParams.toNat
         if args.size < own || mem.specParams.size != own then
           continue
@@ -1083,13 +1158,12 @@ partial def isRecField (dom : KExpr m) (flat : Array (FlatBlockMember m))
             allMatch := false
             break
         if allMatch then
-          return some idx
-      return none
-  return none
+          return .done (some idx)
+      return .done none) maxWhnfFuel.toNat dom
 
 /-- IH type for a recursive field (direct or forall-wrapped), built while
     fields and k earlier IHs are on the context. -/
-partial def buildDirectIh (fieldIdx blockIndIdx nParams nFields k
+def buildDirectIh (fieldIdx blockIndIdx nParams nFields k
     minorSaved motiveBase : Nat) (fieldDomains : Array (KExpr m))
     (blockAddrs : Array Address) : RecM m (KExpr m) := do
   -- Lift field domain from its depth (minorSaved + fieldIdx) to current
@@ -1102,10 +1176,7 @@ partial def buildDirectIh (fieldIdx blockIndIdx nParams nFields k
   | .all .. =>
     -- Forall-wrapped: ∀ xs…, I_bi params idxArgs(xs)
     let ihSaved := (← get).lctx.size
-    let mut innerTy := wdom
-    let mut forallDoms : Array (KExpr m) := #[]
-    let mut innerWhnf := wdom
-    repeat
+    let (forallDoms, innerWhnf) ← runBounded (fun (innerTy, forallDoms) => do
       let w ← whnf innerTy
       match w with
       | .all _ _ innerDom innerBody _ =>
@@ -1114,14 +1185,10 @@ partial def buildDirectIh (fieldIdx blockIndIdx nParams nFields k
           | .const id _ _ => blockAddrs.contains id.addr
           | _ => false
         if isBlockHead then
-          innerWhnf := w
-          break
-        forallDoms := forallDoms.push innerDom
+          return .done (forallDoms, w)
         let _ ← TcM.pushFVarDeclAnon innerDom
-        innerTy := innerBody
-      | _ =>
-        innerWhnf := w
-        break
+        return .next (innerBody, forallDoms.push innerDom)
+      | _ => return .done (forallDoms, w)) maxWhnfFuel.toNat (wdom, #[])
     let nXs := forallDoms.size
     let (_, innerArgs) := innerWhnf.collectSpine
     let idxArgs := innerArgs.extract nParams innerArgs.size
@@ -1154,7 +1221,7 @@ partial def buildDirectIh (fieldIdx blockIndIdx nParams nFields k
 
 /-- Minor premise type for a constructor, built with params+motives on the
     context: `∀ fields ihs, motive(retIndices, C params fields)`. -/
-partial def buildMinorAtDepth (indIdx : Nat) (ctorId : KId m)
+def buildMinorAtDepth (indIdx : Nat) (ctorId : KId m)
     (member : FlatBlockMember m) (nRecParams motiveBase : Nat)
     (flat : Array (FlatBlockMember m)) (blockAddrs : Array Address) :
     RecM m (KExpr m) := do
@@ -1184,22 +1251,21 @@ partial def buildMinorAtDepth (indIdx : Nat) (ctorId : KId m)
       ty ← TcM.runIntern (subst body p 0)
     | _ => break
   -- Collect fields (pushed as locals) + recursive-field positions.
-  let mut fieldDomains : Array (KExpr m) := #[]
-  let mut recFieldIndices : Array (Nat × Nat) := #[]
-  let mut fidx := 0
-  repeat
+  let (fieldsTy, fieldDomains, recFieldIndices, _) ← runBounded
+      (fun (ty, fieldDomains, recFieldIndices, fidx) => do
     let w ← whnf ty
     match w with
     | .all _ _ dom body _ =>
-      fieldDomains := fieldDomains.push dom
+      let fieldDomains := fieldDomains.push dom
       let nRecParams64 := (flat[0]?.map (·.ownParams)).getD 0
       let liftBy := (← TcM.depth (m := m)) - min (← TcM.depth (m := m)) nRecParams64
+      let mut recFieldIndices := recFieldIndices
       if let some bi ← isRecField dom flat liftBy then
         recFieldIndices := recFieldIndices.push (fidx, bi)
       let _ ← TcM.pushFVarDeclAnon dom
-      ty := body
-      fidx := fidx + 1
-    | _ => break
+      return .next (body, fieldDomains, recFieldIndices, fidx + 1)
+    | _ => return .done (ty, fieldDomains, recFieldIndices, fidx))
+      maxWhnfFuel.toNat (ty, #[], #[], 0)
   let nFields := fieldDomains.size
   -- IH types (pushed as locals).
   let mut ihDomains : Array (KExpr m) := #[]
@@ -1215,7 +1281,7 @@ partial def buildMinorAtDepth (indIdx : Nat) (ctorId : KId m)
   let nIhs := ihDomains.size
   let nBinders := nFields + nIhs
   -- Return type: I params indices → conclusion.
-  let (_, retArgs) := ty.collectSpine
+  let (_, retArgs) := fieldsTy.collectSpine
   let retIndices := retArgs.extract member.ownParams.toNat retArgs.size
   let depth := (← TcM.depth (m := m)).toNat
   let motiveVarIdx := (depth - 1 - (motiveBase + indIdx)).toUInt64
@@ -1254,7 +1320,7 @@ partial def buildMinorAtDepth (indIdx : Nat) (ctorId : KId m)
 
 /-- Full recursor type for flat member `di`:
     `∀ params motives minors indices major, motive indices major`. -/
-partial def buildRecType (di : Nat)
+def buildRecType (di : Nat)
     (indInfos : Array (KId m × UInt64 × UInt64 × Array (KId m) × KExpr m))
     (blockInds : Array (KId m)) (flat : Array (FlatBlockMember m))
     (motiveTypes : Array (KExpr m)) (univOffset : UInt64) :
@@ -1362,7 +1428,7 @@ partial def buildRecType (di : Nat)
 
 /-- Extract the major-premise domain whose head is `targetAddr`, after
     skipping `prefixSkip` foralls (scan bounded at 64). -/
-partial def recursorMajorDomainForAddr (recTy : KExpr m)
+def recursorMajorDomainForAddr (recTy : KExpr m)
     (prefixSkip : UInt64) (targetAddr : Address) :
     RecM m (Option (KExpr m)) := do
   let mut ty := recTy
@@ -1387,7 +1453,7 @@ partial def recursorMajorDomainForAddr (recTy : KExpr m)
   return none
 
 /-- Same head/universes/arg-count with def-eq args. -/
-partial def majorDomainSignatureEq (a b : KExpr m) : RecM m Bool := do
+def majorDomainSignatureEq (a b : KExpr m) : RecM m Bool := do
   let (aHead, aArgs) := a.collectSpine
   let (bHead, bArgs) := b.collectSpine
   match aHead, bHead with
@@ -1406,7 +1472,7 @@ partial def majorDomainSignatureEq (a b : KExpr m) : RecM m Bool := do
 
 /-- Position-by-position peer recursor alignment (canonical order both
     sides); `none` on any sanity-check failure. -/
-partial def findPeerRecursors (blockId : KId m)
+def findPeerRecursors (blockId : KId m)
     (flat : Array (FlatBlockMember m)) : RecM m (Option (Array (KId m))) := do
   let some members ← TcM.tryGetBlock blockId | return none
   let mut recIds : Array (KId m) := #[]
@@ -1471,7 +1537,7 @@ partial def findPeerRecursors (blockId : KId m)
 
 /-- IH value for a recursive field in a rule RHS:
     `λ xs…, rec[target] params motives minors idxArgs (field xs…)`. -/
-partial def buildRuleIh (fieldIdx nFields totalLams : UInt64)
+def buildRuleIh (fieldIdx nFields totalLams : UInt64)
     (targetBi : Nat) (flat : Array (FlatBlockMember m))
     (peerRecs : Array (KId m)) (nRecParams nMotives nMinors : Nat)
     (isLarge : Bool) (dom : KExpr m) : RecM m (KExpr m) := do
@@ -1485,20 +1551,7 @@ partial def buildRuleIh (fieldIdx nFields totalLams : UInt64)
     recLvls := recLvls.push (← TcM.internUniv (m := m) (.mkParam i.toUInt64 anonN))
   -- Peel foralls (stop when the result head is a flat member).
   let wdom ← whnf dom
-  let mut inner := wdom
-  let mut forallDoms : Array (KExpr m) := #[]
-  repeat
-    match inner with
-    | .all _ _ fd fb _ =>
-      let (h, _) := inner.collectSpine
-      let isFlatHead := match h with
-        | .const id _ _ => flat.any (·.id.addr == id.addr)
-        | _ => false
-      if isFlatHead then
-        break
-      forallDoms := forallDoms.push fd
-      inner := fb
-    | _ => break
+  let (forallDoms, inner) := peelRuleIhForalls wdom flat
   let nXs := forallDoms.size.toUInt64
   let innerW ← whnf inner
   let (_, innerArgs) := innerW.collectSpine
@@ -1530,7 +1583,7 @@ partial def buildRuleIh (fieldIdx nFields totalLams : UInt64)
 
 /-- Rule RHS for one constructor:
     `λ params motives minors fields, minor[gi] fields ihs`. -/
-partial def buildRuleRhs (memberIdx ctorLocalIdx : Nat) (ctorId : KId m)
+def buildRuleRhs (memberIdx ctorLocalIdx : Nat) (ctorId : KId m)
     (member : FlatBlockMember m) (flat : Array (FlatBlockMember m))
     (peerRecs : Array (KId m)) (recTyForMember : KExpr m)
     (nRecParams : Nat) (isLarge : Bool) : RecM m (KExpr m) := do
@@ -1549,15 +1602,13 @@ partial def buildRuleRhs (memberIdx ctorLocalIdx : Nat) (ctorId : KId m)
     match w with
     | .all _ _ _ body _ => countTy := body
     | _ => break
-  let mut nFields : UInt64 := 0
-  let mut tmp := countTy
-  repeat
+  let nFields ← runBounded (fun (tmp, nFields) => do
     let w ← whnf tmp
     match w with
     | .all _ _ _ body _ =>
-      nFields := nFields + 1
-      tmp := body
-    | _ => break
+      return .next (body, nFields + 1)
+    | _ => return .done nFields) maxWhnfFuel.toNat
+      (countTy, (0 : UInt64))
   let totalLams := pmm.toUInt64 + nFields
   -- Pass 2: body = minor[globalIdx] fields ihs.
   let globalMinorIdx := (flat.extract 0 memberIdx).foldl
@@ -1584,19 +1635,22 @@ partial def buildRuleRhs (memberIdx ctorLocalIdx : Nat) (ctorId : KId m)
     | _ => break
   -- Recursive fields → IH applications.
   let recFieldLift := totalLams - min totalLams nRecParams.toUInt64
-  let mut fieldIdx : UInt64 := 0
-  repeat
-    let w ← whnf ty2
+  let (_, _, bodyAfterFields) ← runBounded
+      (fun (fieldTy, fieldIdx, loopBody) => do
+    let w ← whnf fieldTy
     match w with
     | .all _ _ dom body2 _ =>
+      let mut loopBody := loopBody
       if let some targetBi ← isRecField dom flat recFieldLift then
         let ih ← buildRuleIh fieldIdx nFields totalLams targetBi flat
           peerRecs nRecParams nMotives nMinors isLarge dom
-        body ← TcM.intern (.mkApp body ih)
+        loopBody ← TcM.intern (.mkApp loopBody ih)
       let fvar : KExpr m := .mkVar (nFields - 1 - fieldIdx) anonN
-      ty2 ← TcM.runIntern (subst body2 fvar 0)
-      fieldIdx := fieldIdx + 1
-    | _ => break
+      let fieldTy ← TcM.runIntern (subst body2 fvar 0)
+      return .next (fieldTy, fieldIdx + 1, loopBody)
+    | _ => return .done (fieldTy, fieldIdx, loopBody))
+      maxWhnfFuel.toNat (ty2, (0 : UInt64), body)
+  body := bodyAfterFields
   -- Field lambdas: domains from the peer recursor's minor premise.
   let minorDomain ← do
     let mut cur := recTyForMember
@@ -1646,7 +1700,7 @@ partial def buildRuleRhs (memberIdx ctorLocalIdx : Nat) (ctorId : KId m)
 
 /-- Generate recursors for every flat member of an inductive block and
     cache them (`recursorCache`, `recMajorsCache`). -/
-partial def generateBlockRecursors (blockId : KId m) : RecM m Unit := do
+def generateBlockRecursors (blockId : KId m) : RecM m Unit := do
   let blockInds ← discoverBlockInductives blockId
   if blockInds.isEmpty then
     modify fun s => { s with env := { s.env with
@@ -1739,7 +1793,7 @@ partial def generateBlockRecursors (blockId : KId m) : RecM m Unit := do
 /-- Populate canonical rules from the recursor block's peers (block-level
     recursor checking path). Verifies canonical alignment peer-by-peer via
     major-domain signatures; a divergence is a hard error. -/
-partial def populateRecursorRulesFromBlock (indBlockId recBlockId : KId m) :
+def populateRecursorRulesFromBlock (indBlockId recBlockId : KId m) :
     RecM m Unit := do
   let some generatedSnapshot := (← get).env.recursorCache[indBlockId]?
     | return ()
@@ -1842,7 +1896,7 @@ partial def populateRecursorRulesFromBlock (indBlockId recBlockId : KId m) :
 
 /-- Major inductive ids of all peer recursors in a block, sorted+deduped
     (Rust `BTreeSet<KId>` key). -/
-partial def gatherPeerMajors (recBlock : KId m) : RecM m (Array (KId m)) := do
+def gatherPeerMajors (recBlock : KId m) : RecM m (Array (KId m)) := do
   let mut peers : Array (KId m) := #[]
   match (← TcM.tryGetBlock recBlock) with
   | some members =>
@@ -1869,7 +1923,7 @@ partial def gatherPeerMajors (recBlock : KId m) : RecM m (Array (KId m)) := do
 /-- Block-coordinated inductive validation (inductive.rs `check_inductive`):
     pure inductive blocks route through `blockCheckResults`; anything else
     falls back to the member check. -/
-partial def checkInductive (id : KId m) : RecM m Unit := do
+def checkInductive (id : KId m) : RecM m Unit := do
   let block ← match (← TcM.getConst id) with
     | .indc (block := block) .. => pure block
     | _ => throw (.other "check_inductive: not an inductive")
@@ -1897,7 +1951,7 @@ partial def checkInductive (id : KId m) : RecM m Unit := do
 
 /-- Coherence-only recursor gate: major inductive passes A1–A4 and the
     declared K flag matches the constructive computation. -/
-partial def checkRecursorCoherence (id : KId m) : RecM m Unit := do
+def checkRecursorCoherence (id : KId m) : RecM m Unit := do
   let (ty, declaredK, params, motives, minors, indices) ←
     match (← TcM.getConst id) with
     | .recr (ty := ty) (k := k) (params := p) (motives := mo) (minors := mi)
@@ -1914,7 +1968,7 @@ partial def checkRecursorCoherence (id : KId m) : RecM m Unit := do
 /-- Validate a recursor against the generated canonical form (type def-eq +
     per-rule field count and RHS def-eq), with signature-based aux
     disambiguation and the canonical-aux coherence fallback. -/
-partial def checkRecursorMemberImpl (id : KId m) : RecM m Unit := do
+def checkRecursorMemberImpl (id : KId m) : RecM m Unit := do
   let (recBlock, ty, declaredK, params, motives, minors, indices) ←
     match (← TcM.getConst id) with
     | .recr (block := block) (ty := ty) (k := k) (params := p)
@@ -2011,7 +2065,7 @@ partial def checkRecursorMemberImpl (id : KId m) : RecM m Unit := do
     throw (.other "check_recursor: no generated recursor for major")
 
 /-- Validate every recursor in a homogeneous recursor block. -/
-partial def checkRecursorBlockImpl (block : KId m)
+def checkRecursorBlockImpl (block : KId m)
     (members : Array (KId m)) : RecM m Unit := do
   for member in members do
     TcM.reset (m := m)
diff --git a/Ix/Tc/Infer.lean b/Ix/Tc/Infer.lean
index a9012c8c..f7bbee83 100644
--- a/Ix/Tc/Infer.lean
+++ b/Ix/Tc/Infer.lean
@@ -28,7 +28,8 @@ namespace RecM
 
 mutual
 
-partial def infer (e : KExpr m) : RecM m (KExpr m) := do
+def inferWith (inferRec : KExpr m → RecM m (KExpr m))
+    (e : KExpr m) : RecM m (KExpr m) := do
   let inferOnly := (← get).inferOnly
   let cacheKey ← TcM.inferKey e
   -- Full-mode results are validated; either mode may consume them.
@@ -55,10 +56,10 @@ partial def infer (e : KExpr m) : RecM m (KExpr m) := do
         throw (.univParamMismatch c.lvls us.size)
       TcM.instantiateUnivParams c.ty us
     | .app f a _ => do
-      let fTy ← infer f
+      let fTy ← inferRec f
       let (dom, cod) ← ensureForallDirect fTy
       if !inferOnly then
-        let aTy ← infer a
+        let aTy ← inferRec a
         let isEager ← TcM.isEagerReduce a
         if isEager then
           modify fun s => { s with eagerReduce := true }
@@ -72,7 +73,7 @@ partial def infer (e : KExpr m) : RecM m (KExpr m) := do
       TcM.runIntern (subst cod a 0)
     | .lam name bi ty body _ => do
       if !inferOnly then
-        let t ← infer ty
+        let t ← inferRec ty
         let _ ← ensureSortDirect t
       -- Open the binder with a fresh fvar (lean4lean inferLambda).
       let saved := (← get).lctx.size
@@ -80,7 +81,7 @@ partial def infer (e : KExpr m) : RecM m (KExpr m) := do
       let fv ← TcM.intern (.mkFVar fvId name)
       modify fun s => { s with lctx := s.lctx.push fvId (.cdecl name bi ty) }
       let bodyOpen ← TcM.runIntern (instantiateRev body #[fv])
-      let bodyTy ← infer bodyOpen
+      let bodyTy ← inferRec bodyOpen
       -- Peephole-reduce App(λ…, …) shapes before wrapping in the Pi.
       let bodyTy ← TcM.runIntern (cheapBetaReduce bodyTy)
       let abstracted ← TcM.runIntern (abstractFVars bodyTy #[fvId])
@@ -88,22 +89,22 @@ partial def infer (e : KExpr m) : RecM m (KExpr m) := do
       -- Anonymous binder metadata (hash-neutral; see module doc).
       TcM.intern (.mkAll anonN anonBi ty abstracted)
     | .all name bi ty body _ => do
-      let tyTy ← infer ty
+      let tyTy ← inferRec ty
       let u1 ← ensureSortDirect tyTy
       let saved := (← get).lctx.size
       let fvId ← TcM.freshFVarId (m := m)
       let fv ← TcM.intern (.mkFVar fvId name)
       modify fun s => { s with lctx := s.lctx.push fvId (.cdecl name bi ty) }
       let bodyOpen ← TcM.runIntern (instantiateRev body #[fv])
-      let bodyTy ← infer bodyOpen
+      let bodyTy ← inferRec bodyOpen
       let u2 ← ensureSortDirect bodyTy
       modify fun s => { s with lctx := s.lctx.truncate saved }
       TcM.intern (.mkSort (.mkIMax u1 u2))
     | .letE name ty val body _ _ => do
       if !inferOnly then
-        let t ← infer ty
+        let t ← inferRec ty
         let _ ← ensureSortDirect t
-        let valTy ← infer val
+        let valTy ← inferRec val
         if !(← isDefEqCall valTy ty) then
           throw .declTypeMismatch
       -- Open with a let-bound fvar (lean4lean inferLet); eagerly substitute
@@ -113,14 +114,14 @@ partial def infer (e : KExpr m) : RecM m (KExpr m) := do
       let fv ← TcM.intern (.mkFVar fvId name)
       modify fun s => { s with lctx := s.lctx.push fvId (.ldecl name ty val) }
       let bodyOpen ← TcM.runIntern (instantiateRev body #[fv])
-      let bodyTy ← infer bodyOpen
+      let bodyTy ← inferRec bodyOpen
       let abstracted ← TcM.runIntern (abstractFVars bodyTy #[fvId])
       let r ← TcM.runIntern (subst abstracted val 0)
       let r ← TcM.runIntern (cheapBetaReduce r)
       modify fun s => { s with lctx := s.lctx.truncate saved }
       pure r
     | .prj structId field val _ => do
-      let valTy ← infer val
+      let valTy ← inferRec val
       inferProj structId field val valTy
     | .nat .. => do TcM.intern (.mkConst (← prims).nat #[])
     | .str .. => do TcM.intern (.mkConst (← prims).string #[])
@@ -132,16 +133,31 @@ partial def infer (e : KExpr m) : RecM m (KExpr m) := do
       inferOnlyCache := s.env.inferOnlyCache.insert cacheKey ty } }
   return ty
 
+/-- One recursive Infer edge through the indexed method table. -/
+@[inline] def inferCall (e : KExpr m) : RecM m (KExpr m) := do
+  (← read).infer e
+
+/-- One recursive Infer edge with Infer-only validation policy scoped around
+    the underlying `TcM` action. -/
+@[inline] def inferOnlyCall (e : KExpr m) : RecM m (KExpr m) := do
+  let methods ← read
+  TcM.withInferOnly (methods.infer e)
+
+/-- Tie Infer's structural recursive calls through the indexed method table.
+    `inferWith` is the transparent one-layer body consumed by K0/K1 proofs. -/
+def infer (e : KExpr m) : RecM m (KExpr m) :=
+  inferWith inferCall e
+
 /-- `ensureSort` against the direct whnf (no Methods indirection needed —
     infer imports whnf). -/
-partial def ensureSortDirect (e : KExpr m) : RecM m (KUniv m) := do
+def ensureSortDirect (e : KExpr m) : RecM m (KUniv m) := do
   if let .sort u _ := e then
     return u
   match (← whnf e) with
   | .sort u _ => return u
   | _ => throw .typeExpected
 
-partial def ensureForallDirect (e : KExpr m) : RecM m (KExpr m × KExpr m) := do
+def ensureForallDirect (e : KExpr m) : RecM m (KExpr m × KExpr m) := do
   if let .all _ _ a b _ := e then
     return (a, b)
   let w ← whnf e
@@ -150,10 +166,10 @@ partial def ensureForallDirect (e : KExpr m) : RecM m (KExpr m × KExpr m) := do
   | _ => throw (.funExpected e w)
 
 /-- The isDefEq back-edge (tied in `Ix.Tc.Knot`). -/
-partial def isDefEqCall (a b : KExpr m) : RecM m Bool := do
+def isDefEqCall (a b : KExpr m) : RecM m Bool := do
   (← read).isDefEq a b
 
-partial def inferProj (structId : KId m) (field : UInt64) (val : KExpr m)
+def inferProj (structId : KId m) (field : UInt64) (val : KExpr m)
     (valTy : KExpr m) : RecM m (KExpr m) := do
   let wty ← whnf valTy
   let (head, args) := wty.collectSpine
@@ -184,13 +200,13 @@ partial def inferProj (structId : KId m) (field : UInt64) (val : KExpr m)
     if i == field.toNat then
       -- Prop structures may only project Prop fields.
       if isPropStruct then
-        let fieldSortTy ← infer dom
+        let fieldSortTy ← inferCall dom
         let fieldLevel ← ensureSortDirect fieldSortTy
         if !univEq fieldLevel .mkZero then
           throw (.other "projection: cannot project data field from Prop structure")
       return dom
     if isPropStruct then
-      let fieldSortTy ← infer dom
+      let fieldSortTy ← inferCall dom
       let fieldLevel ← ensureSortDirect fieldSortTy
       let isData := !univEq fieldLevel .mkZero
       -- body.lbr > 0 ⇒ later fields depend on this one.
@@ -202,7 +218,7 @@ partial def inferProj (structId : KId m) (field : UInt64) (val : KExpr m)
   throw (.other "projection: unreachable")
 
 /-- Peel a leading `Π`: syntactic fast path, whnf fallback. -/
-partial def peelProjForall (e : KExpr m) (err : String) :
+def peelProjForall (e : KExpr m) (err : String) :
     RecM m (KExpr m × KExpr m) := do
   if let .all _ _ dom body _ := e then
     return (dom, body)
@@ -210,7 +226,7 @@ partial def peelProjForall (e : KExpr m) (err : String) :
   | .all _ _ dom body _ => return (dom, body)
   | _ => throw (.other err)
 
-partial def inductiveAppIsProp (indId : KId m) (levels : Array (KUniv m))
+def inductiveAppIsProp (indId : KId m) (levels : Array (KUniv m))
     (binders : Nat) : RecM m Bool := do
   let indTy ← match (← TcM.tryGetConst indId) with
     | some (.indc (ty := ty) ..) => pure ty
diff --git a/Ix/Tc/Knot.lean b/Ix/Tc/Knot.lean
index ef5279d9..5479bb56 100644
--- a/Ix/Tc/Knot.lean
+++ b/Ix/Tc/Knot.lean
@@ -5,10 +5,14 @@ public import Ix.Tc.DefEq
 /-!
 The recursion knot. `Ix.Tc.Whnf`/`Infer`/`DefEq` define the kernel algorithms
 in `RecM` (a `Methods`-reader over `TcM`); this module ties the back-edges
-with one `partial def` and exports `TcM`-level entry points. Only the
-back-edges route through the record (whnf reads infer/isDefEq); infer imports
-whnf directly and def-eq imports both — no lean4lean `withFuel` third fuel,
-which would change the error surface vs Rust.
+with a total, depth-indexed method table and exports `TcM`-level entry
+points. Only the back-edges route through the record (whnf reads
+infer/isDefEq); infer imports whnf directly and def-eq imports both.
+
+The index is initialized from the *current* shared `recFuel`, not the reset
+budget: public entries can run in the middle of a constant check after fuel
+has already been consumed. Exhausting method-table depth throws the same
+`.maxRecFuel` error as `TcM.tick`, without changing the state.
 -/
 
 public section
@@ -16,42 +20,64 @@ public section
 
 namespace Ix.Tc
 
-/-- The tied method table. -/
-partial def methods : Methods m where
-  whnf e := (RecM.whnf e).run methods
-  whnfCore e := (RecM.whnfCore e).run methods
-  infer e := (RecM.infer e).run methods
-  isDefEq a b := (RecM.isDefEq a b).run methods
+/-- Fuel-exhausted end of the recursive method table. Every back-edge has
+    the same error and error-state behavior as an exhausted `TcM.tick`. -/
+def methodsOut : Methods m where
+  whnf _ := throw .maxRecFuel
+  whnfCore _ := throw .maxRecFuel
+  whnfMode _ _ := throw .maxRecFuel
+  whnfCoreFlags _ _ := throw .maxRecFuel
+  infer _ := throw .maxRecFuel
+  isDefEq _ _ := throw .maxRecFuel
+
+/-- Total approximation to the recursive method knot. Each method-table
+    back-edge exposes one smaller table to the recursive computation. -/
+def methodsN : Nat → Methods m
+  | 0 => methodsOut
+  | n + 1 =>
+    { whnf := fun e => (RecM.whnf e).run (methodsN n)
+      whnfCore := fun e => (RecM.whnfCore e).run (methodsN n)
+      whnfMode := fun e mode =>
+        (RecM.whnfWithNatSuccMode e mode).run (methodsN n)
+      whnfCoreFlags := fun e flags =>
+        (RecM.whnfCoreWithFlags e flags).run (methodsN n)
+      infer := fun e => (RecM.infer e).run (methodsN n)
+      isDefEq := fun a b => (RecM.isDefEq a b).run (methodsN n) }
 
 namespace TcM
 
+/-- Run a recursive checker computation with method-table depth selected
+    from the current state. This deliberately ignores `fuelBudget`. -/
+def runRec (x : RecM m α) : TcM m α := fun s =>
+  x.run (methodsN s.recFuel.toNat) s
+
 /-- Full WHNF (public entry). -/
 def whnf (e : KExpr m) : TcM m (KExpr m) :=
-  (RecM.whnf e).run methods
+  runRec (RecM.whnf e)
 
 /-- Structural WHNF (beta/iota/zeta/proj, no delta). -/
 def whnfCore (e : KExpr m) : TcM m (KExpr m) :=
-  (RecM.whnfCore e).run methods
+  runRec (RecM.whnfCore e)
 
 /-- WHNF without delta. -/
 def whnfNoDelta (e : KExpr m) : TcM m (KExpr m) :=
-  (RecM.whnfNoDelta e).run methods
+  runRec (RecM.whnfNoDelta e)
 
 /-- Type inference (validating unless `withInferOnly`). -/
 def infer (e : KExpr m) : TcM m (KExpr m) :=
-  (RecM.infer e).run methods
+  runRec (RecM.infer e)
 
 /-- Definitional equality. -/
 def isDefEq (a b : KExpr m) : TcM m Bool :=
-  (RecM.isDefEq a b).run methods
+  runRec (RecM.isDefEq a b)
 
 /-- WHNF then require a sort. -/
 def ensureSort (e : KExpr m) : TcM m (KUniv m) :=
-  (RecM.ensureSortDirect e).run methods
+  runRec (RecM.ensureSortDirect e)
 
 /-- WHNF then require a forall; returns (domain, codomain). -/
 def ensureForall (e : KExpr m) : TcM m (KExpr m × KExpr m) :=
-  (RecM.ensureForallDirect e).run methods
+  runRec (RecM.ensureForallDirect e)
 
 end TcM
 
diff --git a/Ix/Tc/Lctx.lean b/Ix/Tc/Lctx.lean
index 14d0258e..31c2d9a0 100644
--- a/Ix/Tc/Lctx.lean
+++ b/Ix/Tc/Lctx.lean
@@ -83,14 +83,20 @@ def push (lctx : LocalContext m) (id : FVarId) (decl : LocalDecl m) :
 
 /-- Truncate to `len`, dropping declarations pushed since (their fvars become
     unresolvable via `find?`). -/
-def truncate (lctx : LocalContext m) (len : Nat) : LocalContext m := Id.run do
-  let mut decls := lctx.decls
-  let mut index := lctx.index
-  while decls.size > len do
-    let (id, _) := decls.back!
-    decls := decls.pop
-    index := index.erase id
-  return { decls, index }
+def truncate (lctx : LocalContext m) (len : Nat) : LocalContext m :=
+  go lctx.decls lctx.index (lctx.decls.size - len)
+where
+  /-- The old loop pops exactly `decls.size - len` entries. Keeping that
+      count explicit preserves its newest-first erase order. -/
+  go (decls : Array (FVarId × LocalDecl m))
+      (index : Std.HashMap FVarId Nat) : Nat → LocalContext m
+    | 0 => { decls, index }
+    | fuel + 1 =>
+      if decls.size > len then
+        let (id, _) := decls.back!
+        go decls.pop (index.erase id) fuel
+      else
+        { decls, index }
 
 def wrapBinders (lctx : LocalContext m) (fvars : Array FVarId)
     (body : KExpr m) (asLambda : Bool) : InternM m (KExpr m) := do
diff --git a/Ix/Tc/Monad.lean b/Ix/Tc/Monad.lean
index 213a586b..9e06d68c 100644
--- a/Ix/Tc/Monad.lean
+++ b/Ix/Tc/Monad.lean
@@ -26,8 +26,9 @@ Fuels are data-level and placed exactly where Rust places them
 (post-cache-miss). The `IX_MAX_REC_FUEL` env override is not ported.
 
 Cross-file recursion (whnf ↔ infer ↔ def_eq) is tied through a `Methods m`
-record + `RecM m := ReaderT (Methods m) (TcM m)`; the knot is tied by one
-`partial def` in `Ix.Tc.Knot`. Only back-edges go through the record.
+record + `RecM m := ReaderT (Methods m) (TcM m)`; `Ix.Tc.Knot` ties a total
+method table indexed by the current `recFuel`. Only back-edges go through
+the record.
 
 Not ported (diagnostics/profiling only): perf counters, hot-miss sampler,
 `def_eq_trace_depth`, profile sink, `debug_label` env filters.
@@ -161,6 +162,18 @@ def ofEnv (env : KEnv m) : TcState m :=
 def ofEnvAnon (env : KEnv .anon) : TcState .anon :=
   { env, prims := .ofAnonAddrs }
 
+/-- Error-side cache isolation for one top-level constant check.
+
+    Caches that may depend on the failed pending subject are restored from the
+    pre-check state; newly cached block errors remain replayable. All other
+    post-state data, including lazy loads, interned terms, fault history, and
+    consumed fuel, survives. -/
+def restoreCheckCachesOnError (before after : TcState m) : TcState m :=
+  { after with
+    env := KEnv.restoreCheckCachesOnError before.env after.env
+    equivManager := before.equivManager
+    ctxAddrCache := before.ctxAddrCache }
+
 end TcState
 
 /-- The type-checking monad. -/
@@ -170,6 +183,14 @@ instance : Inhabited (TcM m α) := ⟨fun s => .error default s⟩
 
 namespace TcM
 
+/-- Run `x` unchanged on success, but sanitize its error state before
+    returning it. This direct `EStateM` wrapper keeps every non-cache mutation
+    from the failing run while exposing an exact verification equation. -/
+def isolateCheckErrors (x : TcM m α) : TcM m α := fun s =>
+  match x s with
+  | .ok a s' => .ok a s'
+  | .error e s' => .error e (s.restoreCheckCachesOnError s')
+
 @[inline] def ofExcept : Except (TcError m) α → TcM m α
   | .ok a => pure a
   | .error e => throw e
@@ -302,6 +323,32 @@ def depth : TcM m UInt64 := do
   let s ← get
   return (s.ctx.size + s.lctx.size).toUInt64
 
+/-- One closure step for the suffix needed by `ctxAddrForLbr`. Starting at
+    `need`, dependencies may only increase the result, which is then clamped
+    to the context length. -/
+def ctxSuffixNeedStep (s : TcState m) (need : Nat) : Nat := Id.run do
+  let n := s.ctx.size
+  let start := n - need
+  let mut nextNeed := need
+  for i in [start:n] do
+    let frameOffset := n - i
+    let tyNeed := s.ctx[i]!.lbr.toNat
+    nextNeed := max nextNeed (frameOffset + tyNeed)
+    if let some val := s.letVals[i]! then
+      nextNeed := max nextNeed (frameOffset + val.lbr.toNat)
+  return min nextNeed n
+
+/-- Iterate suffix closure with an explicit bound. Because
+    `ctxSuffixNeedStep` is monotone and clamped below `s.ctx.size`, at most
+    `s.ctx.size` strict increases are possible; one extra step detects the
+    fixed point. -/
+def ctxSuffixNeed (s : TcState m) : Nat → Nat → Nat
+  | 0, need => need
+  | fuel + 1, need =>
+    let nextNeed := ctxSuffixNeedStep s need
+    if nextNeed == need then need
+    else ctxSuffixNeed s fuel nextNeed
+
 /-- Suffix-aware context identity for a loose-bound-variable range.
 
     Pure in `(ctxId, lbr)` (memoized). Runs a fixpoint closing the needed
@@ -316,20 +363,7 @@ def ctxAddrForLbr (lbr : UInt64) : TcM m Address := do
   if let some cached := s.ctxAddrCache[cacheKey]? then
     return cached
   let n := s.ctx.size
-  let mut need := min lbr.toNat n
-  repeat
-    let start := n - need
-    let mut nextNeed := need
-    for i in [start:n] do
-      let frameOffset := n - i
-      let tyNeed := s.ctx[i]!.lbr.toNat
-      nextNeed := max nextNeed (frameOffset + tyNeed)
-      if let some val := s.letVals[i]! then
-        nextNeed := max nextNeed (frameOffset + val.lbr.toNat)
-    nextNeed := min nextNeed n
-    if nextNeed == need then
-      break
-    need := nextNeed
+  let need := ctxSuffixNeed s (n + 1) (min lbr.toNat n)
   let result :=
     if need == n then s.ctxId
     else Id.run do
@@ -435,8 +469,17 @@ def saveDepth : TcM m Nat := do
 
 /-- Restore the legacy ctx to a saved depth. -/
 def restoreDepth (saved : Nat) : TcM m Unit := do
-  while (← get).ctx.size > saved do
-    popLocal
+  let fuel := (← get).ctx.size - saved
+  go fuel
+where
+  /-- Explicit form of the old pop loop. `fuel` is the initial excess
+      context length, and `popLocal` removes exactly one frame. -/
+  go : Nat → TcM m Unit
+    | 0 => pure ()
+    | fuel + 1 => do
+      if (← get).ctx.size > saved then
+        popLocal
+        go fuel
 
 /-- Bound variable's type, lifted to the current depth. -/
 def lookupVar (idx : UInt64) : TcM m (KExpr m) := do
@@ -618,29 +661,35 @@ end TcM
 
 /-! ### Free-standing helpers (tc.rs) -/
 
+/-- Sum of pending expression nodes in a worklist. This is proof-only in
+    `exprMentionsAddr`'s termination argument. -/
+def exprWorkSize : List (KExpr m) → Nat
+  | [] => 0
+  | e :: stack => e.treeSize + exprWorkSize stack
+
 /-- Does `e` mention a constant with the given address? Iterative
     (stack-based) — immune to stack overflow on deep input. -/
-def exprMentionsAddr (e : KExpr m) (addr : Address) : Bool := Id.run do
-  let mut stack : Array (KExpr m) := #[e]
-  while !stack.isEmpty do
-    let e := stack.back!
-    stack := stack.pop
-    match e with
-    | .const id _ _ =>
-      if id.addr == addr then
-        return true
-    | .app f a _ =>
-      stack := stack.push f |>.push a
-    | .lam _ _ ty body _ | .all _ _ ty body _ =>
-      stack := stack.push ty |>.push body
-    | .letE _ ty val body _ _ =>
-      stack := stack.push ty |>.push val |>.push body
-    | .prj id _ val _ =>
-      if id.addr == addr then
-        return true
-      stack := stack.push val
-    | _ => pure ()
-  return false
+def exprMentionsAddr (e : KExpr m) (addr : Address) : Bool :=
+  go [e]
+where
+  /-- LIFO order matches the former Array stack: the last pushed child is
+      visited first. -/
+  go : List (KExpr m) → Bool
+    | [] => false
+    | e :: stack =>
+      match e with
+      | .const id _ _ =>
+        if id.addr == addr then true else go stack
+      | .app f a _ => go (a :: f :: stack)
+      | .lam _ _ ty body _ | .all _ _ ty body _ =>
+        go (body :: ty :: stack)
+      | .letE _ ty val body _ _ => go (body :: val :: ty :: stack)
+      | .prj id _ val _ =>
+        if id.addr == addr then true else go (val :: stack)
+      | _ => go stack
+  termination_by stack => exprWorkSize stack
+  decreasing_by
+    all_goals simp [exprWorkSize, KExpr.treeSize, KExpr.treeSize_pos] <;> omega
 
 /-- Does `e` mention any constant from `addrs`? -/
 def exprMentionsAnyAddr (e : KExpr m) (addrs : Array Address) : Bool :=
@@ -648,12 +697,40 @@ def exprMentionsAnyAddr (e : KExpr m) (addrs : Array Address) : Bool :=
 
 /-! ### The recursion knot -/
 
+/-- Reduction-policy flags shared with the internal WHNF knot. Keeping the
+    policy type here lets the total method approximation index cheap/full
+    recursive WHNF calls without an import cycle. -/
+structure WhnfFlags where
+  cheapRec : Bool
+  cheapProj : Bool
+  deriving BEq, Repr, Inhabited
+
+namespace WhnfFlags
+
+def FULL : WhnfFlags := ⟨false, false⟩
+def DEF_EQ_CORE : WhnfFlags := ⟨false, true⟩
+
+@[inline] def isFull (f : WhnfFlags) : Bool := !f.cheapRec && !f.cheapProj
+
+end WhnfFlags
+
+/-- Nat succ-collapse policy. The `.stuck` entry is part of the internal
+    total knot because succ peeling recursively normalizes without
+    re-entering succ collapse. -/
+inductive NatSuccMode where
+  | collapse
+  | stuck
+  deriving BEq, Repr, Inhabited
+
 /-- Back-edges of the whnf ↔ infer ↔ def-eq recursion. Whnf reads
-    `infer`/`isDefEq`; Infer imports Whnf directly; DefEq imports both. The
-    knot is tied by one `partial def` in `Ix.Tc.Knot`. -/
+    `infer`/`isDefEq`; its two policy-sensitive internal recursive entries
+    also live here so cheap-core and stuck-succ calls decrease the same
+    `methodsN` index. Infer imports Whnf directly; DefEq imports both. -/
 structure Methods (m : Mode) where
   whnf : KExpr m → TcM m (KExpr m)
   whnfCore : KExpr m → TcM m (KExpr m)
+  whnfMode : KExpr m → NatSuccMode → TcM m (KExpr m)
+  whnfCoreFlags : KExpr m → WhnfFlags → TcM m (KExpr m)
   infer : KExpr m → TcM m (KExpr m)
   isDefEq : KExpr m → KExpr m → TcM m Bool
 
@@ -661,6 +738,9 @@ instance : Inhabited (Methods m) where
   default :=
     { whnf := fun _ => throw (.other "Methods.whnf: knot not tied")
       whnfCore := fun _ => throw (.other "Methods.whnfCore: knot not tied")
+      whnfMode := fun _ _ => throw (.other "Methods.whnfMode: knot not tied")
+      whnfCoreFlags := fun _ _ =>
+        throw (.other "Methods.whnfCoreFlags: knot not tied")
       infer := fun _ => throw (.other "Methods.infer: knot not tied")
       isDefEq := fun _ _ => throw (.other "Methods.isDefEq: knot not tied") }
 
@@ -681,6 +761,26 @@ def maxDispatchDepth : UInt32 := 200_000
 
 namespace RecM
 
+/-- One iteration of an explicitly bounded kernel loop. `next` consumes the
+    current iteration and continues from a new state; `done` returns without
+    consulting the remaining bound. -/
+inductive BoundedStep (σ α : Type) where
+  | next (state : σ)
+  | done (result : α)
+
+/-- Run at most `fuel` loop iterations. Exhaustion is checked before invoking
+    `step`, matching the former `if fuel == 0; fuel := fuel - 1` loops.
+    Keeping the driver total and higher-order lets WHNF and def-eq expose their
+    local loop equations independently of the still-open recursive knot. -/
+@[specialize]
+def runBounded (step : σ → RecM m (BoundedStep σ α)) :
+    Nat → σ → RecM m α
+  | 0, _ => throw .maxRecDepth
+  | fuel + 1, state => do
+    match ← step state with
+    | .next state => runBounded step fuel state
+    | .done result => return result
+
 /-- Enter one knot dispatch: bump the depth, trip past the ceiling.
     Callers pair with `exitDispatch` via `try/finally` (balanced on
     error unwinds). -/
diff --git a/Ix/Tc/Verify/Audit/Basic.lean b/Ix/Tc/Verify/Audit/Basic.lean
new file mode 100644
index 00000000..6fb0e54d
--- /dev/null
+++ b/Ix/Tc/Verify/Audit/Basic.lean
@@ -0,0 +1,176 @@
+import Lean.Elab.Command
+import Lean.PrivateName
+import Lean.Util.CollectAxioms
+import Lean.Util.FoldConsts
+
+/-!
+# Exact trust-boundary auditing for `Ix.Tc.Verify`
+
+`Lean.collectAxioms` gives the kernel-computed, transitive axiom set for a
+declaration.  This module adds two pieces needed by the verification plan:
+
+* an exact, per-root allowlist split into ordinary Lean axioms and generated
+  `native_decide` axioms;
+* an exact list of the reachable declarations that use `sorryAx` directly,
+  so permitting `sorryAx` cannot hide where that debt entered the proof.
+
+The executable manifests live in sibling modules.  Keeping the mechanism
+separate lets us audit the temporary statement skeletons in a different
+import context from the concrete translation relations with which their
+opaque names currently collide.
+-/
+
+namespace Ix.Tc.Verify.Audit
+
+open Lean
+open Lean.Elab.Command
+
+/-- The complete permitted trust boundary for one exported theorem root.
+
+Lean gives generated native axioms private names such as
+`_private.Ix.Tc.Expr.0....`; use `nativeAxiom` below to construct them
+structurally.  `sorryOrigins` is checked by traversing the root's dependency
+graph. -/
+structure RootAllowance where
+  root : Lean.Name
+  standardAxioms : Array Lean.Name := #[]
+  nativeAxioms : Array Lean.Name := #[]
+  sorryOrigins : Array Lean.Name := #[]
+  /-- Constants that must not occur anywhere in the root's transitive
+  dependency graph.  This is used for architectural quarantine in addition
+  to axiom accounting. -/
+  forbiddenDependencies : Array Lean.Name := #[]
+
+/-- Reconstruct the kernel name of a private generated native axiom.  This
+avoids comparing pretty-printed names: the manifest and environment are
+checked as `Lean.Name` values all the way through. -/
+def nativeAxiom (moduleName userName : Lean.Name) : Lean.Name :=
+  Lean.mkPrivateNameCore moduleName userName
+
+private def permittedStandardAxioms : Array Lean.Name :=
+  #[``propext, ``Classical.choice, ``Quot.sound]
+
+private def sortNames (xs : Array Name) : Array Name :=
+  xs.qsort Name.lt
+
+/-- Direct constant references, following the same declaration cases as
+`Lean.collectAxioms`.  In particular, opaque theorem values and inductive
+constructors are included. -/
+private def directConstants : ConstantInfo → Array Name
+  | .axiomInfo v => v.type.getUsedConstants
+  | .defnInfo v => v.type.getUsedConstants ++ v.value.getUsedConstants
+  | .thmInfo v => v.type.getUsedConstants ++ v.value.getUsedConstants
+  | .opaqueInfo v => v.type.getUsedConstants ++ v.value.getUsedConstants
+  | .quotInfo _ => #[]
+  | .ctorInfo v => v.type.getUsedConstants
+  | .recInfo v => v.type.getUsedConstants
+  | .inductInfo v => v.type.getUsedConstants ++ v.ctors
+
+namespace SorryOrigins
+
+structure State where
+  visited : NameSet := {}
+  origins : Array Name := #[]
+
+abbrev M := ReaderT Environment (StateM State)
+
+/-- Traverse the checked kernel environment and record each reachable
+declaration whose type or value directly mentions `sorryAx`. -/
+partial def visit (declName : Name) : M Unit := do
+  let state ← get
+  unless state.visited.contains declName do
+    modify fun s => { s with visited := s.visited.insert declName }
+    let env ← read
+    match env.checked.get.find? declName with
+    | none => pure ()
+    | some info =>
+      let dependencies := directConstants info
+      if declName != ``sorryAx && dependencies.contains ``sorryAx then
+        modify fun s => { s with origins := s.origins.push declName }
+      dependencies.forM visit
+
+def collect (env : Environment) (root : Name) : Array Name :=
+  let (_, state) := ((visit root).run env).run {}
+  state.origins
+
+end SorryOrigins
+
+namespace Dependencies
+
+structure State where
+  visited : NameSet := {}
+  names : Array Name := #[]
+
+abbrev M := ReaderT Environment (StateM State)
+
+/-- Traverse the same checked dependency graph used by the axiom collector,
+recording every declaration exactly once. -/
+partial def visit (declName : Name) : M Unit := do
+  let state ← get
+  unless state.visited.contains declName do
+    modify fun s =>
+      { visited := s.visited.insert declName, names := s.names.push declName }
+    let env ← read
+    match env.checked.get.find? declName with
+    | none => pure ()
+    | some info => (directConstants info).forM visit
+
+def collect (env : Environment) (root : Name) : Array Name :=
+  let (_, state) := ((visit root).run env).run {}
+  state.names
+
+end Dependencies
+
+private def validateCategories (allowance : RootAllowance) :
+    CommandElabM Unit := do
+  for axiomName in allowance.standardAxioms do
+    unless permittedStandardAxioms.contains axiomName do
+      throwError m!"{allowance.root}: {axiomName} is not a permitted standard Lean axiom"
+  for axiomName in allowance.nativeAxioms do
+    unless Lean.isPrivateName axiomName do
+      throwError m!"{allowance.root}: native axiom is not private: {axiomName}"
+    unless (axiomName.toString.splitOn "._native.native_decide.").length == 2 do
+      throwError m!"{allowance.root}: malformed native_decide axiom: {axiomName}"
+
+private def expectedAxioms (allowance : RootAllowance) : Array Lean.Name :=
+  let expected := allowance.standardAxioms ++ allowance.nativeAxioms
+  sortNames <| if allowance.sorryOrigins.isEmpty then expected
+    else expected.push ``sorryAx
+
+private def checkOne (allowance : RootAllowance) : CommandElabM Unit := do
+  validateCategories allowance
+  let env ← getEnv
+  unless env.contains allowance.root do
+    throwError m!"axiom-audit root does not exist: {allowance.root}"
+
+  let actualAxioms := sortNames (← Lean.collectAxioms allowance.root)
+  let expectedAxioms := expectedAxioms allowance
+  unless actualAxioms == expectedAxioms do
+    throwError m!"axiom allowlist mismatch for {allowance.root}\n\
+      expected: {repr (expectedAxioms.map Name.toString).toList}\n\
+      actual:   {repr (actualAxioms.map Name.toString).toList}"
+
+  let actualOrigins := sortNames <| SorryOrigins.collect env allowance.root
+  let expectedOrigins := sortNames allowance.sorryOrigins
+  unless actualOrigins == expectedOrigins do
+    throwError m!"sorryAx origin mismatch for {allowance.root}\n\
+      expected direct origins: {repr expectedOrigins.toList}\n\
+      actual direct origins:   {repr actualOrigins.toList}"
+
+  let dependencies := Dependencies.collect env allowance.root
+  for forbidden in allowance.forbiddenDependencies do
+    if dependencies.contains forbidden then
+      throwError m!"{allowance.root}: forbidden transitive dependency {forbidden}"
+
+/-- Check a complete executable trust manifest.  Duplicate roots are rejected
+instead of being silently audited twice. -/
+def check (allowances : Array RootAllowance) : CommandElabM Unit := do
+  let mut roots : NameSet := {}
+  for allowance in allowances do
+    if roots.contains allowance.root then
+      throwError m!"duplicate axiom-audit root: {allowance.root}"
+    roots := roots.insert allowance.root
+    checkOne allowance
+  logInfo m!"Ix.Tc verification trust audit passed for {allowances.size} theorem roots"
+
+end Ix.Tc.Verify.Audit
diff --git a/Ix/Tc/Verify/Audit/Completed.lean b/Ix/Tc/Verify/Audit/Completed.lean
new file mode 100644
index 00000000..511f1c95
--- /dev/null
+++ b/Ix/Tc/Verify/Audit/Completed.lean
@@ -0,0 +1,1514 @@
+import Ix.Tc.Verify.Audit.Basic
+import Ix.Tc.Verify.Ctx
+import Ix.Tc.Verify.Decl
+import Ix.Tc.Verify.Execution
+import Ix.Tc.Verify.Frame
+import Ix.Tc.Verify.InstL
+import Ix.Tc.Verify.NatFixture
+import Ix.Tc.Verify.Run
+import Ix.Tc.Verify.Support
+import Ix.Tc.Verify.Totalization
+import Ix.Tc.Verify.Whnf
+import Ix.Tc.Verify.World
+
+/-!
+# Trust manifest for the completed `Ix.Tc.Verify` proof surface
+
+These are the current completed foundations and reusable semantic interfaces
+that later C1--C3 roots will consume.  A new headline theorem must be added here
+when it becomes part of that exported proof surface.  The temporary C1/C2
+statement skeletons are audited separately in `Audit/Statements.lean`
+because their opaque relation names intentionally collide with the concrete
+relations imported here.
+
+The entries are deliberately repetitive at the root level: a change in the
+transitive trust boundary of any one interface should produce a focused CI
+failure.  Shared arrays below are only labels for exactly repeated sets.
+-/
+
+namespace Ix.Tc.Verify.Audit.Completed
+
+open Ix.Tc.Verify.Audit
+
+private def standard : Array Lean.Name :=
+  #[``propext, ``Classical.choice, ``Quot.sound]
+
+private def standardWithoutChoice : Array Lean.Name :=
+  #[``propext, ``Quot.sound]
+
+private def standardWithoutQuot : Array Lean.Name :=
+  #[``propext, ``Classical.choice]
+
+private def propextOnly : Array Lean.Name := #[``propext]
+
+private def blake3Native : Array Lean.Name := #[
+  nativeAxiom `Blake3
+    `Blake3.HasherOps.hash._native.native_decide.ax_1
+]
+
+private def expressionNative : Array Lean.Name := blake3Native.push
+  (nativeAxiom `Ix.Tc.Expr
+    `Ix.Tc.KExpr.mkVar._native.native_decide.ax_1)
+
+private def levelNative : Array Lean.Name := expressionNative.push
+  (nativeAxiom `Ix.Tc.Level
+    `Ix.Tc.KUniv.mkSucc._native.native_decide.ax_1)
+
+private def contextNative : Array Lean.Name := expressionNative.push
+  (nativeAxiom `Ix.Tc.Monad
+    `Ix.Tc.TcM.ctxAddrForLbr._native.native_decide.ax_5)
+
+private def inferNative : Array Lean.Name := levelNative.push
+  (nativeAxiom `Ix.Tc.Monad
+    `Ix.Tc.TcM.ctxAddrForLbr._native.native_decide.ax_5)
+
+private def inductiveNative : Array Lean.Name := (inferNative.push
+  (nativeAxiom `Ix.Environment
+    `Ix.Name.mkStr._native.native_decide.ax_1)).push
+  (nativeAxiom `Ix.Tc.Inductive
+    `Ix.Tc.RecM.canonicalAuxOrder._native.native_decide.ax_17)
+
+/- Direct upstream `sorryAx` origins.  Listing the declarations, rather than
+merely allowing `sorryAx`, makes upstream debt movement visible in review. -/
+private def inductiveWF : Lean.Name := ``Lean4Lean.VInductDecl.WF
+private def addInduct : Lean.Name := ``Lean4Lean.VEnv.addInduct
+private def addInductWF : Lean.Name := ``Lean4Lean.VEnv.addInduct_WF
+private def forallEInv : Lean.Name :=
+  ``Lean4Lean.VEnv.IsDefEqU.forallE_inv_stratified
+private def sortInv : Lean.Name := ``Lean4Lean.VEnv.IsDefEqU.sort_inv
+
+private def typingDebt : Array Lean.Name :=
+  #[inductiveWF, addInduct, addInductWF, forallEInv, sortInv]
+
+/- The empty legacy whole-`KEnv` inductive path is forbidden from every G2b
+consumer root.  Keeping this list in the executable audit prevents an
+innocent-looking helper from reintroducing the old `nomatch` dependency. -/
+private def legacyWholeEnv : Array Lean.Name := #[
+  ``Ix.Tc.AddKInduct,
+  ``Ix.Tc.AddKInduct.to_addInduct,
+  ``Ix.Tc.TrKEnv',
+  ``Ix.Tc.TrKEnv
+]
+
+private def roots : Array RootAllowance := #[
+  -- Level decision procedures.
+  { root := ``Ix.Tc.univEq_sound, standardAxioms := standard },
+  { root := ``Ix.Tc.univGeq_sound, standardAxioms := standard },
+
+  -- Memoized expression walkers against their pure specifications.
+  { root := ``Ix.Tc.lift_spec,
+    standardAxioms := standard, nativeAxioms := expressionNative },
+  { root := ``Ix.Tc.subst_spec,
+    standardAxioms := standard, nativeAxioms := expressionNative },
+  { root := ``Ix.Tc.simulSubst_spec,
+    standardAxioms := standard, nativeAxioms := expressionNative },
+  { root := ``Ix.Tc.instantiateRev_spec,
+    standardAxioms := standard, nativeAxioms := expressionNative },
+  -- There is not yet an API-level `abstractFVars_spec`; protect the current
+  -- walker master until that final wrapper replaces it.
+  { root := ``Ix.Tc.abstractFVarsCached_spec,
+    standardAxioms := standard, nativeAxioms := expressionNative },
+  { root := ``Ix.Tc.TcM.instantiateUnivParams_wf,
+    standardAxioms := standard, nativeAxioms := levelNative },
+
+  -- G3a finite run support and generated-term resource bounds.
+  { root := ``Ix.Tc.KExpr.LiftReach.finite,
+    standardAxioms := standardWithoutQuot,
+    nativeAxioms := expressionNative },
+  { root := ``Ix.Tc.KExpr.SubstReach.finite,
+    standardAxioms := standardWithoutQuot,
+    nativeAxioms := expressionNative },
+  { root := ``Ix.Tc.KExpr.InstUnivReach.finite,
+    standardAxioms := standardWithoutQuot,
+    nativeAxioms := levelNative },
+  { root := ``Ix.Tc.WalkerRequest.reach_finite,
+    standardAxioms := standard,
+    nativeAxioms := levelNative },
+  { root := ``Ix.Tc.InternTable.exprSupport_finite,
+    standardAxioms := standard },
+  { root := ``Ix.Tc.RunSupport.collisionFree_of_le,
+    standardAxioms := propextOnly },
+  { root := ``Ix.Tc.RunSupport.singleton_collisionFree,
+    standardAxioms := propextOnly },
+  { root := ``Ix.Tc.WalkerRequest.Bounds.lift_result,
+    standardAxioms := standard, nativeAxioms := expressionNative },
+  { root := ``Ix.Tc.WalkerRequest.Bounds.subst_result,
+    standardAxioms := standard, nativeAxioms := expressionNative },
+  { root := ``Ix.Tc.CheckConstSupport.initial_support,
+    standardAxioms := standard, nativeAxioms := levelNative },
+  { root := ``Ix.Tc.CheckConstSupport.lift,
+    standardAxioms := standard, nativeAxioms := levelNative },
+  { root := ``Ix.Tc.CheckConstSupport.subst,
+    standardAxioms := standard, nativeAxioms := levelNative },
+  { root := ``Ix.Tc.CheckConstSupport.instUniv,
+    standardAxioms := standard, nativeAxioms := levelNative },
+  { root := ``Ix.Tc.CheckConstSupport.mono,
+    standardAxioms := standard, nativeAxioms := levelNative },
+  { root := ``Ix.Tc.CheckConstSupport.scope,
+    standardAxioms := standard, nativeAxioms := levelNative },
+  { root := ``Ix.Tc.ResourceBounds.mono,
+    standardAxioms := standard,
+    nativeAxioms := expressionNative },
+  { root := ``Ix.Tc.AmbientNat.checkSupport,
+    standardAxioms := standard, nativeAxioms := levelNative,
+    forbiddenDependencies := legacyWholeEnv },
+  { root := ``Ix.Tc.AmbientNat.resourceBounds,
+    standardAxioms := standard,
+    nativeAxioms := expressionNative,
+    forbiddenDependencies := legacyWholeEnv },
+  { root := ``Ix.Tc.AmbientNat.supportAcceptance,
+    standardAxioms := standard, nativeAxioms := levelNative,
+    sorryOrigins := #[inductiveWF, addInduct],
+    forbiddenDependencies := legacyWholeEnv },
+
+  -- G3b closes the remaining formalized walker/direct-intern families and
+  -- ties the exact finite request list to an actual TcM computation.
+  { root := ``Ix.Tc.KExpr.SimulSubstReach.finite,
+    standardAxioms := standardWithoutQuot,
+    nativeAxioms := expressionNative },
+  { root := ``Ix.Tc.KExpr.InstRevReach.finite,
+    standardAxioms := standardWithoutQuot,
+    nativeAxioms := expressionNative },
+  { root := ``Ix.Tc.KExpr.AbstractReach.finite,
+    standardAxioms := standard, nativeAxioms := expressionNative },
+  { root := ``Ix.Tc.WalkerRequest.univReach_finite,
+    standardAxioms := propextOnly },
+  { root := ``Ix.Tc.InternTable.univSupport_finite,
+    standardAxioms := standard },
+  { root := ``Ix.Tc.RunSupport.pair_collisionFree,
+    standardAxioms := propextOnly },
+  { root := ``Ix.Tc.WalkerRequest.Bounds.simulSubst_result,
+    standardAxioms := standard, nativeAxioms := expressionNative },
+  { root := ``Ix.Tc.WalkerRequest.Bounds.instRev_result,
+    standardAxioms := standard, nativeAxioms := expressionNative },
+  { root := ``Ix.Tc.WalkerRequest.Bounds.abstractFVars_result,
+    standardAxioms := standard, nativeAxioms := expressionNative },
+  { root := ``Ix.Tc.abstractFVars_eq,
+    standardAxioms := standard, nativeAxioms := expressionNative },
+  { root := ``Ix.Tc.InternPreservesUnivs.pure,
+    standardAxioms := standardWithoutChoice },
+  { root := ``Ix.Tc.InternPreservesUnivs.runWalk,
+    standardAxioms := standardWithoutChoice },
+  { root := ``Ix.Tc.WalkPreservesUnivs.pure,
+    standardAxioms := standardWithoutChoice },
+  { root := ``Ix.Tc.WalkPreservesUnivs.bind,
+    standardAxioms := standardWithoutChoice },
+  { root := ``Ix.Tc.WalkPreservesUnivs.scratchGet,
+    standardAxioms := standardWithoutChoice },
+  { root := ``Ix.Tc.WalkPreservesUnivs.scratchInsert,
+    standardAxioms := standardWithoutChoice },
+  { root := ``Ix.Tc.WalkPreservesUnivs.liftIntern,
+    standardAxioms := standardWithoutChoice },
+  { root := ``Ix.Tc.WalkPreservesUnivs.internExpr,
+    standardAxioms := standardWithoutChoice },
+  { root := ``Ix.Tc.lift_preservesUnivs,
+    standardAxioms := standard, nativeAxioms := expressionNative },
+  { root := ``Ix.Tc.subst_preservesUnivs,
+    standardAxioms := standard, nativeAxioms := expressionNative },
+  { root := ``Ix.Tc.simulSubst_preservesUnivs,
+    standardAxioms := standard, nativeAxioms := expressionNative },
+  { root := ``Ix.Tc.instantiateRev_preservesUnivs,
+    standardAxioms := standard, nativeAxioms := expressionNative },
+  { root := ``Ix.Tc.abstractFVars_preservesUnivs,
+    standardAxioms := standard, nativeAxioms := expressionNative },
+  { root := ``Ix.Tc.WalkerRequest.Bounds.abstractFVarsCached_result,
+    standardAxioms := standard, nativeAxioms := expressionNative },
+  { root := ``Ix.Tc.CheckConstSupport.initial_univ_support,
+    standardAxioms := standard, nativeAxioms := levelNative },
+  { root := ``Ix.Tc.CheckConstSupport.internExpr,
+    standardAxioms := standard, nativeAxioms := levelNative },
+  { root := ``Ix.Tc.CheckConstSupport.internUniv,
+    standardAxioms := standard, nativeAxioms := levelNative },
+  { root := ``Ix.Tc.CheckConstSupport.simulSubst,
+    standardAxioms := standard, nativeAxioms := levelNative },
+  { root := ``Ix.Tc.CheckConstSupport.instRev,
+    standardAxioms := standard, nativeAxioms := levelNative },
+  { root := ``Ix.Tc.CheckConstSupport.abstractFVars,
+    standardAxioms := standard, nativeAxioms := levelNative },
+  { root := ``Ix.Tc.ExecutionRequests.bind,
+    standardAxioms := standard, nativeAxioms := levelNative },
+  { root := ``Ix.Tc.ExecutionRequests.tryCatch,
+    standardAxioms := standard, nativeAxioms := levelNative },
+  { root := ``Ix.Tc.ExecutionRequests.weaken,
+    standardAxioms := standard, nativeAxioms := levelNative },
+  { root := ``Ix.Tc.ExecutionRequests.of_eq,
+    standardAxioms := standard, nativeAxioms := levelNative },
+  { root := ``Ix.Tc.RunAssumptions.initial,
+    standardAxioms := standard, nativeAxioms := levelNative },
+  { root := ``Ix.Tc.RunAssumptions.requestBounds,
+    standardAxioms := standard, nativeAxioms := levelNative },
+  { root := ``Ix.Tc.RunAssumptions.internExpr_spec,
+    standardAxioms := standard, nativeAxioms := levelNative },
+  { root := ``Ix.Tc.RunAssumptions.internUniv_spec,
+    standardAxioms := standard, nativeAxioms := levelNative },
+  { root := ``Ix.Tc.RunSupport.CoversIntern.of_expr_univs,
+    standardAxioms := standardWithoutChoice },
+  { root := ``Ix.Tc.RunAssumptions.lift_spec,
+    standardAxioms := standard, nativeAxioms := levelNative },
+  { root := ``Ix.Tc.RunAssumptions.subst_spec,
+    standardAxioms := standard, nativeAxioms := levelNative },
+  { root := ``Ix.Tc.RunAssumptions.simulSubst_spec,
+    standardAxioms := standard, nativeAxioms := levelNative },
+  { root := ``Ix.Tc.RunAssumptions.instRev_spec,
+    standardAxioms := standard, nativeAxioms := levelNative },
+  { root := ``Ix.Tc.RunAssumptions.abstractFVarsCached_spec,
+    standardAxioms := standard, nativeAxioms := levelNative },
+  { root := ``Ix.Tc.RunAssumptions.abstractFVars_spec,
+    standardAxioms := standard, nativeAxioms := levelNative },
+  { root := ``Ix.Tc.RunAssumptions.instantiateUnivParams_wf,
+    standardAxioms := standard, nativeAxioms := levelNative },
+  { root := ``Ix.Tc.RunAssumptions.runIntern_supported_wf,
+    standardAxioms := standard,
+    sorryOrigins := #[inductiveWF, addInduct] },
+  { root := ``Ix.Tc.RunAssumptions.lift_wf,
+    standardAxioms := standard, nativeAxioms := levelNative,
+    sorryOrigins := #[inductiveWF, addInduct] },
+  { root := ``Ix.Tc.RunAssumptions.subst_wf,
+    standardAxioms := standard, nativeAxioms := levelNative,
+    sorryOrigins := #[inductiveWF, addInduct] },
+  { root := ``Ix.Tc.RunAssumptions.simulSubst_wf,
+    standardAxioms := standard, nativeAxioms := levelNative,
+    sorryOrigins := #[inductiveWF, addInduct] },
+  { root := ``Ix.Tc.RunAssumptions.instRev_wf,
+    standardAxioms := standard, nativeAxioms := levelNative,
+    sorryOrigins := #[inductiveWF, addInduct] },
+  { root := ``Ix.Tc.RunAssumptions.abstractFVars_wf,
+    standardAxioms := standard, nativeAxioms := levelNative,
+    sorryOrigins := #[inductiveWF, addInduct] },
+  { root := ``Ix.Tc.RunAssumptions.instUniv_wf,
+    standardAxioms := standard, nativeAxioms := levelNative,
+    sorryOrigins := #[inductiveWF, addInduct] },
+  { root := ``Ix.Tc.AmbientNat.supportExecution,
+    standardAxioms := standard, nativeAxioms := levelNative,
+    forbiddenDependencies := legacyWholeEnv },
+  { root := ``Ix.Tc.AmbientNat.runAssumptions,
+    standardAxioms := standard, nativeAxioms := levelNative,
+    forbiddenDependencies := legacyWholeEnv },
+
+  -- Expression translation, typing, uniqueness, and defeq bridges.
+  { root := ``Ix.Tc.TrKExprS.instL,
+    standardAxioms := standard, nativeAxioms := levelNative,
+    sorryOrigins := typingDebt },
+  { root := ``Ix.Tc.TrKExprS.inst,
+    standardAxioms := standard, nativeAxioms := expressionNative },
+  { root := ``Ix.Tc.TrKExprS.wf, standardAxioms := standard },
+  { root := ``Ix.Tc.TrKExpr.wf, standardAxioms := standard },
+  { root := ``Ix.Tc.TrKExprS.uniq,
+    standardAxioms := standard, sorryOrigins := typingDebt },
+  { root := ``Ix.Tc.TrKExprS.defeqDFC,
+    standardAxioms := standard, sorryOrigins := typingDebt },
+  { root := ``Ix.Tc.TrKExpr.defeq,
+    standardAxioms := standard, sorryOrigins := typingDebt },
+
+  -- Legacy whole-environment compatibility interfaces.  G2b consumer roots
+  -- below are forbidden from depending on these declarations.
+  { root := ``Ix.Tc.TrKEnv.wf,
+    standardAxioms := standard, sorryOrigins := #[inductiveWF, addInduct] },
+  { root := ``Ix.Tc.TrKEnv.find?,
+    standardAxioms := standard, sorryOrigins := #[inductiveWF] },
+  { root := ``Ix.Tc.TcM.tick.tcInv,
+    standardAxioms := standard, sorryOrigins := #[inductiveWF, addInduct] },
+  { root := ``Ix.Tc.TcM.instantiateUnivParams.tcInv,
+    standardAxioms := standard, nativeAxioms := levelNative,
+    sorryOrigins := #[inductiveWF, addInduct] },
+
+  -- The narrow upstream-context dependency behind translation uniqueness.
+  { root := ``Ix.Tc.KVLCtx.IsDefEq.find?_uniq,
+    standardAxioms := standardWithoutChoice,
+    sorryOrigins := #[inductiveWF, addInduct, addInductWF] },
+
+  -- Dual-context reconciliation entry points used by the checker proofs.
+  { root := ``Ix.Tc.CtxRecon.wf, standardAxioms := standard },
+  { root := ``Ix.Tc.CtxRecon.lookupVar,
+    standardAxioms := standard, nativeAxioms := expressionNative },
+  { root := ``Ix.Tc.CtxRecon.fvar_resolves,
+    standardAxioms := standard },
+
+  -- G1a's non-circular world and one-way lazy-load boundary.
+  { root := ``Ix.Tc.VerifyWorld.ofCatalog_catalogued_not_trusted,
+    standardAxioms := standardWithoutChoice,
+    sorryOrigins := #[inductiveWF, addInduct] },
+  { root := ``Ix.Tc.VerifyWorld.LE.trans,
+    standardAxioms := standardWithoutChoice,
+    sorryOrigins := #[inductiveWF, addInduct] },
+  { root := ``Ix.Tc.VerifyWorld.LE.catalogued_iff,
+    standardAxioms := standardWithoutChoice,
+    sorryOrigins := #[inductiveWF, addInduct] },
+  { root := ``Ix.Tc.LoadedAgrees.world_iff,
+    standardAxioms := standardWithoutChoice,
+    sorryOrigins := #[inductiveWF, addInduct] },
+  { root := ``Ix.Tc.LoadedAgrees.insert,
+    standardAxioms := standard },
+  { root := ``Ix.Tc.LoadedAgrees.of_extension,
+    standardAxioms := standardWithoutChoice },
+  { root := ``Ix.Tc.VerifyWorld.ofCatalog_loaded,
+    standardAxioms := standardWithoutChoice,
+    sorryOrigins := #[inductiveWF, addInduct] },
+  { root := ``Ix.Tc.VerifyWorld.ofCatalog_loaded_not_trusted,
+    standardAxioms := standard,
+    sorryOrigins := #[inductiveWF, addInduct] },
+
+  -- G1b's raw/pending boundary.  Raw correspondence has no declaration-WF
+  -- premise; the fixture roots pin the concrete non-WF pending case.
+  { root := ``Ix.Tc.RawExprRel.mono,
+    standardAxioms := standard },
+  { root := ``Ix.Tc.RawExprRel.reference_resolved,
+    standardAxioms := standard },
+  { root := ``Ix.Tc.RawDeclRel.mono,
+    standardAxioms := standard },
+  { root := ``Ix.Tc.PendingDecl.no_target_lookup,
+    standardAxioms := standard,
+    sorryOrigins := #[inductiveWF, addInduct] },
+  { root := ``Ix.Tc.PendingDecl.no_self_expr_reference,
+    standardAxioms := standard,
+    sorryOrigins := #[inductiveWF, addInduct] },
+  { root := ``Ix.Tc.PendingDecl.not_trustedDecl,
+    standardAxioms := standard,
+    sorryOrigins := #[inductiveWF, addInduct] },
+  { root := ``Ix.Tc.IllTypedPending.pending_but_not_wf,
+    standardAxioms := standard,
+    sorryOrigins := #[inductiveWF, addInduct] },
+  { root := ``Ix.Tc.IllTypedPending.loaded_pending_but_not_wf,
+    standardAxioms := standard,
+    sorryOrigins := #[inductiveWF, addInduct] },
+
+  -- G1c's trusted-only catalog log and explicit-WF promotion boundary.
+  { root := ``Ix.Tc.RawDeclRel.wf_le,
+    standardAxioms := standard,
+    sorryOrigins := #[inductiveWF, addInduct] },
+  { root := ``Ix.Tc.TrustedCatalogLog.wf,
+    standardAxioms := standard,
+    sorryOrigins := #[inductiveWF, addInduct] },
+  { root := ``Ix.Tc.TrustedCatalogLog.catalogued,
+    standardAxioms := standard,
+    sorryOrigins := #[inductiveWF, addInduct] },
+  { root := ``Ix.Tc.TrustedCatalogLog.find,
+    standardAxioms := standard,
+    sorryOrigins := #[inductiveWF, addInduct] },
+  { root := ``Ix.Tc.TrustedCatalogRel.ofCatalog,
+    standardAxioms := standard,
+    sorryOrigins := #[inductiveWF, addInduct] },
+  { root := ``Ix.Tc.TrustedCatalogRel.find,
+    standardAxioms := standard,
+    sorryOrigins := #[inductiveWF, addInduct] },
+  { root := ``Ix.Tc.TrustedDecl.lookup,
+    standardAxioms := standard,
+    sorryOrigins := #[inductiveWF, addInduct] },
+  { root := ``Ix.Tc.TrustedCatalogRel.lookup,
+    standardAxioms := standard,
+    sorryOrigins := #[inductiveWF, addInduct] },
+  { root := ``Ix.Tc.Promotes.trans,
+    standardAxioms := standardWithoutChoice,
+    sorryOrigins := #[inductiveWF, addInduct] },
+  { root := ``Ix.Tc.TrustedCatalogRel.promote,
+    standardAxioms := standard,
+    sorryOrigins := #[inductiveWF, addInduct] },
+  { root := ``Ix.Tc.IllTypedPending.trustedCatalogRel,
+    standardAxioms := standard,
+    sorryOrigins := #[inductiveWF, addInduct] },
+  { root := ``Ix.Tc.WellTypedPromotion.promotes,
+    standardAxioms := standard,
+    sorryOrigins := #[inductiveWF, addInduct] },
+
+  -- G1d's world-based concrete-state invariant.  Loading stays
+  -- representation-only, promotion requires a fresh WF witness, and the
+  -- fixed-world Hoare roots pin no-promotion behavior on both outcomes.
+  { root := ``Ix.Tc.TcStateWF.of_consts_eq,
+    standardAxioms := standard,
+    sorryOrigins := #[inductiveWF, addInduct] },
+  { root := ``Ix.Tc.TcStateWF.load,
+    standardAxioms := standard,
+    sorryOrigins := #[inductiveWF, addInduct] },
+  { root := ``Ix.Tc.TcStateWF.promote,
+    standardAxioms := standard,
+    sorryOrigins := #[inductiveWF, addInduct] },
+  { root := ``Ix.Tc.TcStateWF.find?,
+    standardAxioms := standard,
+    sorryOrigins := #[inductiveWF, addInduct] },
+  { root := ``Ix.Tc.TcInv.find?,
+    standardAxioms := standard,
+    sorryOrigins := #[inductiveWF, addInduct] },
+  { root := ``Ix.Tc.IllTypedPending.tcInv_pending_but_not_wf,
+    standardAxioms := standard,
+    sorryOrigins := #[inductiveWF, addInduct] },
+  { root := ``Ix.Tc.TcM.tick.tcStateWF,
+    standardAxioms := standard,
+    sorryOrigins := #[inductiveWF, addInduct] },
+  { root := ``Ix.Tc.TcM.instantiateUnivParams.tcStateWF,
+    standardAxioms := standard, nativeAxioms := levelNative,
+    sorryOrigins := #[inductiveWF, addInduct] },
+
+  -- G2a's explicit ambient-inductive assumption boundary.  Audit every
+  -- oracle projection so adding a field changes this manifest, then pin the
+  -- constructive Nat model and its adversarial loaded-state witness.
+  { root := ``Ix.Tc.RawInductiveConstRel.mono,
+    standardAxioms := standard },
+  { root := ``Ix.Tc.RawRecursorRuleRel.mono,
+    standardAxioms := standard },
+  { root := ``Ix.Tc.InductiveOracle.members,
+    standardAxioms := standard,
+    sorryOrigins := #[inductiveWF, addInduct] },
+  { root := ``Ix.Tc.InductiveOracle.nonempty,
+    standardAxioms := standard,
+    sorryOrigins := #[inductiveWF, addInduct] },
+  { root := ``Ix.Tc.InductiveOracle.fresh,
+    standardAxioms := standard,
+    sorryOrigins := #[inductiveWF, addInduct] },
+  { root := ``Ix.Tc.InductiveOracle.after,
+    standardAxioms := standard,
+    sorryOrigins := #[inductiveWF, addInduct] },
+  { root := ``Ix.Tc.InductiveOracle.envLE,
+    standardAxioms := standard,
+    sorryOrigins := #[inductiveWF, addInduct] },
+  { root := ``Ix.Tc.InductiveOracle.blockWF,
+    standardAxioms := standard,
+    sorryOrigins := #[inductiveWF, addInduct] },
+  { root := ``Ix.Tc.InductiveOracle.translateBlock,
+    standardAxioms := standard,
+    sorryOrigins := #[inductiveWF, addInduct] },
+  { root := ``Ix.Tc.InductiveOracle.recursorFacts,
+    standardAxioms := standard,
+    sorryOrigins := #[inductiveWF, addInduct] },
+  { root := ``Ix.Tc.InductiveOracle.catalogued,
+    standardAxioms := standard,
+    sorryOrigins := #[inductiveWF, addInduct] },
+  { root := ``Ix.Tc.AmbientNat.oracle,
+    standardAxioms := standard,
+    sorryOrigins := #[inductiveWF, addInduct] },
+  { root := ``Ix.Tc.AmbientNat.nat_lookup_good,
+    standardAxioms := standard,
+    sorryOrigins := #[inductiveWF, addInduct] },
+  { root := ``Ix.Tc.AmbientNat.badDecl_not_wf,
+    standardAxioms := standard,
+    sorryOrigins := #[inductiveWF, addInduct] },
+  { root := ``Ix.Tc.AmbientNat.acceptance,
+    standardAxioms := standard,
+    sorryOrigins := #[inductiveWF, addInduct] },
+
+  -- G2b's C1--C3 consumer path.  These roots resolve exact concrete
+  -- constants through trusted-world provenance and are mechanically barred
+  -- from depending on the legacy whole-environment translation.
+  { root := ``Ix.Tc.TrustedConstRel.mono,
+    standardAxioms := standard,
+    sorryOrigins := #[inductiveWF, addInduct],
+    forbiddenDependencies := legacyWholeEnv },
+  { root := ``Ix.Tc.TrustedConstRel.trKExprS_const,
+    standardAxioms := standard,
+    sorryOrigins := #[inductiveWF, addInduct],
+    forbiddenDependencies := legacyWholeEnv },
+  { root := ``Ix.Tc.TrustedCatalogRel.resolve,
+    standardAxioms := standard,
+    sorryOrigins := #[inductiveWF, addInduct, addInductWF],
+    forbiddenDependencies := legacyWholeEnv },
+  { root := ``Ix.Tc.TcStateWF.resolve,
+    standardAxioms := standard,
+    sorryOrigins := #[inductiveWF, addInduct, addInductWF],
+    forbiddenDependencies := legacyWholeEnv },
+  { root := ``Ix.Tc.TcInv.resolve,
+    standardAxioms := standard,
+    sorryOrigins := #[inductiveWF, addInduct, addInductWF],
+    forbiddenDependencies := legacyWholeEnv },
+  { root := ``Ix.Tc.AmbientNat.natResolved,
+    standardAxioms := standard,
+    sorryOrigins := #[inductiveWF, addInduct, addInductWF],
+    forbiddenDependencies := legacyWholeEnv },
+  { root := ``Ix.Tc.AmbientNat.natReferenceTranslates,
+    standardAxioms := standard,
+    sorryOrigins := #[inductiveWF, addInduct, addInductWF],
+    forbiddenDependencies := legacyWholeEnv },
+  { root := ``Ix.Tc.AmbientNat.bad_not_resolved,
+    standardAxioms := standard,
+    sorryOrigins := #[inductiveWF, addInduct],
+    forbiddenDependencies := legacyWholeEnv },
+  { root := ``Ix.Tc.AmbientNat.natResolvedInv,
+    standardAxioms := standard,
+    sorryOrigins := #[inductiveWF, addInduct, addInductWF],
+    forbiddenDependencies := legacyWholeEnv },
+
+  -- G4's lookup isolation, exhaustive semantic-cache provenance, monotone
+  -- warm-world transport, and transactional public-check error boundary.
+  { root := ``Ix.Tc.PendingDecl.lookup_isolation,
+    standardAxioms := standard,
+    sorryOrigins := #[inductiveWF, addInduct] },
+  { root := ``Ix.Tc.CacheEntry.SupportedBy.mono },
+  { root := ``Ix.Tc.CacheAuthority.stable_mono,
+    standardAxioms := standardWithoutChoice,
+    sorryOrigins := #[inductiveWF, addInduct] },
+  { root := ``Ix.Tc.CacheProvenance.mono,
+    standardAxioms := standardWithoutChoice,
+    sorryOrigins := #[inductiveWF, addInduct] },
+  { root := ``Ix.Tc.CacheProvenance.pending_isolation_stable,
+    standardAxioms := standard,
+    sorryOrigins := #[inductiveWF, addInduct] },
+  { root := ``Ix.Tc.KEnv.restoreBlockCheckResultsOnError_origin,
+    standardAxioms := standard },
+  { root := ``Ix.Tc.CacheInvariant.mono,
+    standardAxioms := standardWithoutChoice,
+    sorryOrigins := #[inductiveWF, addInduct] },
+  { root := ``Ix.Tc.CacheInvariant.insertWhnf,
+    standardAxioms := standard,
+    sorryOrigins := #[inductiveWF, addInduct] },
+  { root := ``Ix.Tc.CacheInvariant.insertWhnfNoDelta,
+    standardAxioms := standard,
+    sorryOrigins := #[inductiveWF, addInduct] },
+  { root := ``Ix.Tc.CacheInvariant.insertWhnfNoDeltaCheap,
+    standardAxioms := standard,
+    sorryOrigins := #[inductiveWF, addInduct] },
+  { root := ``Ix.Tc.CacheInvariant.insertWhnfCore,
+    standardAxioms := standard,
+    sorryOrigins := #[inductiveWF, addInduct] },
+  { root := ``Ix.Tc.CacheInvariant.insertWhnfCoreCheap,
+    standardAxioms := standard,
+    sorryOrigins := #[inductiveWF, addInduct] },
+  { root := ``Ix.Tc.CacheInvariant.of_intern_update,
+    standardAxioms := standardWithoutChoice,
+    sorryOrigins := #[inductiveWF, addInduct] },
+  { root := ``Ix.Tc.CacheInvariant.clearReductionCaches,
+    standardAxioms := standard,
+    sorryOrigins := #[inductiveWF, addInduct] },
+  { root := ``Ix.Tc.CacheInvariant.restoreCheckCachesOnError,
+    standardAxioms := standard,
+    sorryOrigins := #[inductiveWF, addInduct] },
+  { root := ``Ix.Tc.TcM.isolateCheckErrors_error,
+    standardAxioms := standardWithoutChoice },
+  { root := ``Ix.Tc.TcM.reset_cache_frame,
+    standardAxioms := standard,
+    nativeAxioms := #[nativeAxiom `Blake3
+      `Blake3.HasherOps.hash._native.native_decide.ax_1] },
+  { root := ``Ix.Tc.KernelStateWF.pendingCacheIsolation,
+    standardAxioms := standard,
+    sorryOrigins := #[inductiveWF, addInduct] },
+  { root := ``Ix.Tc.KernelStateWF.restoreCheckCachesOnError,
+    standardAxioms := standard,
+    sorryOrigins := #[inductiveWF, addInduct] },
+  { root := ``Ix.Tc.AmbientNat.warmCache_worldTransport,
+    standardAxioms := standard, nativeAxioms := expressionNative,
+    sorryOrigins := #[inductiveWF, addInduct, addInductWF],
+    forbiddenDependencies := legacyWholeEnv },
+  { root := ``Ix.Tc.AmbientNat.warmCache_cannotResolvePending,
+    standardAxioms := standard, nativeAxioms := levelNative,
+    sorryOrigins := #[inductiveWF, addInduct, addInductWF],
+    forbiddenDependencies := legacyWholeEnv },
+  { root := ``Ix.Tc.AmbientNat.cacheAcceptance,
+    standardAxioms := standard, nativeAxioms := inferNative,
+    sorryOrigins := #[inductiveWF, addInduct, addInductWF],
+    forbiddenDependencies := legacyWholeEnv },
+
+  -- K1's concrete Theory reduction meaning, exact five-way cache overlay,
+  -- and real ambient-Nat warm-hit witness.  The only sorries are the already
+  -- named upstream inductive-environment boundary.
+  { root := ``Ix.Tc.WhnfMeaning.refl,
+    standardAxioms := standard,
+    sorryOrigins := #[inductiveWF, addInduct] },
+  { root := ``Ix.Tc.WhnfMeaning.symm,
+    standardAxioms := standard,
+    sorryOrigins := #[inductiveWF, addInduct] },
+  { root := ``Ix.Tc.WhnfMeaning.mono,
+    standardAxioms := standard,
+    sorryOrigins := #[inductiveWF, addInduct] },
+  { root := ``Ix.Tc.ExprCacheKind.isWhnf_iff },
+  { root := ``Ix.Tc.WhnfCacheValid.mono,
+    standardAxioms := standard,
+    sorryOrigins := #[inductiveWF, addInduct] },
+  { root := ``Ix.Tc.WhnfCacheValid.expr,
+    standardAxioms := standard,
+    sorryOrigins := #[inductiveWF, addInduct] },
+  { root := ``Ix.Tc.CacheProvenance.whnfMeaning,
+    standardAxioms := standard,
+    sorryOrigins := #[inductiveWF, addInduct] },
+  { root := ``Ix.Tc.CacheInvariant.whnfHit,
+    standardAxioms := standard,
+    sorryOrigins := #[inductiveWF, addInduct] },
+  { root := ``Ix.Tc.AmbientNat.supportExpr_whnfMeaning,
+    standardAxioms := standard, nativeAxioms := expressionNative,
+    sorryOrigins := #[inductiveWF, addInduct, addInductWF],
+    forbiddenDependencies := legacyWholeEnv },
+  { root := ``Ix.Tc.AmbientNat.warmHit_whnfMeaning,
+    standardAxioms := standard, nativeAxioms := inferNative,
+    sorryOrigins := #[inductiveWF, addInduct, addInductWF],
+    forbiddenDependencies := legacyWholeEnv },
+  { root := ``Ix.Tc.RecM.tryReduceNative_noAccel,
+    standardAxioms := standard, nativeAxioms := levelNative },
+  { root := ``Ix.Tc.RecM.tryReduceBitvec_noAccel,
+    standardAxioms := standard, nativeAxioms := expressionNative },
+  { root := ``Ix.Tc.RecM.tryReduceDecidable_noAccel,
+    standardAxioms := standard, nativeAxioms := levelNative },
+  { root := ``Ix.Tc.RecM.tryReduceFinValDecidableRec_noAccel,
+    standardAxioms := standard, nativeAxioms := expressionNative },
+  { root := ``Ix.Tc.WhnfTheory.exprWF,
+    standardAxioms := standard,
+    sorryOrigins := #[inductiveWF, addInduct, addInductWF] },
+  { root := ``Ix.Tc.WhnfTheory.transMeaning,
+    standardAxioms := standard,
+    sorryOrigins := typingDebt },
+  { root := ``Ix.Tc.RawProjRel.none_ok,
+    standardAxioms := propextOnly },
+  { root := ``Ix.Tc.TcM.ctxAddrForLbr_zero,
+    standardAxioms := standard, nativeAxioms := contextNative },
+  { root := ``Ix.Tc.TcM.whnfKey_closed,
+    standardAxioms := standard, nativeAxioms := contextNative },
+  { root := ``Ix.Tc.ContextKeyFrame.whnfStateInv,
+    standardAxioms := standard,
+    sorryOrigins := #[inductiveWF, addInduct] },
+  { root := ``Ix.Tc.TcM.ctxAddrForLbr_wf,
+    standardAxioms := standard, nativeAxioms := contextNative },
+  { root := ``Ix.Tc.TcM.whnfKey_wf,
+    standardAxioms := standard, nativeAxioms := contextNative,
+    sorryOrigins := #[inductiveWF, addInduct] },
+  { root := ``Ix.Tc.TcM.whnfKey_matches_wf,
+    standardAxioms := standard, nativeAxioms := contextNative,
+    sorryOrigins := #[inductiveWF, addInduct] },
+  -- K1c: exact intern-only framing, execution-indexed simultaneous
+  -- substitution, and the production one-argument beta path.
+  { root := ``Ix.Tc.InternUpdateFrame.whnfStateInv,
+    standardAxioms := standard,
+    sorryOrigins := #[inductiveWF, addInduct] },
+  { root := ``Ix.Tc.TcM.runIntern_whnf_wf,
+    standardAxioms := standard,
+    sorryOrigins := #[inductiveWF, addInduct] },
+  { root := ``Ix.Tc.TcM.runIntern_whnf_eval,
+    standardAxioms := standard,
+    sorryOrigins := #[inductiveWF, addInduct] },
+  { root := ``Ix.Tc.RunAssumptions.simulSubst_whnf_wf,
+    standardAxioms := standard, nativeAxioms := levelNative,
+    sorryOrigins := #[inductiveWF, addInduct] },
+  { root := ``Ix.Tc.RunAssumptions.simulSubst_whnf_eval,
+    standardAxioms := standard, nativeAxioms := levelNative,
+    sorryOrigins := #[inductiveWF, addInduct] },
+  { root := ``Ix.Tc.WhnfMeaning.beta,
+    standardAxioms := standard, nativeAxioms := expressionNative,
+    sorryOrigins := #[inductiveWF, addInduct, addInductWF] },
+  { root := ``Ix.Tc.WhnfMeaning.betaSimul,
+    standardAxioms := standard, nativeAxioms := expressionNative,
+    sorryOrigins := #[inductiveWF, addInduct] },
+  { root := ``Ix.Tc.RecM.WhnfCoreLeaf.eval,
+    standardAxioms := standard, nativeAxioms := inferNative },
+  { root := ``Ix.Tc.RecM.whnfCoreWithFlagsStep_betaOne,
+    standardAxioms := standard, nativeAxioms := levelNative },
+  { root := ``Ix.Tc.RecM.whnfCoreWithFlagsStep_leaf,
+    standardAxioms := standard, nativeAxioms := levelNative },
+  { root := ``Ix.Tc.RecM.whnfCoreWithFlagsUncached_betaOne,
+    standardAxioms := standard, nativeAxioms := levelNative },
+  { root := ``Ix.Tc.RecM.whnfCoreWithFlagsUncached_betaOne_wf,
+    standardAxioms := standard, nativeAxioms := levelNative,
+    sorryOrigins := #[inductiveWF, addInduct] },
+  { root := ``Ix.Tc.RecM.whnfCoreWithFlags_leaf_wf,
+    standardAxioms := standard, nativeAxioms := inferNative,
+    sorryOrigins := #[inductiveWF, addInduct] },
+  { root := ``Ix.Tc.AmbientNat.warmStateInvAccelerated,
+    standardAxioms := standard, nativeAxioms := inferNative,
+    sorryOrigins := #[inductiveWF, addInduct, addInductWF],
+    forbiddenDependencies := legacyWholeEnv },
+  { root := ``Ix.Tc.AmbientNat.warmKey_matches_wf,
+    standardAxioms := standard, nativeAxioms := contextNative,
+    sorryOrigins := #[inductiveWF, addInduct],
+    forbiddenDependencies := legacyWholeEnv },
+  { root := ``Ix.Tc.AmbientNat.whnfCoreConst_noAccel_acceptance,
+    standardAxioms := standard, nativeAxioms := inferNative,
+    sorryOrigins := #[inductiveWF, addInduct],
+    forbiddenDependencies := legacyWholeEnv },
+  { root := ``Ix.Tc.AmbientNat.betaIdentityMeaning,
+    standardAxioms := standard, nativeAxioms := expressionNative,
+    sorryOrigins := #[inductiveWF, addInduct, addInductWF],
+    forbiddenDependencies := legacyWholeEnv },
+  { root := ``Ix.Tc.AmbientNat.betaSimulSpec,
+    standardAxioms := standardWithoutQuot, nativeAxioms := expressionNative },
+  { root := ``Ix.Tc.AmbientNat.betaSimulMeaning,
+    standardAxioms := standard, nativeAxioms := expressionNative,
+    sorryOrigins := #[inductiveWF, addInduct, addInductWF],
+    forbiddenDependencies := legacyWholeEnv },
+  { root := ``Ix.Tc.AmbientNat.betaWalker_eval,
+    standardAxioms := standard, nativeAxioms := expressionNative },
+  { root := ``Ix.Tc.AmbientNat.betaResultMeaning,
+    standardAxioms := standard, nativeAxioms := expressionNative,
+    sorryOrigins := #[inductiveWF, addInduct, addInductWF],
+    forbiddenDependencies := legacyWholeEnv },
+  { root := ``Ix.Tc.AmbientNat.betaCoreUncached_eval,
+    standardAxioms := standard, nativeAxioms := levelNative },
+  { root := ``Ix.Tc.AmbientNat.betaCoreUncached_acceptance,
+    standardAxioms := standard, nativeAxioms := levelNative,
+    sorryOrigins := #[inductiveWF, addInduct, addInductWF],
+    forbiddenDependencies := legacyWholeEnv },
+  -- K1d: both production zeta branches, including the legacy lifting walk,
+  -- mixed-context semantic lookup, bounded driver, and inhabited fixtures.
+  { root := ``Ix.Tc.CtxRecon.lctxFindLetVal,
+    standardAxioms := standard, nativeAxioms := expressionNative },
+  { root := ``Ix.Tc.TcM.lookupLetVal_eval,
+    standardAxioms := standard, nativeAxioms := expressionNative },
+  { root := ``Ix.Tc.RunAssumptions.lift_whnf_wf,
+    standardAxioms := standard, nativeAxioms := levelNative,
+    sorryOrigins := #[inductiveWF, addInduct] },
+  { root := ``Ix.Tc.RunAssumptions.lift_whnf_eval,
+    standardAxioms := standard, nativeAxioms := levelNative,
+    sorryOrigins := #[inductiveWF, addInduct] },
+  { root := ``Ix.Tc.WhnfMeaning.zetaVar,
+    standardAxioms := standard, nativeAxioms := expressionNative,
+    sorryOrigins := #[inductiveWF, addInduct, addInductWF] },
+  { root := ``Ix.Tc.WhnfMeaning.zetaFVar,
+    standardAxioms := standard, nativeAxioms := expressionNative,
+    sorryOrigins := #[inductiveWF, addInduct, addInductWF] },
+  { root := ``Ix.Tc.RecM.whnfCoreWithFlagsStep_varZeta,
+    standardAxioms := standard, nativeAxioms := levelNative },
+  { root := ``Ix.Tc.RecM.whnfCoreWithFlagsStep_fvarZeta,
+    standardAxioms := standard, nativeAxioms := levelNative },
+  { root := ``Ix.Tc.RecM.whnfCoreWithFlagsUncached_nextLeaf,
+    standardAxioms := standard, nativeAxioms := levelNative },
+  { root := ``Ix.Tc.RecM.whnfCoreWithFlagsUncached_varZeta,
+    standardAxioms := standard, nativeAxioms := levelNative },
+  { root := ``Ix.Tc.RecM.whnfCoreWithFlagsUncached_fvarZeta,
+    standardAxioms := standard, nativeAxioms := levelNative },
+  { root := ``Ix.Tc.RecM.whnfCoreWithFlagsUncached_varZeta_acceptance,
+    standardAxioms := standard, nativeAxioms := levelNative,
+    sorryOrigins := #[inductiveWF, addInduct, addInductWF] },
+  { root := ``Ix.Tc.RecM.whnfCoreWithFlagsUncached_fvarZeta_acceptance,
+    standardAxioms := standard, nativeAxioms := levelNative,
+    sorryOrigins := #[inductiveWF, addInduct, addInductWF] },
+  { root := ``Ix.Tc.AmbientNat.bvarZetaLiftSpec,
+    standardAxioms := standardWithoutQuot, nativeAxioms := expressionNative },
+  { root := ``Ix.Tc.AmbientNat.bvarZetaLookupEval,
+    standardAxioms := standard, nativeAxioms := expressionNative },
+  { root := ``Ix.Tc.AmbientNat.bvarZetaMeaning,
+    standardAxioms := standard, nativeAxioms := expressionNative,
+    sorryOrigins := #[inductiveWF, addInduct, addInductWF],
+    forbiddenDependencies := legacyWholeEnv },
+  { root := ``Ix.Tc.AmbientNat.bvarZetaCoreUncachedEval,
+    standardAxioms := standard, nativeAxioms := levelNative },
+  { root := ``Ix.Tc.AmbientNat.bvarZetaAcceptance,
+    standardAxioms := standard, nativeAxioms := levelNative,
+    sorryOrigins := #[inductiveWF, addInduct, addInductWF],
+    forbiddenDependencies := legacyWholeEnv },
+  { root := ``Ix.Tc.AmbientNat.fvarZetaMeaning,
+    standardAxioms := standard, nativeAxioms := expressionNative,
+    sorryOrigins := #[inductiveWF, addInduct, addInductWF],
+    forbiddenDependencies := legacyWholeEnv },
+  { root := ``Ix.Tc.AmbientNat.fvarZetaCoreUncachedEval,
+    standardAxioms := standard, nativeAxioms := levelNative },
+  { root := ``Ix.Tc.AmbientNat.fvarZetaAcceptance,
+    standardAxioms := standard, nativeAxioms := levelNative,
+    sorryOrigins := #[inductiveWF, addInduct, addInductWF],
+    forbiddenDependencies := legacyWholeEnv },
+  -- K1e: exact projection/iota branches and bounded-driver composition.
+  -- Semantic success is conditional on an explicit translated-source oracle;
+  -- the two hostile fixtures prove that raw helper success cannot replace it.
+  { root := ``Ix.Tc.WhnfMeaning.projection,
+    standardAxioms := standard,
+    sorryOrigins := #[inductiveWF, addInduct] },
+  { root := ``Ix.Tc.WhnfMeaning.registeredDefEq,
+    standardAxioms := standard,
+    sorryOrigins := #[inductiveWF, addInduct] },
+  { root := ``Ix.Tc.InductiveReductionOracle.projection,
+    standardAxioms := standard, nativeAxioms := levelNative,
+    sorryOrigins := #[inductiveWF, addInduct] },
+  { root := ``Ix.Tc.InductiveReductionOracle.iota,
+    standardAxioms := standard, nativeAxioms := levelNative,
+    sorryOrigins := #[inductiveWF, addInduct] },
+  { root := ``Ix.Tc.RecM.whnfCoreWithFlagsStep_projection,
+    standardAxioms := standard, nativeAxioms := levelNative },
+  { root := ``Ix.Tc.RecM.whnfCoreWithFlagsStep_iota,
+    standardAxioms := standard, nativeAxioms := levelNative },
+  { root := ``Ix.Tc.RecM.whnfCoreWithFlagsUncached_projection,
+    standardAxioms := standard, nativeAxioms := levelNative },
+  { root := ``Ix.Tc.RecM.whnfCoreWithFlagsUncached_iota,
+    standardAxioms := standard, nativeAxioms := levelNative },
+  { root := ``Ix.Tc.RecM.whnfCoreWithFlagsUncached_projection_acceptance,
+    standardAxioms := standard, nativeAxioms := levelNative,
+    sorryOrigins := #[inductiveWF, addInduct] },
+  { root := ``Ix.Tc.RecM.whnfCoreWithFlagsUncached_iota_acceptance,
+    standardAxioms := standard, nativeAxioms := levelNative,
+    sorryOrigins := #[inductiveWF, addInduct] },
+  { root := ``Ix.Tc.AmbientNat.projectionReduceEval,
+    standardAxioms := standard, nativeAxioms := expressionNative,
+    forbiddenDependencies := legacyWholeEnv },
+  { root := ``Ix.Tc.AmbientNat.projectionCoreEval,
+    standardAxioms := standard, nativeAxioms := levelNative,
+    forbiddenDependencies := legacyWholeEnv },
+  { root := ``Ix.Tc.AmbientNat.projectionSource_not_translated,
+    standardAxioms := standard, nativeAxioms := expressionNative,
+    sorryOrigins := #[inductiveWF, addInduct],
+    forbiddenDependencies := legacyWholeEnv },
+  { root := ``Ix.Tc.AmbientNat.projectionAdversarialWitness,
+    standardAxioms := standard, nativeAxioms := levelNative,
+    sorryOrigins := #[inductiveWF, addInduct],
+    forbiddenDependencies := legacyWholeEnv },
+  { root := ``Ix.Tc.AmbientNat.iotaStateInv,
+    standardAxioms := standard, nativeAxioms := levelNative,
+    sorryOrigins := #[inductiveWF, addInduct],
+    forbiddenDependencies := legacyWholeEnv },
+  { root := ``Ix.Tc.AmbientNat.iotaTryEval,
+    standardAxioms := standard, nativeAxioms := levelNative,
+    forbiddenDependencies := legacyWholeEnv },
+  { root := ``Ix.Tc.AmbientNat.iotaCoreEval,
+    standardAxioms := standard, nativeAxioms := levelNative,
+    forbiddenDependencies := legacyWholeEnv },
+  { root := ``Ix.Tc.AmbientNat.iotaSource_not_translated,
+    standardAxioms := standard, nativeAxioms := expressionNative,
+    sorryOrigins := #[inductiveWF, addInduct],
+    forbiddenDependencies := legacyWholeEnv },
+  { root := ``Ix.Tc.AmbientNat.iotaAdversarialWitness,
+    standardAxioms := standard, nativeAxioms := levelNative,
+    sorryOrigins := #[inductiveWF, addInduct],
+    forbiddenDependencies := legacyWholeEnv },
+  -- K1f: arbitrary-length structural traces compose exact production
+  -- execution, fixed-world/context invariants, and local Theory meanings.
+  -- The inhabited fixture takes two `.next` steps before its leaf; the
+  -- hostile zero-fuel witness cannot be certified as a successful trace.
+  { root := ``Ix.Tc.RecM.WhnfCoreTrace.no_zero,
+    standardAxioms := standard, nativeAxioms := levelNative,
+    sorryOrigins := #[inductiveWF, addInduct] },
+  { root := ``Ix.Tc.RecM.WhnfCoreTrace.eval,
+    standardAxioms := standard, nativeAxioms := levelNative,
+    sorryOrigins := #[inductiveWF, addInduct] },
+  { root := ``Ix.Tc.RecM.WhnfCoreTrace.initialInv,
+    standardAxioms := standard, nativeAxioms := levelNative,
+    sorryOrigins := #[inductiveWF, addInduct] },
+  { root := ``Ix.Tc.RecM.WhnfCoreTrace.finalInv,
+    standardAxioms := standard, nativeAxioms := levelNative,
+    sorryOrigins := #[inductiveWF, addInduct] },
+  { root := ``Ix.Tc.RecM.WhnfCoreTrace.meaning,
+    standardAxioms := standard, nativeAxioms := levelNative,
+    sorryOrigins := typingDebt },
+  { root := ``Ix.Tc.RecM.WhnfCoreTrace.uncached_eval,
+    standardAxioms := standard, nativeAxioms := levelNative,
+    sorryOrigins := #[inductiveWF, addInduct] },
+  { root := ``Ix.Tc.RecM.WhnfCoreTrace.uncached_acceptance,
+    standardAxioms := standard, nativeAxioms := levelNative,
+    sorryOrigins := typingDebt },
+  { root := ``Ix.Tc.AmbientNat.structuralNatLit_type,
+    standardAxioms := standard,
+    sorryOrigins := #[inductiveWF, addInduct],
+    forbiddenDependencies := legacyWholeEnv },
+  { root := ``Ix.Tc.AmbientNat.structuralWhnfTheory,
+    standardAxioms := standard,
+    sorryOrigins := #[inductiveWF, addInduct],
+    forbiddenDependencies := legacyWholeEnv },
+  { root := ``Ix.Tc.AmbientNat.structuralLoopStateInv,
+    standardAxioms := standard, nativeAxioms := levelNative,
+    sorryOrigins := #[inductiveWF, addInduct],
+    forbiddenDependencies := legacyWholeEnv },
+  { root := ``Ix.Tc.AmbientNat.structuralLoopSourceMeaning,
+    standardAxioms := standard, nativeAxioms := expressionNative,
+    sorryOrigins := #[inductiveWF, addInduct, addInductWF],
+    forbiddenDependencies := legacyWholeEnv },
+  { root := ``Ix.Tc.AmbientNat.structuralLoopBetaMeaning,
+    standardAxioms := standard, nativeAxioms := expressionNative,
+    sorryOrigins := #[inductiveWF, addInduct, addInductWF],
+    forbiddenDependencies := legacyWholeEnv },
+  { root := ``Ix.Tc.AmbientNat.structuralLoopFVarStep,
+    standardAxioms := standard, nativeAxioms := levelNative,
+    forbiddenDependencies := legacyWholeEnv },
+  { root := ``Ix.Tc.AmbientNat.structuralLoopBetaStep,
+    standardAxioms := standard, nativeAxioms := levelNative,
+    forbiddenDependencies := legacyWholeEnv },
+  { root := ``Ix.Tc.AmbientNat.structuralLoopTrace,
+    standardAxioms := standard, nativeAxioms := levelNative,
+    sorryOrigins := #[inductiveWF, addInduct, addInductWF],
+    forbiddenDependencies := legacyWholeEnv },
+  { root := ``Ix.Tc.AmbientNat.structuralLoopAcceptance,
+    standardAxioms := standard, nativeAxioms := levelNative,
+    sorryOrigins := typingDebt,
+    forbiddenDependencies := legacyWholeEnv },
+  { root := ``Ix.Tc.AmbientNat.structuralLoopZeroFuel,
+    standardAxioms := standard, nativeAxioms := levelNative,
+    sorryOrigins := #[inductiveWF, addInduct],
+    forbiddenDependencies := legacyWholeEnv },
+  -- K1g: the public structural entry point's keyed body has exact full,
+  -- cheap, miss, hit, and transient equations.  Misses require both an
+  -- execution-indexed trace and universal provenance before insertion;
+  -- hits require the physical entry, semantic invariant, and executed key
+  -- match.  The Nat fixture runs cold-to-warm in both isolated partitions.
+  { root := ``Ix.Tc.RecM.WhnfCoreNonLeaf.enter,
+    standardAxioms := standard, nativeAxioms := inferNative },
+  { root := ``Ix.Tc.RecM.whnfCoreWithFlags_varNotLet,
+    standardAxioms := standard, nativeAxioms := inferNative },
+  { root := ``Ix.Tc.RecM.whnfCoreWithFlags_varEnter,
+    standardAxioms := standard, nativeAxioms := inferNative },
+  { root := ``Ix.Tc.RecM.WhnfCoreKeyedEntry.eval,
+    standardAxioms := standard, nativeAxioms := inferNative },
+  { root := ``Ix.Tc.RecM.whnfCoreWithFlagsNonLeaf_fullHit,
+    standardAxioms := standard, nativeAxioms := inferNative },
+  { root := ``Ix.Tc.RecM.whnfCoreWithFlagsNonLeaf_cheapHit,
+    standardAxioms := standard, nativeAxioms := inferNative },
+  { root := ``Ix.Tc.RecM.whnfCoreWithFlagsNonLeaf_fullMiss,
+    standardAxioms := standard, nativeAxioms := inferNative },
+  { root := ``Ix.Tc.RecM.whnfCoreWithFlagsNonLeaf_cheapMiss,
+    standardAxioms := standard, nativeAxioms := inferNative },
+  { root := ``Ix.Tc.RecM.whnfCoreWithFlagsNonLeaf_transient,
+    standardAxioms := standard, nativeAxioms := inferNative },
+  { root := ``Ix.Tc.RecM.WhnfCoreCacheUpdate.full_whnfStateInv,
+    standardAxioms := standard,
+    sorryOrigins := #[inductiveWF, addInduct] },
+  { root := ``Ix.Tc.RecM.WhnfCoreCacheUpdate.cheap_whnfStateInv,
+    standardAxioms := standard,
+    sorryOrigins := #[inductiveWF, addInduct] },
+  { root := ``Ix.Tc.RecM.whnfCoreWithFlags_fullHit_acceptance,
+    standardAxioms := standard, nativeAxioms := inferNative,
+    sorryOrigins := #[inductiveWF, addInduct] },
+  { root := ``Ix.Tc.RecM.whnfCoreWithFlags_cheapHit_acceptance,
+    standardAxioms := standard, nativeAxioms := inferNative,
+    sorryOrigins := #[inductiveWF, addInduct] },
+  { root := ``Ix.Tc.RecM.whnfCoreWithFlags_fullMiss_acceptance,
+    standardAxioms := standard, nativeAxioms := inferNative,
+    sorryOrigins := typingDebt },
+  { root := ``Ix.Tc.RecM.whnfCoreWithFlags_cheapMiss_acceptance,
+    standardAxioms := standard, nativeAxioms := inferNative,
+    sorryOrigins := typingDebt },
+  { root := ``Ix.Tc.RecM.whnfCoreWithFlags_transient_acceptance,
+    standardAxioms := standard, nativeAxioms := inferNative,
+    sorryOrigins := typingDebt },
+  { root := ``Ix.Tc.AmbientNat.betaArgMeaning,
+    standardAxioms := standard, nativeAxioms := expressionNative,
+    sorryOrigins := #[inductiveWF, addInduct],
+    forbiddenDependencies := legacyWholeEnv },
+  { root := ``Ix.Tc.AmbientNat.fullCoreProvenance,
+    standardAxioms := standard, nativeAxioms := expressionNative,
+    sorryOrigins := #[inductiveWF, addInduct, addInductWF],
+    forbiddenDependencies := legacyWholeEnv },
+  { root := ``Ix.Tc.AmbientNat.cheapCoreProvenance,
+    standardAxioms := standard, nativeAxioms := expressionNative,
+    sorryOrigins := #[inductiveWF, addInduct, addInductWF],
+    forbiddenDependencies := legacyWholeEnv },
+  { root := ``Ix.Tc.AmbientNat.coreCacheFreshStateInv,
+    standardAxioms := standard, nativeAxioms := expressionNative,
+    sorryOrigins := #[inductiveWF, addInduct],
+    forbiddenDependencies := legacyWholeEnv },
+  { root := ``Ix.Tc.AmbientNat.fullCoreWarmStateInv,
+    standardAxioms := standard, nativeAxioms := expressionNative,
+    sorryOrigins := #[inductiveWF, addInduct, addInductWF],
+    forbiddenDependencies := legacyWholeEnv },
+  { root := ``Ix.Tc.AmbientNat.bothCoreWarmStateInv,
+    standardAxioms := standard, nativeAxioms := expressionNative,
+    sorryOrigins := #[inductiveWF, addInduct, addInductWF],
+    forbiddenDependencies := legacyWholeEnv },
+  { root := ``Ix.Tc.AmbientNat.coreCacheKey_eval,
+    standardAxioms := standard, nativeAxioms := contextNative,
+    forbiddenDependencies := legacyWholeEnv },
+  { root := ``Ix.Tc.AmbientNat.coreCacheKey_matches,
+    standardAxioms := standard, nativeAxioms := contextNative,
+    sorryOrigins := #[inductiveWF, addInduct],
+    forbiddenDependencies := legacyWholeEnv },
+  { root := ``Ix.Tc.AmbientNat.betaTransientFalse,
+    standardAxioms := standard, nativeAxioms := expressionNative,
+    forbiddenDependencies := legacyWholeEnv },
+  { root := ``Ix.Tc.AmbientNat.betaWalker_eval_state,
+    standardAxioms := standard, nativeAxioms := expressionNative,
+    forbiddenDependencies := legacyWholeEnv },
+  { root := ``Ix.Tc.AmbientNat.betaStep_state,
+    standardAxioms := standard, nativeAxioms := levelNative,
+    forbiddenDependencies := legacyWholeEnv },
+  { root := ``Ix.Tc.AmbientNat.coreCacheTrace,
+    standardAxioms := standard, nativeAxioms := levelNative,
+    sorryOrigins := #[inductiveWF, addInduct, addInductWF],
+    forbiddenDependencies := legacyWholeEnv },
+  { root := ``Ix.Tc.AmbientNat.fullCoreColdAcceptance,
+    standardAxioms := standard, nativeAxioms := inferNative,
+    sorryOrigins := typingDebt,
+    forbiddenDependencies := legacyWholeEnv },
+  { root := ``Ix.Tc.AmbientNat.fullCoreWarmAcceptance,
+    standardAxioms := standard, nativeAxioms := inferNative,
+    sorryOrigins := #[inductiveWF, addInduct, addInductWF],
+    forbiddenDependencies := legacyWholeEnv },
+  { root := ``Ix.Tc.AmbientNat.cheapCorePolicyMissAcceptance,
+    standardAxioms := standard, nativeAxioms := inferNative,
+    sorryOrigins := typingDebt,
+    forbiddenDependencies := legacyWholeEnv },
+  { root := ``Ix.Tc.AmbientNat.cheapCoreWarmAcceptance,
+    standardAxioms := standard, nativeAxioms := inferNative,
+    sorryOrigins := #[inductiveWF, addInduct, addInductWF],
+    forbiddenDependencies := legacyWholeEnv },
+  { root := ``Ix.Tc.AmbientNat.coreCachePolicyIsolation,
+    standardAxioms := standard, nativeAxioms := expressionNative,
+    forbiddenDependencies := legacyWholeEnv },
+  -- K1h: no-delta and full-WHNF now have execution-indexed bounded traces,
+  -- exact public-prefix/cache/fuel equations, provenance-checked insertion,
+  -- and semantic hit/miss acceptance.  The Nat fixture executes all nested
+  -- cache layers, proves the cold call consumes exactly one fuel unit, and
+  -- proves the warm public call preserves the entire state.
+  { root := ``Ix.Tc.WhnfStateInv.of_semantic_fields_eq,
+    standardAxioms := standard,
+    sorryOrigins := #[inductiveWF, addInduct] },
+  { root := ``Ix.Tc.TcM.stepTrace_disabled,
+    standardAxioms := standardWithoutChoice },
+  { root := ``Ix.Tc.TcM.bumpStats_disabled,
+    standardAxioms := standardWithoutChoice },
+  { root := ``Ix.Tc.TcM.tick_success,
+    standardAxioms := standardWithoutChoice },
+  { root := ``Ix.Tc.RecM.WhnfNoDeltaTrace.no_zero,
+    standardAxioms := standard, nativeAxioms := inferNative,
+    sorryOrigins := #[inductiveWF, addInduct] },
+  { root := ``Ix.Tc.RecM.WhnfNoDeltaTrace.eval,
+    standardAxioms := standard, nativeAxioms := inferNative,
+    sorryOrigins := #[inductiveWF, addInduct] },
+  { root := ``Ix.Tc.RecM.WhnfNoDeltaTrace.initialInv,
+    standardAxioms := standard, nativeAxioms := inferNative,
+    sorryOrigins := #[inductiveWF, addInduct] },
+  { root := ``Ix.Tc.RecM.WhnfNoDeltaTrace.finalInv,
+    standardAxioms := standard, nativeAxioms := inferNative,
+    sorryOrigins := #[inductiveWF, addInduct] },
+  { root := ``Ix.Tc.RecM.WhnfNoDeltaTrace.meaning,
+    standardAxioms := standard, nativeAxioms := inferNative,
+    sorryOrigins := typingDebt },
+  { root := ``Ix.Tc.RecM.WhnfNoDeltaTrace.uncached_eval,
+    standardAxioms := standard, nativeAxioms := inferNative,
+    sorryOrigins := #[inductiveWF, addInduct] },
+  { root := ``Ix.Tc.RecM.WhnfNoDeltaTrace.uncached_acceptance,
+    standardAxioms := standard, nativeAxioms := inferNative,
+    sorryOrigins := typingDebt },
+  { root := ``Ix.Tc.RecM.WhnfFullTrace.no_zero,
+    standardAxioms := standard, nativeAxioms := inferNative,
+    sorryOrigins := #[inductiveWF, addInduct] },
+  { root := ``Ix.Tc.RecM.WhnfFullTrace.eval,
+    standardAxioms := standard, nativeAxioms := inferNative,
+    sorryOrigins := #[inductiveWF, addInduct] },
+  { root := ``Ix.Tc.RecM.WhnfFullTrace.initialInv,
+    standardAxioms := standard, nativeAxioms := inferNative,
+    sorryOrigins := #[inductiveWF, addInduct] },
+  { root := ``Ix.Tc.RecM.WhnfFullTrace.finalInv,
+    standardAxioms := standard, nativeAxioms := inferNative,
+    sorryOrigins := #[inductiveWF, addInduct] },
+  { root := ``Ix.Tc.RecM.WhnfFullTrace.meaning,
+    standardAxioms := standard, nativeAxioms := inferNative,
+    sorryOrigins := typingDebt },
+  { root := ``Ix.Tc.RecM.WhnfFullTrace.uncached_eval,
+    standardAxioms := standard, nativeAxioms := inferNative,
+    sorryOrigins := #[inductiveWF, addInduct] },
+  { root := ``Ix.Tc.RecM.WhnfFullTrace.uncached_acceptance,
+    standardAxioms := standard, nativeAxioms := inferNative,
+    sorryOrigins := typingDebt },
+  { root := ``Ix.Tc.RecM.WhnfDriverNonLeaf.noDelta_enter,
+    standardAxioms := standard, nativeAxioms := inferNative },
+  { root := ``Ix.Tc.RecM.WhnfDriverNonLeaf.full_enter,
+    standardAxioms := standard, nativeAxioms := inferNative },
+  { root := ``Ix.Tc.RecM.WhnfDriverEntry.noDelta_eval,
+    standardAxioms := standard, nativeAxioms := inferNative },
+  { root := ``Ix.Tc.RecM.WhnfDriverEntry.full_eval,
+    standardAxioms := standard, nativeAxioms := inferNative },
+  { root := ``Ix.Tc.RecM.whnfWithNatSuccModePrefix_disabled,
+    standardAxioms := standard },
+  { root := ``Ix.Tc.RecM.whnfWithNatSuccModeMissCharge_disabled,
+    standardAxioms := standardWithoutChoice },
+  { root := ``Ix.Tc.RecM.whnfNoDeltaImplNonLeaf_fullHit,
+    standardAxioms := standard, nativeAxioms := inferNative },
+  { root := ``Ix.Tc.RecM.whnfNoDeltaImplNonLeaf_cheapHit,
+    standardAxioms := standard, nativeAxioms := inferNative },
+  { root := ``Ix.Tc.RecM.whnfNoDeltaImplNonLeaf_fullMiss,
+    standardAxioms := standard, nativeAxioms := inferNative },
+  { root := ``Ix.Tc.RecM.whnfNoDeltaImplNonLeaf_cheapMiss,
+    standardAxioms := standard, nativeAxioms := inferNative },
+  { root := ``Ix.Tc.RecM.whnfNoDeltaImplNonLeaf_stuck,
+    standardAxioms := standard, nativeAxioms := inferNative },
+  { root := ``Ix.Tc.RecM.whnfNoDeltaImplNonLeaf_transient,
+    standardAxioms := standard, nativeAxioms := inferNative },
+  { root := ``Ix.Tc.RecM.whnfNoDeltaImplNonLeaf_nativeNoInsert,
+    standardAxioms := standard, nativeAxioms := inferNative },
+  { root := ``Ix.Tc.RecM.WhnfDriverCacheUpdate.noDelta_whnfStateInv,
+    standardAxioms := standard,
+    sorryOrigins := #[inductiveWF, addInduct] },
+  { root := ``Ix.Tc.RecM.WhnfDriverCacheUpdate.noDeltaCheap_whnfStateInv,
+    standardAxioms := standard,
+    sorryOrigins := #[inductiveWF, addInduct] },
+  { root := ``Ix.Tc.RecM.WhnfDriverCacheUpdate.full_whnfStateInv,
+    standardAxioms := standard,
+    sorryOrigins := #[inductiveWF, addInduct] },
+  { root := ``Ix.Tc.RecM.whnfNoDeltaImpl_fullHit_acceptance,
+    standardAxioms := standard, nativeAxioms := inferNative,
+    sorryOrigins := #[inductiveWF, addInduct] },
+  { root := ``Ix.Tc.RecM.whnfNoDeltaImpl_cheapHit_acceptance,
+    standardAxioms := standard, nativeAxioms := inferNative,
+    sorryOrigins := #[inductiveWF, addInduct] },
+  { root := ``Ix.Tc.RecM.whnfNoDeltaImpl_fullMiss_acceptance,
+    standardAxioms := standard, nativeAxioms := inferNative,
+    sorryOrigins := typingDebt },
+  { root := ``Ix.Tc.RecM.whnfNoDeltaImpl_cheapMiss_acceptance,
+    standardAxioms := standard, nativeAxioms := inferNative,
+    sorryOrigins := typingDebt },
+  { root := ``Ix.Tc.RecM.whnfNoDeltaImpl_stuck_acceptance,
+    standardAxioms := standard, nativeAxioms := inferNative,
+    sorryOrigins := typingDebt },
+  { root := ``Ix.Tc.RecM.whnfNoDeltaImpl_transient_acceptance,
+    standardAxioms := standard, nativeAxioms := inferNative,
+    sorryOrigins := typingDebt },
+  { root := ``Ix.Tc.RecM.whnfWithNatSuccModeNonLeaf_hit,
+    standardAxioms := standard, nativeAxioms := inferNative },
+  { root := ``Ix.Tc.RecM.whnfWithNatSuccModeNonLeaf_miss,
+    standardAxioms := standard, nativeAxioms := inferNative },
+  { root := ``Ix.Tc.RecM.whnfWithNatSuccModeNonLeaf_stuck,
+    standardAxioms := standard, nativeAxioms := inferNative },
+  { root := ``Ix.Tc.RecM.whnfWithNatSuccModeNonLeaf_transient,
+    standardAxioms := standard, nativeAxioms := inferNative },
+  { root := ``Ix.Tc.RecM.whnfWithNatSuccModeNonLeaf_nativeNoInsert,
+    standardAxioms := standard, nativeAxioms := inferNative },
+  { root := ``Ix.Tc.RecM.whnfWithNatSuccMode_hit_acceptance,
+    standardAxioms := standard, nativeAxioms := inferNative,
+    sorryOrigins := #[inductiveWF, addInduct] },
+  { root := ``Ix.Tc.RecM.whnfWithNatSuccMode_miss_acceptance,
+    standardAxioms := standard, nativeAxioms := inferNative,
+    sorryOrigins := typingDebt },
+  { root := ``Ix.Tc.RecM.whnfWithNatSuccMode_stuck_acceptance,
+    standardAxioms := standard, nativeAxioms := inferNative,
+    sorryOrigins := typingDebt },
+  { root := ``Ix.Tc.RecM.whnfWithNatSuccMode_transient_acceptance,
+    standardAxioms := standard, nativeAxioms := inferNative,
+    sorryOrigins := typingDebt },
+  { root := ``Ix.Tc.RecM.whnf_public_eq_whnfWithNatSuccMode,
+    standardAxioms := standard, nativeAxioms := inferNative },
+  { root := ``Ix.Tc.AmbientNat.betaNoDeltaStep,
+    standardAxioms := standard, nativeAxioms := inferNative,
+    sorryOrigins := #[inductiveWF, addInduct, addInductWF],
+    forbiddenDependencies := legacyWholeEnv },
+  { root := ``Ix.Tc.AmbientNat.fullNoDeltaProvenance,
+    standardAxioms := standard, nativeAxioms := expressionNative,
+    sorryOrigins := #[inductiveWF, addInduct, addInductWF],
+    forbiddenDependencies := legacyWholeEnv },
+  { root := ``Ix.Tc.AmbientNat.fullWhnfProvenance,
+    standardAxioms := standard, nativeAxioms := expressionNative,
+    sorryOrigins := #[inductiveWF, addInduct, addInductWF],
+    forbiddenDependencies := legacyWholeEnv },
+  { root := ``Ix.Tc.AmbientNat.fullNoDeltaWarmStateInv,
+    standardAxioms := standard, nativeAxioms := expressionNative,
+    sorryOrigins := #[inductiveWF, addInduct, addInductWF],
+    forbiddenDependencies := legacyWholeEnv },
+  { root := ``Ix.Tc.AmbientNat.noDeltaTrace,
+    standardAxioms := standard, nativeAxioms := inferNative,
+    sorryOrigins := #[inductiveWF, addInduct, addInductWF],
+    forbiddenDependencies := legacyWholeEnv },
+  { root := ``Ix.Tc.AmbientNat.fullNoDeltaColdAcceptance,
+    standardAxioms := standard, nativeAxioms := inferNative,
+    sorryOrigins := typingDebt,
+    forbiddenDependencies := legacyWholeEnv },
+  { root := ``Ix.Tc.AmbientNat.fullNoDeltaWarmAcceptance,
+    standardAxioms := standard, nativeAxioms := inferNative,
+    sorryOrigins := #[inductiveWF, addInduct, addInductWF],
+    forbiddenDependencies := legacyWholeEnv },
+  { root := ``Ix.Tc.AmbientNat.noDeltaCachePolicyIsolation,
+    standardAxioms := standard, nativeAxioms := expressionNative,
+    forbiddenDependencies := legacyWholeEnv },
+  { root := ``Ix.Tc.AmbientNat.fullWhnfChargedStateInv,
+    standardAxioms := standard, nativeAxioms := expressionNative,
+    sorryOrigins := #[inductiveWF, addInduct, addInductWF],
+    forbiddenDependencies := legacyWholeEnv },
+  { root := ``Ix.Tc.AmbientNat.fullWhnfPrefixCold,
+    standardAxioms := standard, nativeAxioms := expressionNative,
+    forbiddenDependencies := legacyWholeEnv },
+  { root := ``Ix.Tc.AmbientNat.fullWhnfMissCharge,
+    standardAxioms := standard, nativeAxioms := expressionNative,
+    forbiddenDependencies := legacyWholeEnv },
+  { root := ``Ix.Tc.AmbientNat.fullWhnfCharged_noDeltaHit,
+    standardAxioms := standard, nativeAxioms := inferNative,
+    forbiddenDependencies := legacyWholeEnv },
+  { root := ``Ix.Tc.AmbientNat.betaFullWhnfStep,
+    standardAxioms := standard, nativeAxioms := inferNative,
+    forbiddenDependencies := legacyWholeEnv },
+  { root := ``Ix.Tc.AmbientNat.fullWhnfTrace,
+    standardAxioms := standard, nativeAxioms := inferNative,
+    sorryOrigins := #[inductiveWF, addInduct, addInductWF],
+    forbiddenDependencies := legacyWholeEnv },
+  { root := ``Ix.Tc.AmbientNat.fullWhnfWarmStateInv,
+    standardAxioms := standard, nativeAxioms := expressionNative,
+    sorryOrigins := #[inductiveWF, addInduct, addInductWF],
+    forbiddenDependencies := legacyWholeEnv },
+  { root := ``Ix.Tc.AmbientNat.fullWhnfColdAcceptance,
+    standardAxioms := standard, nativeAxioms := inferNative,
+    sorryOrigins := typingDebt,
+    forbiddenDependencies := legacyWholeEnv },
+  { root := ``Ix.Tc.AmbientNat.fullWhnfWarmAcceptance,
+    standardAxioms := standard, nativeAxioms := inferNative,
+    sorryOrigins := #[inductiveWF, addInduct, addInductWF],
+    forbiddenDependencies := legacyWholeEnv },
+  { root := ``Ix.Tc.AmbientNat.fullWhnfFuelDiscipline,
+    standardAxioms := standard, nativeAxioms := expressionNative,
+    forbiddenDependencies := legacyWholeEnv },
+  { root := ``Ix.Tc.AmbientNat.fullWhnfCacheLayering,
+    standardAxioms := standard, nativeAxioms := expressionNative,
+    forbiddenDependencies := legacyWholeEnv },
+  { root := ``Ix.Tc.WhnfPost.refl,
+    standardAxioms := standard,
+    sorryOrigins := #[inductiveWF, addInduct] },
+  { root := ``Ix.Tc.RecM.WF.bind,
+    standardAxioms := standard,
+    sorryOrigins := #[inductiveWF, addInduct] },
+  { root := ``Ix.Tc.RecM.runBounded_wf,
+    standardAxioms := standard,
+    sorryOrigins := #[inductiveWF, addInduct] },
+  { root := ``Ix.Tc.RecM.WhnfLeaf.eval,
+    standardAxioms := standard, nativeAxioms := inferNative },
+  { root := ``Ix.Tc.RecM.whnf_leaf_wf,
+    standardAxioms := standard, nativeAxioms := inferNative,
+    sorryOrigins := #[inductiveWF, addInduct] },
+  { root := ``Ix.Tc.RecM.whnf_leaf_wf_of_theory,
+    standardAxioms := standard, nativeAxioms := inferNative,
+    sorryOrigins := #[inductiveWF, addInduct, addInductWF] },
+  { root := ``Ix.Tc.AmbientNat.noAccelStateInv,
+    standardAxioms := standard, nativeAxioms := levelNative,
+    sorryOrigins := #[inductiveWF, addInduct],
+    forbiddenDependencies := legacyWholeEnv },
+  { root := ``Ix.Tc.AmbientNat.whnfLeaf_noAccel_wf,
+    standardAxioms := standard, nativeAxioms := inferNative,
+    sorryOrigins := #[inductiveWF, addInduct],
+    forbiddenDependencies := legacyWholeEnv },
+  { root := ``Ix.Tc.AmbientNat.whnfLeaf_noAccel_acceptance,
+    standardAxioms := standard, nativeAxioms := inferNative,
+    sorryOrigins := #[inductiveWF, addInduct],
+    forbiddenDependencies := legacyWholeEnv },
+  { root := ``Ix.Tc.TcM.whnfKey_fst,
+    standardAxioms := standard, nativeAxioms := contextNative },
+  { root := ``Ix.Tc.WhnfContextKeys.Matches.sourceAddr,
+    standardAxioms := standard, nativeAxioms := contextNative,
+    sorryOrigins := #[inductiveWF, addInduct] },
+  { root := ``Ix.Tc.CacheProvenance.whnfMeaningOfMatches,
+    standardAxioms := standard, nativeAxioms := contextNative,
+    sorryOrigins := #[inductiveWF, addInduct] },
+  { root := ``Ix.Tc.CacheInvariant.whnfHitOfMatches,
+    standardAxioms := standard, nativeAxioms := contextNative,
+    sorryOrigins := #[inductiveWF, addInduct] },
+  { root := ``Ix.Tc.AmbientNat.warmKey_matches,
+    standardAxioms := standard, nativeAxioms := contextNative,
+    sorryOrigins := #[inductiveWF, addInduct],
+    forbiddenDependencies := legacyWholeEnv },
+  { root := ``Ix.Tc.methodsN_zero,
+    standardAxioms := standard, nativeAxioms := inferNative },
+  { root := ``Ix.Tc.methodsN_succ_whnf,
+    standardAxioms := standard, nativeAxioms := inferNative },
+  { root := ``Ix.Tc.methodsN_succ_whnfCore,
+    standardAxioms := standard, nativeAxioms := inferNative },
+  { root := ``Ix.Tc.methodsN_succ_whnfMode,
+    standardAxioms := standard, nativeAxioms := inferNative },
+  { root := ``Ix.Tc.methodsN_succ_whnfCoreFlags,
+    standardAxioms := standard, nativeAxioms := inferNative },
+  { root := ``Ix.Tc.methodsN_succ_infer,
+    standardAxioms := standard, nativeAxioms := inferNative },
+  { root := ``Ix.Tc.methodsN_succ_isDefEq,
+    standardAxioms := standard, nativeAxioms := inferNative },
+  { root := ``Ix.Tc.methodsOut_whnf,
+    standardAxioms := standardWithoutChoice },
+  { root := ``Ix.Tc.methodsOut_whnfCore,
+    standardAxioms := standardWithoutChoice },
+  { root := ``Ix.Tc.methodsOut_whnfMode,
+    standardAxioms := standardWithoutChoice },
+  { root := ``Ix.Tc.methodsOut_whnfCoreFlags,
+    standardAxioms := standardWithoutChoice },
+  { root := ``Ix.Tc.methodsOut_infer,
+    standardAxioms := standardWithoutChoice },
+  { root := ``Ix.Tc.methodsOut_isDefEq,
+    standardAxioms := standardWithoutChoice },
+  { root := ``Ix.Tc.TcM.runRec_apply,
+    standardAxioms := standard, nativeAxioms := inferNative },
+  { root := ``Ix.Tc.TcM.runRec_directInfer_zero,
+    standardAxioms := standard, nativeAxioms := inferNative },
+  { root := ``Ix.Tc.TcM.whnf_eq_runRec,
+    standardAxioms := standard, nativeAxioms := inferNative },
+  { root := ``Ix.Tc.TcM.whnfCore_eq_runRec,
+    standardAxioms := standard, nativeAxioms := inferNative },
+  { root := ``Ix.Tc.TcM.whnfNoDelta_eq_runRec,
+    standardAxioms := standard, nativeAxioms := inferNative },
+  { root := ``Ix.Tc.TcM.infer_eq_runRec,
+    standardAxioms := standard, nativeAxioms := inferNative },
+  { root := ``Ix.Tc.TcM.isDefEq_eq_runRec,
+    standardAxioms := standard, nativeAxioms := inferNative },
+  { root := ``Ix.Tc.TcM.ensureSort_eq_runRec,
+    standardAxioms := standard, nativeAxioms := inferNative },
+  { root := ``Ix.Tc.TcM.ensureForall_eq_runRec,
+    standardAxioms := standard, nativeAxioms := inferNative },
+  { root := ``Ix.Tc.RecM.unfoldConstValue_equation,
+    standardAxioms := standard, nativeAxioms := levelNative },
+  { root := ``Ix.Tc.RecM.tryDeltaUnfold_equation,
+    standardAxioms := standard, nativeAxioms := levelNative },
+  { root := ``Ix.Tc.RecM.deltaUnfoldOne_equation,
+    standardAxioms := standard, nativeAxioms := levelNative },
+  { root := ``Ix.Tc.RecM.applyIotaArg_false,
+    standardAxioms := standard, nativeAxioms := expressionNative },
+  { root := ``Ix.Tc.RecM.applyIotaArg_true_lam,
+    standardAxioms := standard, nativeAxioms := expressionNative },
+  { root := ``Ix.Tc.RecM.isNatLiteralRecursorApp_equation,
+    standardAxioms := standardWithoutChoice },
+  { root := ``Ix.Tc.RecM.isTransientNatLiteralWork_equation,
+    standardAxioms := standard, nativeAxioms := expressionNative },
+  { root := ``Ix.Tc.RecM.cleanupNatOffsetMajor_equation,
+    standardAxioms := standard, nativeAxioms := expressionNative },
+  { root := ``Ix.Tc.RecM.projectDecidableFinValMinor_equation,
+    standardAxioms := standard, nativeAxioms := expressionNative },
+  { root := ``Ix.Tc.RecM.tryReduceFinValDecidableRec_equation,
+    standardAxioms := standard, nativeAxioms := expressionNative },
+  { root := ``Ix.Tc.RecM.tryReduceProjectionDefinition_equation,
+    standardAxioms := standard, nativeAxioms := expressionNative },
+  { root := ``Ix.Tc.RecM.natRecLiteralParts_equation,
+    standardAxioms := standardWithoutChoice },
+  { root := ``Ix.Tc.RecM.isNatStuckRecursorAddr_equation,
+    standardAxioms := standardWithoutChoice },
+  { root := ``Ix.Tc.RecM.isStuckNatPredicateProbe_equation,
+    standardAxioms := standardWithoutChoice },
+  { root := ``Ix.Tc.RecM.bitvecOfNatArgs_equation,
+    standardAxioms := standard, nativeAxioms := expressionNative },
+  { root := ``Ix.Tc.RecM.charOfNatExpr_equation,
+    standardAxioms := standard, nativeAxioms := expressionNative },
+  { root := ``Ix.Tc.RecM.tryReduceString_equation,
+    standardAxioms := standard, nativeAxioms := expressionNative },
+  { root := ``Ix.Tc.RecM.discoverBlockInductives_equation,
+    standardAxioms := standardWithoutChoice },
+  { root := ``Ix.Tc.RecM.runBounded_zero,
+    standardAxioms := standardWithoutChoice },
+  { root := ``Ix.Tc.RecM.runBounded_succ,
+    standardAxioms := standardWithoutChoice },
+  { root := ``Ix.Tc.RecM.consumeBetaLams_equation,
+    standardAxioms := standardWithoutQuot,
+    nativeAxioms := expressionNative },
+  { root := ``Ix.Tc.RecM.consumeBetaLamsFuel_zero,
+    standardAxioms := standardWithoutQuot,
+    nativeAxioms := expressionNative },
+  { root := ``Ix.Tc.RecM.consumeBetaLamsFuel_succ,
+    standardAxioms := standardWithoutQuot,
+    nativeAxioms := expressionNative },
+  { root := ``Ix.Tc.RecM.compareRank_equation,
+    standardAxioms := propextOnly },
+  { root := ``Ix.Tc.RecM.isNatLike_equation,
+    standardAxioms := standardWithoutChoice },
+  { root := ``Ix.Tc.RecM.isNatZero_equation,
+    standardAxioms := standardWithoutChoice },
+  { root := ``Ix.Tc.RecM.natSuccOf_equation,
+    standardAxioms := standard, nativeAxioms := expressionNative },
+  { root := ``Ix.Tc.RecM.isBoolTrue_equation,
+    standardAxioms := standardWithoutChoice },
+  { root := ``Ix.Tc.RecM.isDelta_equation,
+    standardAxioms := standardWithoutChoice },
+  { root := ``Ix.Tc.RecM.isRegular_equation,
+    standardAxioms := standardWithoutChoice },
+  { root := ``Ix.Tc.RecM.defRankId_equation,
+    standardAxioms := standardWithoutChoice },
+  { root := ``Ix.Tc.RecM.infer_eq_inferWith,
+    standardAxioms := standard, nativeAxioms := inferNative },
+  { root := ``Ix.Tc.RecM.inferCall_run,
+    standardAxioms := standardWithoutChoice },
+  { root := ``Ix.Tc.RecM.inferOnlyCall_run,
+    standardAxioms := standardWithoutChoice },
+  { root := ``Ix.Tc.RecM.isDefEqCall_run,
+    standardAxioms := standardWithoutChoice },
+  { root := ``Ix.Tc.RecM.whnfRec_run,
+    standardAxioms := standardWithoutChoice },
+  { root := ``Ix.Tc.RecM.whnfModeRec_run,
+    standardAxioms := standardWithoutChoice },
+  { root := ``Ix.Tc.RecM.whnfCoreFlagsRec_run,
+    standardAxioms := standardWithoutChoice },
+  { root := ``Ix.Tc.RecM.whnf_eq_whnfWithNatSuccMode,
+    standardAxioms := standard, nativeAxioms := inferNative },
+  { root := ``Ix.Tc.RecM.whnfCore_eq_whnfCoreWithFlags,
+    standardAxioms := standard, nativeAxioms := inferNative },
+  { root := ``Ix.Tc.RecM.whnfNoDelta_eq_whnfNoDeltaImpl,
+    standardAxioms := standard, nativeAxioms := inferNative },
+  { root := ``Ix.Tc.RecM.ensureSortDirect_equation,
+    standardAxioms := standard, nativeAxioms := inferNative },
+  { root := ``Ix.Tc.RecM.ensureForallDirect_equation,
+    standardAxioms := standard, nativeAxioms := inferNative },
+  { root := ``Ix.Tc.RecM.peelProjForall_equation,
+    standardAxioms := standard, nativeAxioms := inferNative },
+  { root := ``Ix.Tc.RecM.checkNoUnsafeRefs_equation,
+    standardAxioms := standard },
+  { root := ``Ix.Tc.RecM.checkNoUnsafeRefs_go_nil,
+    standardAxioms := standard },
+  { root := ``Ix.Tc.RecM.checkNoUnsafeRefs_go_app,
+    standardAxioms := standard },
+  { root := ``Ix.Tc.RecM.validateUnivParamsSeen_equation,
+    standardAxioms := standardWithoutChoice },
+  { root := ``Ix.Tc.RecM.validateUnivParamsSeen_go_nil,
+    standardAxioms := standardWithoutChoice },
+  { root := ``Ix.Tc.RecM.validateUnivParamsSeen_go_max,
+    standardAxioms := standardWithoutChoice },
+  { root := ``Ix.Tc.RecM.validateExprWellScoped_equation,
+    standardAxioms := standardWithoutChoice },
+  { root := ``Ix.Tc.RecM.validateExprWellScoped_go_nil,
+    standardAxioms := standardWithoutChoice },
+  { root := ``Ix.Tc.RecM.validateExprWellScoped_go_app,
+    standardAxioms := standardWithoutChoice },
+  { root := ``Ix.Tc.RecM.peelRuleIhForalls_equation,
+    standardAxioms := standardWithoutChoice },
+  { root := ``Ix.Tc.RecM.checkPositivityDomain_equation,
+    standardAxioms := standard, nativeAxioms := inferNative },
+  { root := ``Ix.Tc.RecM.checkPositivityDomainFuel_zero,
+    standardAxioms := standard, nativeAxioms := inferNative },
+  { root := ``Ix.Tc.RecM.checkNestedCtorFieldsFuel_zero,
+    standardAxioms := standard, nativeAxioms := inferNative },
+  { root := ``Ix.Tc.RecM.checkNestedCtorFieldsLoopFuel_zero,
+    standardAxioms := standard, nativeAxioms := inferNative },
+  { root := ``Ix.Tc.RecM.countForalls_equation,
+    standardAxioms := standard, nativeAxioms := inferNative },
+  -- The complete checker dispatch is transparent now; these roots pin its
+  -- exact production trust boundary in addition to the local equations.
+  { root := ``Ix.Tc.RecM.checkInductive,
+    standardAxioms := standard, nativeAxioms := inductiveNative },
+  { root := ``Ix.Tc.RecM.checkRecursorMemberImpl,
+    standardAxioms := standard, nativeAxioms := inductiveNative },
+  { root := ``Ix.Tc.RecM.checkConst,
+    standardAxioms := standard, nativeAxioms := inductiveNative },
+  { root := ``Ix.Tc.TcM.checkConst,
+    standardAxioms := standard, nativeAxioms := inductiveNative },
+  { root := ``Ix.Tc.extractNatValue_app_const_equation,
+    standardAxioms := propextOnly },
+  { root := ``Ix.Tc.extractNatValue_nat_equation,
+    standardAxioms := propextOnly },
+  { root := ``Ix.Tc.projectionDefinitionInfo_go_equation,
+    standardAxioms := propextOnly },
+  { root := ``Ix.Tc.EquivManager.find_equation,
+    standardAxioms := standardWithoutChoice },
+  { root := ``Ix.Tc.EquivManager.find_go_zero },
+  { root := ``Ix.Tc.EquivManager.find_go_succ },
+  { root := ``Ix.Tc.LocalContext.truncate_equation,
+    standardAxioms := standard, nativeAxioms := expressionNative },
+  { root := ``Ix.Tc.LocalContext.truncate_go_zero,
+    standardAxioms := standard, nativeAxioms := expressionNative },
+  { root := ``Ix.Tc.LocalContext.truncate_go_succ,
+    standardAxioms := standard, nativeAxioms := expressionNative },
+  { root := ``Ix.Tc.TcM.restoreDepth_apply,
+    standardAxioms := standard, nativeAxioms := blake3Native },
+  { root := ``Ix.Tc.TcM.restoreDepth_go_zero,
+    standardAxioms := standard, nativeAxioms := blake3Native },
+  { root := ``Ix.Tc.TcM.ctxSuffixNeed_zero,
+    standardAxioms := standard, nativeAxioms := expressionNative },
+  { root := ``Ix.Tc.TcM.ctxSuffixNeed_succ,
+    standardAxioms := standard, nativeAxioms := expressionNative },
+  { root := ``Ix.Tc.TcM.ctxSuffixNeed_of_fixed,
+    standardAxioms := standard, nativeAxioms := expressionNative },
+  { root := ``Ix.Tc.KExpr.render_equation,
+    standardAxioms := standard },
+  { root := ``Ix.Tc.KExpr.renderFuel_zero,
+    standardAxioms := standard },
+  { root := ``Ix.Tc.RecM.natOffset_equation,
+    standardAxioms := standard, nativeAxioms := expressionNative },
+  { root := ``Ix.Tc.RecM.natOffsetOrZero_equation,
+    standardAxioms := standard, nativeAxioms := expressionNative },
+  { root := ``Ix.Tc.RecM.evalNatOffsetLiteral_equation,
+    standardAxioms := standard, nativeAxioms := expressionNative },
+  { root := ``Ix.Tc.RecM.natOffsetFuel_zero,
+    standardAxioms := standard, nativeAxioms := expressionNative },
+  { root := ``Ix.Tc.RecM.evalNatOffsetLiteralFuel_zero,
+    standardAxioms := standard, nativeAxioms := expressionNative },
+  { root := ``Ix.Tc.RecM.tryEvalNatValueForPred_equation,
+    standardAxioms := standard, nativeAxioms := expressionNative },
+  { root := ``Ix.Tc.RecM.tryEvalNatValueForPredFuel_zero,
+    standardAxioms := standard, nativeAxioms := expressionNative },
+  { root := ``Ix.Tc.compareKUniv_succ_equation,
+    standardAxioms := propextOnly },
+  { root := ``Ix.Tc.compareKUniv_max_equation,
+    standardAxioms := propextOnly },
+  { root := ``Ix.Tc.mergeSorted_equation,
+    standardAxioms := standard, nativeAxioms := expressionNative },
+  { root := ``Ix.Tc.mergeSorted_go_zero,
+    standardAxioms := standard, nativeAxioms := expressionNative },
+  { root := ``Ix.Tc.sortByCompare_equation,
+    standardAxioms := standard, nativeAxioms := expressionNative },
+  { root := ``Ix.Tc.sortByCompareFuel_zero,
+    standardAxioms := standard, nativeAxioms := expressionNative },
+  { root := ``Ix.Tc.sortKConstsRefineFuel_zero,
+    standardAxioms := standard, nativeAxioms := expressionNative },
+  { root := ``Ix.Tc.KExpr.treeSize_pos,
+    standardAxioms := propextOnly },
+  { root := ``Ix.Tc.exprMentionsAddr_equation,
+    standardAxioms := standardWithoutChoice },
+  { root := ``Ix.Tc.exprMentionsAddr_go_nil,
+    standardAxioms := standardWithoutChoice },
+  { root := ``Ix.Tc.exprMentionsAddr_go_app,
+    standardAxioms := standardWithoutChoice },
+  { root := ``Ix.Tc.exprMentionsAddr_go_const,
+    standardAxioms := standardWithoutChoice }
+]
+
+run_cmd Ix.Tc.Verify.Audit.check roots
+
+end Ix.Tc.Verify.Audit.Completed
diff --git a/Ix/Tc/Verify/Audit/Statements.lean b/Ix/Tc/Verify/Audit/Statements.lean
new file mode 100644
index 00000000..b432c1bd
--- /dev/null
+++ b/Ix/Tc/Verify/Audit/Statements.lean
@@ -0,0 +1,68 @@
+import Ix.Tc.Verify.Audit.Basic
+import Ix.Tc.Verify.Statements
+
+/-!
+# Trust manifest for the temporary checker statement frontier
+
+The four roots in this import context are intentionally still proved with
+`sorry`. Their exact direct frontier includes each theorem itself plus the
+two upstream inductive-environment assumptions now exposed by G4's concrete
+`KernelTcInv`. As proofs land, the corresponding local origin must disappear
+and the remaining transitive boundary must still match exactly.
+-/
+
+namespace Ix.Tc.Verify.Audit.Statements
+
+open Ix.Tc.Verify.Audit
+
+private def standard : Array Lean.Name :=
+  #[``propext, ``Classical.choice, ``Quot.sound]
+
+private def inductiveWF : Lean.Name := ``Lean4Lean.VInductDecl.WF
+private def addInduct : Lean.Name := ``Lean4Lean.VEnv.addInduct
+
+private def runNative : Array Lean.Name := #[
+  nativeAxiom `Blake3
+    `Blake3.HasherOps.hash._native.native_decide.ax_1,
+  nativeAxiom `Ix.Tc.Expr
+    `Ix.Tc.KExpr.mkVar._native.native_decide.ax_1,
+  nativeAxiom `Ix.Tc.Level
+    `Ix.Tc.KUniv.mkSucc._native.native_decide.ax_1,
+  nativeAxiom `Ix.Tc.Monad
+    `Ix.Tc.TcM.ctxAddrForLbr._native.native_decide.ax_5
+]
+
+private def checkConstNative : Array Lean.Name := #[
+  nativeAxiom `Blake3
+    `Blake3.HasherOps.hash._native.native_decide.ax_1,
+  nativeAxiom `Ix.Tc.Expr
+    `Ix.Tc.KExpr.mkVar._native.native_decide.ax_1,
+  nativeAxiom `Ix.Tc.Level
+    `Ix.Tc.KUniv.mkSucc._native.native_decide.ax_1,
+  nativeAxiom `Ix.Tc.Monad
+    `Ix.Tc.TcM.ctxAddrForLbr._native.native_decide.ax_5,
+  nativeAxiom `Ix.Environment
+    `Ix.Name.mkStr._native.native_decide.ax_1,
+  nativeAxiom `Ix.Tc.Inductive
+    `Ix.Tc.RecM.canonicalAuxOrder._native.native_decide.ax_17
+]
+
+private def roots : Array RootAllowance := #[
+  { root := ``Ix.Tc.TcM.whnf.wf,
+    standardAxioms := standard, nativeAxioms := runNative,
+    sorryOrigins := #[inductiveWF, addInduct, ``Ix.Tc.TcM.whnf.wf] },
+  { root := ``Ix.Tc.TcM.infer.wf,
+    standardAxioms := standard, nativeAxioms := runNative,
+    sorryOrigins := #[inductiveWF, addInduct, ``Ix.Tc.TcM.infer.wf] },
+  { root := ``Ix.Tc.TcM.isDefEq.wf,
+    standardAxioms := standard, nativeAxioms := runNative,
+    sorryOrigins := #[inductiveWF, addInduct, ``Ix.Tc.TcM.isDefEq.wf] },
+  { root := ``Ix.Tc.TcM.checkConst.wf,
+    standardAxioms := standard,
+    nativeAxioms := checkConstNative,
+    sorryOrigins := #[inductiveWF, addInduct, ``Ix.Tc.TcM.checkConst.wf] }
+]
+
+run_cmd Ix.Tc.Verify.Audit.check roots
+
+end Ix.Tc.Verify.Audit.Statements
diff --git a/Ix/Tc/Verify/Cache.lean b/Ix/Tc/Verify/Cache.lean
new file mode 100644
index 00000000..5e1bc74b
--- /dev/null
+++ b/Ix/Tc/Verify/Cache.lean
@@ -0,0 +1,993 @@
+import Ix.Tc.Verify.Decl
+import Ix.Tc.Verify.Env
+import Ix.Tc.Verify.Monad
+import Ix.Tc.Verify.Support
+import Std.Data.HashMap.Lemmas
+import Std.Data.HashSet.Lemmas
+
+/-!
+# Cache provenance and pending-declaration isolation
+
+This is the G4 boundary between an optimization hit and a semantic fact.
+`KEnv` stores only compact address keys, values, and booleans; it does not
+store the world or expression witnesses under which an entry was produced.
+The verification therefore carries that missing data as ghost provenance:
+
+* `CacheEntry` is an exhaustive tagged view of the 18 semantic cache fields
+  in `KEnv` (seven expression-result maps, two defeq maps, three negative/
+  stuck sets, unfold, is-prop, and four inductive/block families plus block
+  results);
+* `CacheAuthority` separates already-trusted declarations from an active
+  atomic block. Reduction/inference entries never receive active-block
+  authority; only the explicitly structural block cache kinds do;
+* `CacheEntry.SupportedBy` ties every address key and cached expression value
+  to the same finite `RunSupport` used by the collision-freedom hypotheses;
+* `CacheEntry.ReferencesAuthorized` records that every direct constant root
+  behind an entry is trusted (or, for a structural block artifact only, is an
+  active block member); and
+* `CacheSemantics.Valid` is the exact family of C1/K1/K2 semantic meanings.
+  G4 keeps it parametric and requires its world monotonicity. A run chooses
+  its final finite support up front; K1 and K2 instantiate and preserve the
+  contract at each concrete insertion site.
+
+The split is deliberate. This file proves generic cache-hit, world-extension,
+support-witness weakening, reset, clearing, error-restoration, and
+pending-isolation laws without pretending the still-partial
+whnf/infer/defeq implementations have already been verified.
+
+## Constant-lookup audit
+
+Every `checkConst`-reachable concrete lookup is one of these roles:
+
+1. `subject`: the initial target/member read in `Check.lean`;
+2. `blockPeer`: classification and inductive/recursor coordination reads;
+3. `semantic`: expression inference, delta unfolding, proof irrelevance,
+   projection/iota reduction, native-definition unfolding, and safety walks.
+
+Only role (1) may read a standalone pending target. Role (2) is confined to
+the active atomic block. Every reduction/delta/cache fact is role (3), so a
+pending target cannot justify its own type or value.
+
+These roles are proof-side labels: the production `TcM.getConst` API is not
+yet intrinsically capability-tagged. G4 proves the standalone raw-translation
+barrier and the stable-cache barrier. K1/K2 must still classify and discharge
+`LookupScope.Allows` at each whnf/infer/defeq/inductive call site; this audit
+does not treat an untagged concrete lookup as trusted merely because it was
+listed here.
+-/
+
+namespace Ix.Tc
+
+/-! ## Lookup authority -/
+
+/-- Why the checker is reading a constant. The role, not mere presence in the
+loaded catalog cache, determines whether the read has semantic authority. -/
+inductive ConstLookupRole where
+  | subject
+  | blockPeer
+  | semantic
+  deriving Repr, DecidableEq
+
+/-- Per-check subject scope. `targets` is the declaration/block being checked;
+`peers` is empty for a standalone and contains exactly an atomic block's
+members for a coordinated check. -/
+structure LookupScope where
+  targets : KId .anon → Prop
+  peers : KId .anon → Prop
+
+namespace LookupScope
+
+def standalone (target : KId .anon) : LookupScope where
+  targets := fun id => id = target
+  peers := fun _ => False
+
+/-- Lookup policy used by the proof. A loaded entry alone is never enough. -/
+def Allows (scope : LookupScope) (world : VerifyWorld)
+    (role : ConstLookupRole) (id : KId .anon) : Prop :=
+  match role with
+  | .subject => scope.targets id
+  | .blockPeer => scope.peers id
+  | .semantic => world.trusted id
+
+@[simp] theorem standalone_subject (target : KId .anon) :
+    (standalone target).Allows world .subject target := rfl
+
+@[simp] theorem standalone_no_peer (target id : KId .anon) :
+    ¬(standalone target).Allows world .blockPeer id := fun h => h
+
+end LookupScope
+
+/-- The pending target can be acquired as the subject, but cannot be used by
+inference, delta unfolding, definitional equality, or a semantic cache hit. -/
+theorem PendingDecl.lookup_isolation {trProj : RawProjRel}
+    {world : VerifyWorld} {target : KId .anon} {d : Lean4Lean.VDecl}
+    (h : PendingDecl trProj world target d) :
+    (LookupScope.standalone target).Allows world .subject target ∧
+      ¬(LookupScope.standalone target).Allows world .semantic target := by
+  obtain ⟨_, _, _, huntrusted, _, _⟩ := h
+  exact ⟨rfl, huntrusted⟩
+
+/-! ## Physical cache inventory -/
+
+/-- The seven `(expression address, context address) ↦ expression` maps. -/
+inductive ExprCacheKind where
+  | whnf
+  | whnfNoDelta
+  | whnfNoDeltaCheap
+  | whnfCore
+  | whnfCoreCheap
+  | infer
+  | inferOnly
+  deriving Repr, DecidableEq
+
+/-- The two general defeq result maps. The narrow negative cache has its own
+`CacheEntry.defEqFailure` tag because it stores set membership, not a Bool. -/
+inductive DefEqCacheKind where
+  | full
+  | cheap
+  deriving Repr, DecidableEq
+
+/-- A typed, exhaustive view of every semantic `KEnv` cache entry.
+
+`ctxAddrCache` and `equivManager` live on `TcState`, are per-check, and are
+handled by `TcM.reset`; the lazy-fault set is ingress bookkeeping rather than
+a semantic memo. -/
+inductive CacheEntry where
+  | expr (kind : ExprCacheKind) (key : Address × Address)
+      (value : KExpr .anon)
+  | defEq (kind : DefEqCacheKind)
+      (key : Address × Address × Address) (value : Bool)
+  | defEqFailure (key : Address × Address × Address)
+  | unfold (key : Address) (value : KExpr .anon)
+  | natSuccStuck (key : Address × Address)
+  | isProp (key : Address × Address) (value : Bool)
+  | isRec (ind : Address) (value : Bool)
+  | recursor (block : KId .anon) (value : Array (GeneratedRecursor .anon))
+  | recMajors (majors : Array (KId .anon)) (block : KId .anon)
+  | blockPeer (block : KId .anon)
+  | blockResult (block : KId .anon) (value : Except (TcError .anon) Unit)
+
+/-- Physical membership of a tagged entry in the corresponding `KEnv` field.
+There is intentionally one constructor per field/read mode. -/
+inductive KEnv.HasCacheEntry (env : KEnv .anon) : CacheEntry → Prop
+  | whnf {key value} : env.whnfCache[key]? = some value →
+      HasCacheEntry env (.expr .whnf key value)
+  | whnfNoDelta {key value} : env.whnfNoDeltaCache[key]? = some value →
+      HasCacheEntry env (.expr .whnfNoDelta key value)
+  | whnfNoDeltaCheap {key value} :
+      env.whnfNoDeltaCheapCache[key]? = some value →
+      HasCacheEntry env (.expr .whnfNoDeltaCheap key value)
+  | whnfCore {key value} : env.whnfCoreCache[key]? = some value →
+      HasCacheEntry env (.expr .whnfCore key value)
+  | whnfCoreCheap {key value} :
+      env.whnfCoreCheapCache[key]? = some value →
+      HasCacheEntry env (.expr .whnfCoreCheap key value)
+  | infer {key value} : env.inferCache[key]? = some value →
+      HasCacheEntry env (.expr .infer key value)
+  | inferOnly {key value} : env.inferOnlyCache[key]? = some value →
+      HasCacheEntry env (.expr .inferOnly key value)
+  | defEq {key value} : env.defEqCache[key]? = some value →
+      HasCacheEntry env (.defEq .full key value)
+  | defEqCheap {key value} : env.defEqCheapCache[key]? = some value →
+      HasCacheEntry env (.defEq .cheap key value)
+  | defEqFailure {key} : env.defEqFailure.contains key = true →
+      HasCacheEntry env (.defEqFailure key)
+  | unfold {key value} : env.unfoldCache[key]? = some value →
+      HasCacheEntry env (.unfold key value)
+  | natSuccStuck {key} : env.natSuccStuck.contains key = true →
+      HasCacheEntry env (.natSuccStuck key)
+  | isProp {key value} : env.isPropCache[key]? = some value →
+      HasCacheEntry env (.isProp key value)
+  | isRec {ind value} : env.isRecCache[ind]? = some value →
+      HasCacheEntry env (.isRec ind value)
+  | recursor {block value} : env.recursorCache[block]? = some value →
+      HasCacheEntry env (.recursor block value)
+  | recMajors {majors block} : env.recMajorsCache[majors]? = some block →
+      HasCacheEntry env (.recMajors majors block)
+  | blockPeer {block} : env.blockPeerAgreementCache.contains block = true →
+      HasCacheEntry env (.blockPeer block)
+  | blockResult {block value} : env.blockCheckResults[block]? = some value →
+      HasCacheEntry env (.blockResult block value)
+
+/-! ## Finite support and direct dependency provenance -/
+
+namespace RunSupport
+
+/-- An expression in the finite collision scope has this semantic address. -/
+def HasExprAddr (support : RunSupport) (addr : Address) : Prop :=
+  ∃ e, support e ∧ e.addr = addr
+
+theorem HasExprAddr.mono {small large : RunSupport} (hle : small ≤ large)
+    {addr : Address} (h : small.HasExprAddr addr) :
+    large.HasExprAddr addr := by
+  obtain ⟨e, he, rfl⟩ := h
+  exact ⟨e, hle.1 e he, rfl⟩
+
+end RunSupport
+
+namespace CacheEntry
+
+/-- Cache kinds allowed to depend on the active atomic block. No reduction,
+inference, defeq, unfold, stuck, or is-prop entry is subject-scoped. -/
+def SubjectScoped : CacheEntry → Prop
+  | .isRec .. | .recursor .. | .recMajors .. | .blockPeer .. |
+      .blockResult .. => True
+  | _ => False
+
+/-- Every expression address observed by a cache key has a source witness in
+the finite collision scope, and every cached expression value is in it too. -/
+def SupportedBy (support : RunSupport) : CacheEntry → Prop
+  | .expr _ key value => support.HasExprAddr key.1 ∧ support value
+  | .defEq _ key _ | .defEqFailure key =>
+      support.HasExprAddr key.1 ∧ support.HasExprAddr key.2.1
+  | .unfold key value => support.HasExprAddr key ∧ support value
+  | .natSuccStuck key | .isProp key _ => support.HasExprAddr key.1
+  | .recursor _ value =>
+      ∀ generated ∈ value, support generated.ty ∧
+        ∀ rule ∈ generated.rules, support rule.rhs
+  | .isRec .. | .recMajors .. | .blockPeer .. | .blockResult .. => True
+
+theorem SupportedBy.mono {small large : RunSupport} (hle : small ≤ large)
+    {entry : CacheEntry} (h : entry.SupportedBy small) :
+    entry.SupportedBy large := by
+  cases entry with
+  | expr kind key value =>
+    exact ⟨RunSupport.HasExprAddr.mono hle h.1, hle.1 value h.2⟩
+  | defEq kind key value | defEqFailure key =>
+    exact ⟨RunSupport.HasExprAddr.mono hle h.1,
+      RunSupport.HasExprAddr.mono hle h.2⟩
+  | unfold key value =>
+    exact ⟨RunSupport.HasExprAddr.mono hle h.1, hle.1 value h.2⟩
+  | natSuccStuck key | isProp key value =>
+    exact RunSupport.HasExprAddr.mono hle h
+  | recursor block value =>
+    intro generated hgenerated
+    have hg := h generated hgenerated
+    exact ⟨hle.1 generated.ty hg.1,
+      fun rule hrule => hle.1 rule.rhs (hg.2 rule hrule)⟩
+  | isRec | recMajors | blockPeer | blockResult => trivial
+
+/-- A source expression under an address key directly references `id`. The
+existential source is ghost provenance lost by the concrete address-only map. -/
+def SourceReferences (support : RunSupport) (addr : Address)
+    (id : KId .anon) : Prop :=
+  ∃ e, support e ∧ e.addr = addr ∧ e.References id
+
+theorem SourceReferences.mono {small large : RunSupport}
+    (hle : small ≤ large) {addr : Address} {id : KId .anon}
+    (h : SourceReferences small addr id) :
+    SourceReferences large addr id := by
+  obtain ⟨e, he, ha, href⟩ := h
+  exact ⟨e, hle.1 e he, ha, href⟩
+
+/-- Direct constant roots on which an entry can depend. Trusted constants'
+own bodies are justified by their trusted-world provenance, so this records
+roots rather than an unbounded syntactic transitive closure. -/
+def References (support : RunSupport) : CacheEntry → KId .anon → Prop
+  | .expr _ key value, id =>
+      SourceReferences support key.1 id ∨ value.References id
+  | .defEq _ key _, id | .defEqFailure key, id =>
+      SourceReferences support key.1 id ∨
+        SourceReferences support key.2.1 id
+  | .unfold key value, id =>
+      SourceReferences support key id ∨ value.References id
+  | .natSuccStuck key, id | .isProp key _, id =>
+      SourceReferences support key.1 id
+  | .isRec ind _, id => id.addr = ind
+  | .recursor block generated, id =>
+      id = block ∨ ∃ g ∈ generated,
+        id.addr = g.indAddr ∨ g.ty.References id ∨
+          ∃ rule ∈ g.rules, rule.rhs.References id
+  | .recMajors majors block, id => id ∈ majors ∨ id = block
+  | .blockPeer block, id => id = block
+  | .blockResult block (.ok ()), id => id = block
+  | .blockResult _ (.error _), _ => False
+
+theorem References.mono {small large : RunSupport} (hle : small ≤ large)
+    {entry : CacheEntry} {id : KId .anon} (h : entry.References small id) :
+    entry.References large id := by
+  cases entry with
+  | expr kind key value =>
+    exact h.elim (fun h => .inl (SourceReferences.mono hle h)) .inr
+  | defEq kind key value | defEqFailure key =>
+    exact h.elim (fun h => .inl (SourceReferences.mono hle h))
+      (fun h => .inr (SourceReferences.mono hle h))
+  | unfold key value =>
+    exact h.elim (fun h => .inl (SourceReferences.mono hle h)) .inr
+  | natSuccStuck key | isProp key value =>
+    exact SourceReferences.mono hle h
+  | isRec | recursor | recMajors | blockPeer => exact h
+  | blockResult block value =>
+    cases value with
+    | ok => exact h
+    | error => exact False.elim h
+
+end CacheEntry
+
+/-! ## World/active-block authority and semantic contracts -/
+
+/-- Semantic authority under which cache entries are being used. `active` is
+proof-only and is empty at stable top-level boundaries. -/
+structure CacheAuthority where
+  world : VerifyWorld
+  active : KId .anon → Prop
+
+namespace CacheAuthority
+
+def stable (world : VerifyWorld) : CacheAuthority :=
+  ⟨world, fun _ => False⟩
+
+protected structure LE (before after : CacheAuthority) : Prop where
+  world : before.world ≤ after.world
+  authorized : ∀ {id},
+    before.world.trusted id ∨ before.active id →
+      after.world.trusted id ∨ after.active id
+
+instance : LE CacheAuthority := ⟨CacheAuthority.LE⟩
+
+namespace LE
+
+theorem rfl {authority : CacheAuthority} : authority ≤ authority :=
+  ⟨VerifyWorld.LE.rfl, fun h => h⟩
+
+theorem trans {a b c : CacheAuthority} (hab : a ≤ b) (hbc : b ≤ c) :
+    a ≤ c :=
+  ⟨hab.world.trans hbc.world, fun h => hbc.authorized (hab.authorized h)⟩
+
+end LE
+
+theorem stable_mono {before after : VerifyWorld} (hle : before ≤ after) :
+    stable before ≤ stable after := by
+  refine ⟨hle, ?_⟩
+  rintro id (h | h)
+  · exact .inl (hle.trusted h)
+  · exact False.elim h
+
+end CacheAuthority
+
+/-- All direct roots of an entry have the authority appropriate to its kind.
+Active-block authority is unavailable to every reduction/inference kind. -/
+def CacheEntry.ReferencesAuthorized (authority : CacheAuthority)
+    (support : RunSupport) (entry : CacheEntry) : Prop :=
+  ∀ ⦃id⦄, entry.References support id →
+    authority.world.trusted id ∨
+      (entry.SubjectScoped ∧ authority.active id)
+
+/-- The semantic meaning of each tagged cache family. K1/K2 provide the
+concrete `Valid`; G4 requires world monotonicity so a warm entry remains
+usable after declarations are admitted. A composite run chooses its final
+finite support up front, so changing support is deliberately not hidden in
+this interface. -/
+structure CacheSemantics where
+  Valid : CacheAuthority → RunSupport → CacheEntry → Prop
+  mono : ∀ {before after : CacheAuthority} {support : RunSupport}
+    {entry : CacheEntry}, before ≤ after →
+      Valid before support entry → Valid after support entry
+  blockError : ∀ (authority : CacheAuthority) (support : RunSupport)
+    (block : KId .anon) (err : TcError .anon),
+      Valid authority support (.blockResult block (.error err))
+
+/-- Full ghost certificate attached to one physical entry. -/
+structure CacheProvenance (semantics : CacheSemantics)
+    (authority : CacheAuthority) (support : RunSupport)
+    (entry : CacheEntry) : Prop where
+  supported : entry.SupportedBy support
+  references : entry.ReferencesAuthorized authority support
+  valid : semantics.Valid authority support entry
+
+namespace CacheProvenance
+
+/-- Cached failures carry no acceptance claim, have no expression support or
+constant dependencies, and are valid under every cache contract. -/
+theorem blockError (semantics : CacheSemantics) (authority : CacheAuthority)
+    (support : RunSupport) (block : KId .anon) (err : TcError .anon) :
+    CacheProvenance semantics authority support
+      (.blockResult block (.error err)) := by
+  refine ⟨trivial, ?_, semantics.blockError authority support block err⟩
+  intro id href
+  exact False.elim href
+
+theorem mono {semantics : CacheSemantics}
+    {before after : CacheAuthority} {support : RunSupport}
+    {entry : CacheEntry} (hauth : before ≤ after)
+    (h : CacheProvenance semantics before support entry) :
+    CacheProvenance semantics after support entry := by
+  refine ⟨h.supported, ?_, semantics.mono hauth h.valid⟩
+  intro id href
+  have hold := h.references href
+  rcases hold with htrusted | ⟨hsubject, hactive⟩
+  · exact .inl (hauth.world.trusted htrusted)
+  · exact (hauth.authorized (.inr hactive)).elim .inl
+      (fun h => .inr ⟨hsubject, h⟩)
+
+/-- A semantic (non-block-scoped) cache entry cannot depend directly on a
+pending target. This is the cache-hit half of the self-unfolding barrier. -/
+theorem pending_isolation {semantics : CacheSemantics}
+    {authority : CacheAuthority} {support : RunSupport} {entry : CacheEntry}
+    {trProj : RawProjRel} {target : KId .anon} {d : Lean4Lean.VDecl}
+    (hpending : PendingDecl trProj authority.world target d)
+    (hentry : ¬entry.SubjectScoped)
+    (h : CacheProvenance semantics authority support entry) :
+    ¬entry.References support target := by
+  obtain ⟨_, _, _, huntrusted, _, _⟩ := hpending
+  intro href
+  rcases h.references href with htrusted | hactive
+  · exact huntrusted htrusted
+  · exact hentry hactive.1
+
+/-- At a stable boundary even structural block entries cannot name a pending
+target: there is no active-block authority left. -/
+theorem pending_isolation_stable {semantics : CacheSemantics}
+    {authority : CacheAuthority} {support : RunSupport} {entry : CacheEntry}
+    {trProj : RawProjRel} {target : KId .anon} {d : Lean4Lean.VDecl}
+    (hstable : ∀ id, ¬authority.active id)
+    (hpending : PendingDecl trProj authority.world target d)
+    (h : CacheProvenance semantics authority support entry) :
+    ¬entry.References support target := by
+  obtain ⟨_, _, _, huntrusted, _, _⟩ := hpending
+  intro href
+  rcases h.references href with htrusted | hactive
+  · exact huntrusted htrusted
+  · exact hstable target hactive.2
+
+end CacheProvenance
+
+namespace KEnv
+
+/-- Every block verdict surviving error restoration is either the exact old
+verdict or an error. In particular, a failed check cannot synthesize a new
+cached success or replace an old verdict. -/
+theorem restoreBlockCheckResultsOnError_origin
+    (before after : Std.HashMap (KId .anon)
+      (Except (TcError .anon) Unit))
+    {block : KId .anon} {result : Except (TcError .anon) Unit}
+    (h : (restoreBlockCheckResultsOnError before after)[block]? =
+      some result) :
+    before[block]? = some result ∨
+      ∃ err, result = .error err := by
+  let step := fun
+      (results : Std.HashMap (KId .anon) (Except (TcError .anon) Unit))
+      (item : KId .anon × Except (TcError .anon) Unit) =>
+    restoreBlockCheckResultOnError before results item.1 item.2
+  rw [restoreBlockCheckResultsOnError,
+    Std.HashMap.fold_eq_foldl_toList] at h
+  have hstep :
+      (List.foldl step before after.toList)[block]? = some result := by
+    simpa only [step] using h
+  have hinv : ∀ (results :
+      Std.HashMap (KId .anon) (Except (TcError .anon) Unit)),
+      (∀ {key : KId .anon} {value : Except (TcError .anon) Unit},
+        results[key]? = some value →
+          before[key]? = some value ∨
+            ∃ err : TcError .anon, value = Except.error err) →
+      ∀ {item : KId .anon × Except (TcError .anon) Unit},
+        item ∈ after.toList →
+        ∀ {key : KId .anon} {value : Except (TcError .anon) Unit},
+          (step results item)[key]? = some value →
+            before[key]? = some value ∨
+              ∃ err : TcError .anon, value = Except.error err := by
+    intro results ih item _ key value hget
+    rcases item with ⟨newKey, newValue⟩
+    cases newValue with
+    | ok okValue =>
+      cases okValue
+      exact ih hget
+    | error err =>
+      dsimp [step, restoreBlockCheckResultOnError] at hget
+      split at hget
+      · exact ih hget
+      · rw [Std.HashMap.getElem?_insert] at hget
+        split at hget
+        · cases hget
+          exact .inr ⟨err, rfl⟩
+        · exact ih hget
+  have hall : ∀ {key : KId .anon}
+      {value : Except (TcError .anon) Unit},
+      (List.foldl step before after.toList)[key]? = some value →
+        before[key]? = some value ∨
+          ∃ err : TcError .anon, value = Except.error err := by
+    apply List.foldlRecOn (motive := fun results =>
+      ∀ {key : KId .anon} {value : Except (TcError .anon) Unit},
+        results[key]? = some value →
+          before[key]? = some value ∨
+            ∃ err : TcError .anon, value = Except.error err)
+      after.toList step
+    · intro key value hget
+      exact .inl hget
+    · exact hinv
+  exact hall hstep
+
+end KEnv
+
+/-- Every physical cache entry has finite-support, dependency, and semantic
+provenance. -/
+def CacheInvariant (semantics : CacheSemantics)
+    (authority : CacheAuthority) (support : RunSupport)
+    (env : KEnv .anon) : Prop :=
+  ∀ ⦃entry⦄, env.HasCacheEntry entry →
+    CacheProvenance semantics authority support entry
+
+namespace CacheInvariant
+
+/-- A concrete hit exposes its recorded semantic provenance. -/
+theorem hit {semantics : CacheSemantics} {authority : CacheAuthority}
+    {support : RunSupport} {env : KEnv .anon} {entry : CacheEntry}
+    (h : CacheInvariant semantics authority support env)
+    (hhit : env.HasCacheEntry entry) :
+    CacheProvenance semantics authority support entry :=
+  h hhit
+
+/-- Warm entries transport when the trusted world grows. -/
+theorem mono {semantics : CacheSemantics}
+    {before after : CacheAuthority} {support : RunSupport}
+    {env : KEnv .anon} (hauth : before ≤ after)
+    (h : CacheInvariant semantics before support env) :
+    CacheInvariant semantics after support env := by
+  intro entry hentry
+  exact (h hentry).mono hauth
+
+/-- A fresh kernel environment satisfies every semantic cache contract. -/
+theorem empty (semantics : CacheSemantics) (authority : CacheAuthority)
+    (support : RunSupport) :
+    CacheInvariant semantics authority support ({} : KEnv .anon) := by
+  intro entry h
+  cases h <;> simp_all
+
+/-- Extensional fresh-cache constructor for an environment that may already
+contain constants, blocks, and interned nodes. -/
+theorem of_no_entries {semantics : CacheSemantics}
+    {authority : CacheAuthority} {support : RunSupport} {env : KEnv .anon}
+    (h : ∀ entry, ¬env.HasCacheEntry entry) :
+    CacheInvariant semantics authority support env := by
+  intro entry hentry
+  exact False.elim (h entry hentry)
+
+/-- Generic cache-update rule. Concrete insertion proofs need only show that
+each post-entry is either the newly certified entry or an old hit. -/
+theorem update {semantics : CacheSemantics}
+    {authority : CacheAuthority} {support : RunSupport}
+    {before after : KEnv .anon} {newEntry : CacheEntry}
+    (hbefore : CacheInvariant semantics authority support before)
+    (hnew : CacheProvenance semantics authority support newEntry)
+    (hentries : ∀ ⦃entry⦄, after.HasCacheEntry entry →
+      entry = newEntry ∨ before.HasCacheEntry entry) :
+    CacheInvariant semantics authority support after := by
+  intro entry hentry
+  rcases hentries hentry with rfl | hold
+  · exact hnew
+  · exact hbefore hold
+
+/-- Insert one certified full-whnf result while retaining provenance for all
+old entries.  The four policy-specific siblings below cover every other K1
+WHNF expression map; their exact semantic payload is supplied by
+`Verify/Whnf.lean`. -/
+theorem insertWhnf {semantics : CacheSemantics}
+    {authority : CacheAuthority} {support : RunSupport}
+    {env : KEnv .anon} {key : Address × Address} {value : KExpr .anon}
+    (hbefore : CacheInvariant semantics authority support env)
+    (hnew : CacheProvenance semantics authority support
+      (.expr .whnf key value)) :
+    CacheInvariant semantics authority support
+      { env with whnfCache := env.whnfCache.insert key value } := by
+  apply update hbefore hnew
+  intro entry hentry
+  cases hentry with
+  | @whnf foundKey foundValue hget =>
+    rw [Std.HashMap.getElem?_insert] at hget
+    split at hget
+    · next heq =>
+      cases hget
+      have hkey : key = foundKey := eq_of_beq heq
+      subst foundKey
+      exact .inl rfl
+    · exact .inr (.whnf hget)
+  | whnfNoDelta hget => exact .inr (.whnfNoDelta hget)
+  | whnfNoDeltaCheap hget => exact .inr (.whnfNoDeltaCheap hget)
+  | whnfCore hget => exact .inr (.whnfCore hget)
+  | whnfCoreCheap hget => exact .inr (.whnfCoreCheap hget)
+  | infer hget => exact .inr (.infer hget)
+  | inferOnly hget => exact .inr (.inferOnly hget)
+  | defEq hget => exact .inr (.defEq hget)
+  | defEqCheap hget => exact .inr (.defEqCheap hget)
+  | defEqFailure hmem => exact .inr (.defEqFailure hmem)
+  | unfold hget => exact .inr (.unfold hget)
+  | natSuccStuck hmem => exact .inr (.natSuccStuck hmem)
+  | isProp hget => exact .inr (.isProp hget)
+  | isRec hget => exact .inr (.isRec hget)
+  | recursor hget => exact .inr (.recursor hget)
+  | recMajors hget => exact .inr (.recMajors hget)
+  | blockPeer hmem => exact .inr (.blockPeer hmem)
+  | blockResult hget => exact .inr (.blockResult hget)
+
+/-- Insert one certified full-policy no-delta result. -/
+theorem insertWhnfNoDelta {semantics : CacheSemantics}
+    {authority : CacheAuthority} {support : RunSupport}
+    {env : KEnv .anon} {key : Address × Address} {value : KExpr .anon}
+    (hbefore : CacheInvariant semantics authority support env)
+    (hnew : CacheProvenance semantics authority support
+      (.expr .whnfNoDelta key value)) :
+    CacheInvariant semantics authority support
+      { env with
+        whnfNoDeltaCache := env.whnfNoDeltaCache.insert key value } := by
+  apply update hbefore hnew
+  intro entry hentry
+  cases hentry with
+  | whnf hget => exact .inr (.whnf hget)
+  | @whnfNoDelta foundKey foundValue hget =>
+    rw [Std.HashMap.getElem?_insert] at hget
+    split at hget
+    · next heq =>
+      cases hget
+      have hkey : key = foundKey := eq_of_beq heq
+      subst foundKey
+      exact .inl rfl
+    · exact .inr (.whnfNoDelta hget)
+  | whnfNoDeltaCheap hget => exact .inr (.whnfNoDeltaCheap hget)
+  | whnfCore hget => exact .inr (.whnfCore hget)
+  | whnfCoreCheap hget => exact .inr (.whnfCoreCheap hget)
+  | infer hget => exact .inr (.infer hget)
+  | inferOnly hget => exact .inr (.inferOnly hget)
+  | defEq hget => exact .inr (.defEq hget)
+  | defEqCheap hget => exact .inr (.defEqCheap hget)
+  | defEqFailure hmem => exact .inr (.defEqFailure hmem)
+  | unfold hget => exact .inr (.unfold hget)
+  | natSuccStuck hmem => exact .inr (.natSuccStuck hmem)
+  | isProp hget => exact .inr (.isProp hget)
+  | isRec hget => exact .inr (.isRec hget)
+  | recursor hget => exact .inr (.recursor hget)
+  | recMajors hget => exact .inr (.recMajors hget)
+  | blockPeer hmem => exact .inr (.blockPeer hmem)
+  | blockResult hget => exact .inr (.blockResult hget)
+
+/-- Insert one certified cheap-policy no-delta result.  Its tag is distinct
+from the full-policy map, preventing a cheap result from being consumed as a
+full result. -/
+theorem insertWhnfNoDeltaCheap {semantics : CacheSemantics}
+    {authority : CacheAuthority} {support : RunSupport}
+    {env : KEnv .anon} {key : Address × Address} {value : KExpr .anon}
+    (hbefore : CacheInvariant semantics authority support env)
+    (hnew : CacheProvenance semantics authority support
+      (.expr .whnfNoDeltaCheap key value)) :
+    CacheInvariant semantics authority support
+      { env with
+        whnfNoDeltaCheapCache :=
+          env.whnfNoDeltaCheapCache.insert key value } := by
+  apply update hbefore hnew
+  intro entry hentry
+  cases hentry with
+  | whnf hget => exact .inr (.whnf hget)
+  | whnfNoDelta hget => exact .inr (.whnfNoDelta hget)
+  | @whnfNoDeltaCheap foundKey foundValue hget =>
+    rw [Std.HashMap.getElem?_insert] at hget
+    split at hget
+    · next heq =>
+      cases hget
+      have hkey : key = foundKey := eq_of_beq heq
+      subst foundKey
+      exact .inl rfl
+    · exact .inr (.whnfNoDeltaCheap hget)
+  | whnfCore hget => exact .inr (.whnfCore hget)
+  | whnfCoreCheap hget => exact .inr (.whnfCoreCheap hget)
+  | infer hget => exact .inr (.infer hget)
+  | inferOnly hget => exact .inr (.inferOnly hget)
+  | defEq hget => exact .inr (.defEq hget)
+  | defEqCheap hget => exact .inr (.defEqCheap hget)
+  | defEqFailure hmem => exact .inr (.defEqFailure hmem)
+  | unfold hget => exact .inr (.unfold hget)
+  | natSuccStuck hmem => exact .inr (.natSuccStuck hmem)
+  | isProp hget => exact .inr (.isProp hget)
+  | isRec hget => exact .inr (.isRec hget)
+  | recursor hget => exact .inr (.recursor hget)
+  | recMajors hget => exact .inr (.recMajors hget)
+  | blockPeer hmem => exact .inr (.blockPeer hmem)
+  | blockResult hget => exact .inr (.blockResult hget)
+
+/-- Insert one certified full structural-WHNF result. -/
+theorem insertWhnfCore {semantics : CacheSemantics}
+    {authority : CacheAuthority} {support : RunSupport}
+    {env : KEnv .anon} {key : Address × Address} {value : KExpr .anon}
+    (hbefore : CacheInvariant semantics authority support env)
+    (hnew : CacheProvenance semantics authority support
+      (.expr .whnfCore key value)) :
+    CacheInvariant semantics authority support
+      { env with whnfCoreCache := env.whnfCoreCache.insert key value } := by
+  apply update hbefore hnew
+  intro entry hentry
+  cases hentry with
+  | whnf hget => exact .inr (.whnf hget)
+  | whnfNoDelta hget => exact .inr (.whnfNoDelta hget)
+  | whnfNoDeltaCheap hget => exact .inr (.whnfNoDeltaCheap hget)
+  | @whnfCore foundKey foundValue hget =>
+    rw [Std.HashMap.getElem?_insert] at hget
+    split at hget
+    · next heq =>
+      cases hget
+      have hkey : key = foundKey := eq_of_beq heq
+      subst foundKey
+      exact .inl rfl
+    · exact .inr (.whnfCore hget)
+  | whnfCoreCheap hget => exact .inr (.whnfCoreCheap hget)
+  | infer hget => exact .inr (.infer hget)
+  | inferOnly hget => exact .inr (.inferOnly hget)
+  | defEq hget => exact .inr (.defEq hget)
+  | defEqCheap hget => exact .inr (.defEqCheap hget)
+  | defEqFailure hmem => exact .inr (.defEqFailure hmem)
+  | unfold hget => exact .inr (.unfold hget)
+  | natSuccStuck hmem => exact .inr (.natSuccStuck hmem)
+  | isProp hget => exact .inr (.isProp hget)
+  | isRec hget => exact .inr (.isRec hget)
+  | recursor hget => exact .inr (.recursor hget)
+  | recMajors hget => exact .inr (.recMajors hget)
+  | blockPeer hmem => exact .inr (.blockPeer hmem)
+  | blockResult hget => exact .inr (.blockResult hget)
+
+/-- Insert one certified cheap structural-WHNF result. -/
+theorem insertWhnfCoreCheap {semantics : CacheSemantics}
+    {authority : CacheAuthority} {support : RunSupport}
+    {env : KEnv .anon} {key : Address × Address} {value : KExpr .anon}
+    (hbefore : CacheInvariant semantics authority support env)
+    (hnew : CacheProvenance semantics authority support
+      (.expr .whnfCoreCheap key value)) :
+    CacheInvariant semantics authority support
+      { env with
+        whnfCoreCheapCache := env.whnfCoreCheapCache.insert key value } := by
+  apply update hbefore hnew
+  intro entry hentry
+  cases hentry with
+  | whnf hget => exact .inr (.whnf hget)
+  | whnfNoDelta hget => exact .inr (.whnfNoDelta hget)
+  | whnfNoDeltaCheap hget => exact .inr (.whnfNoDeltaCheap hget)
+  | whnfCore hget => exact .inr (.whnfCore hget)
+  | @whnfCoreCheap foundKey foundValue hget =>
+    rw [Std.HashMap.getElem?_insert] at hget
+    split at hget
+    · next heq =>
+      cases hget
+      have hkey : key = foundKey := eq_of_beq heq
+      subst foundKey
+      exact .inl rfl
+    · exact .inr (.whnfCoreCheap hget)
+  | infer hget => exact .inr (.infer hget)
+  | inferOnly hget => exact .inr (.inferOnly hget)
+  | defEq hget => exact .inr (.defEq hget)
+  | defEqCheap hget => exact .inr (.defEqCheap hget)
+  | defEqFailure hmem => exact .inr (.defEqFailure hmem)
+  | unfold hget => exact .inr (.unfold hget)
+  | natSuccStuck hmem => exact .inr (.natSuccStuck hmem)
+  | isProp hget => exact .inr (.isProp hget)
+  | isRec hget => exact .inr (.isRec hget)
+  | recursor hget => exact .inr (.recursor hget)
+  | recMajors hget => exact .inr (.recMajors hget)
+  | blockPeer hmem => exact .inr (.blockPeer hmem)
+  | blockResult hget => exact .inr (.blockResult hget)
+
+/-- Exact environment equality preserves all cache provenance. -/
+theorem of_env_eq {semantics : CacheSemantics}
+    {authority : CacheAuthority} {support : RunSupport}
+    {before after : KEnv .anon} (h : CacheInvariant semantics authority support before)
+    (heq : after = before) : CacheInvariant semantics authority support after :=
+  heq ▸ h
+
+/-- Intern-table growth does not touch any semantic cache field. -/
+theorem of_intern_update {semantics : CacheSemantics}
+    {authority : CacheAuthority} {support : RunSupport}
+    {env : KEnv .anon} {intern : InternTable .anon}
+    (h : CacheInvariant semantics authority support env) :
+    CacheInvariant semantics authority support { env with intern } := by
+  intro entry hentry
+  apply h
+  cases hentry with
+  | whnf hget => exact .whnf hget
+  | whnfNoDelta hget => exact .whnfNoDelta hget
+  | whnfNoDeltaCheap hget => exact .whnfNoDeltaCheap hget
+  | whnfCore hget => exact .whnfCore hget
+  | whnfCoreCheap hget => exact .whnfCoreCheap hget
+  | infer hget => exact .infer hget
+  | inferOnly hget => exact .inferOnly hget
+  | defEq hget => exact .defEq hget
+  | defEqCheap hget => exact .defEqCheap hget
+  | defEqFailure hmem => exact .defEqFailure hmem
+  | unfold hget => exact .unfold hget
+  | natSuccStuck hmem => exact .natSuccStuck hmem
+  | isProp hget => exact .isProp hget
+  | isRec hget => exact .isRec hget
+  | recursor hget => exact .recursor hget
+  | recMajors hget => exact .recMajors hget
+  | blockPeer hmem => exact .blockPeer hmem
+  | blockResult hget => exact .blockResult hget
+
+/-- Periodic reduction-cache clearing removes entries and cannot invalidate
+the retained structural/block entries. -/
+theorem clearReductionCaches {semantics : CacheSemantics}
+    {authority : CacheAuthority} {support : RunSupport} {env : KEnv .anon}
+    (h : CacheInvariant semantics authority support env) :
+    CacheInvariant semantics authority support env.clearReductionCaches := by
+  intro entry hentry
+  cases hentry with
+  | @whnf key value hget =>
+    change ({} : Std.HashMap (Address × Address) (KExpr .anon))[key]? = _ at hget
+    simp at hget
+  | @whnfNoDelta key value hget =>
+    change ({} : Std.HashMap (Address × Address) (KExpr .anon))[key]? = _ at hget
+    simp at hget
+  | @whnfNoDeltaCheap key value hget =>
+    change ({} : Std.HashMap (Address × Address) (KExpr .anon))[key]? = _ at hget
+    simp at hget
+  | @whnfCore key value hget =>
+    change ({} : Std.HashMap (Address × Address) (KExpr .anon))[key]? = _ at hget
+    simp at hget
+  | @whnfCoreCheap key value hget =>
+    change ({} : Std.HashMap (Address × Address) (KExpr .anon))[key]? = _ at hget
+    simp at hget
+  | @infer key value hget =>
+    change ({} : Std.HashMap (Address × Address) (KExpr .anon))[key]? = _ at hget
+    simp at hget
+  | @inferOnly key value hget =>
+    change ({} : Std.HashMap (Address × Address) (KExpr .anon))[key]? = _ at hget
+    simp at hget
+  | @defEq key value hget =>
+    change ({} : Std.HashMap (Address × Address × Address) Bool)[key]? = _ at hget
+    simp at hget
+  | @defEqCheap key value hget =>
+    change ({} : Std.HashMap (Address × Address × Address) Bool)[key]? = _ at hget
+    simp at hget
+  | @defEqFailure key hmem =>
+    change ({} : Std.HashSet (Address × Address × Address)).contains key = true at hmem
+    simp at hmem
+  | @unfold key value hget =>
+    change ({} : Std.HashMap Address (KExpr .anon))[key]? = _ at hget
+    simp at hget
+  | @natSuccStuck key hmem =>
+    change ({} : Std.HashSet (Address × Address)).contains key = true at hmem
+    simp at hmem
+  | @isProp key value hget =>
+    change ({} : Std.HashMap (Address × Address) Bool)[key]? = _ at hget
+    simp at hget
+  | isRec hget => exact h (.isRec hget)
+  | recursor hget => exact h (.recursor hget)
+  | recMajors hget => exact h (.recMajors hget)
+  | blockPeer hmem => exact h (.blockPeer hmem)
+  | blockResult hget => exact h (.blockResult hget)
+
+/-- Error restoration preserves the complete cache invariant without any
+assumption about cache entries created by the failed run. All semantic and
+subject-scoped entries revert to `before`; the only new retained entries are
+cached errors, whose contract and dependency set are unconditional. -/
+theorem restoreCheckCachesOnError {semantics : CacheSemantics}
+    {authority : CacheAuthority} {support : RunSupport}
+    {before after : KEnv .anon}
+    (hbefore : CacheInvariant semantics authority support before) :
+    CacheInvariant semantics authority support
+      (before.restoreCheckCachesOnError after) := by
+  intro entry hentry
+  cases hentry with
+  | whnf hget =>
+    exact hbefore (.whnf (by
+      simpa [KEnv.restoreCheckCachesOnError] using hget))
+  | whnfNoDelta hget =>
+    exact hbefore (.whnfNoDelta (by
+      simpa [KEnv.restoreCheckCachesOnError] using hget))
+  | whnfNoDeltaCheap hget =>
+    exact hbefore (.whnfNoDeltaCheap (by
+      simpa [KEnv.restoreCheckCachesOnError] using hget))
+  | whnfCore hget =>
+    exact hbefore (.whnfCore (by
+      simpa [KEnv.restoreCheckCachesOnError] using hget))
+  | whnfCoreCheap hget =>
+    exact hbefore (.whnfCoreCheap (by
+      simpa [KEnv.restoreCheckCachesOnError] using hget))
+  | infer hget =>
+    exact hbefore (.infer (by
+      simpa [KEnv.restoreCheckCachesOnError] using hget))
+  | inferOnly hget =>
+    exact hbefore (.inferOnly (by
+      simpa [KEnv.restoreCheckCachesOnError] using hget))
+  | defEq hget =>
+    exact hbefore (.defEq (by
+      simpa [KEnv.restoreCheckCachesOnError] using hget))
+  | defEqCheap hget =>
+    exact hbefore (.defEqCheap (by
+      simpa [KEnv.restoreCheckCachesOnError] using hget))
+  | defEqFailure hmem =>
+    exact hbefore (.defEqFailure (by
+      simpa [KEnv.restoreCheckCachesOnError] using hmem))
+  | unfold hget =>
+    exact hbefore (.unfold (by
+      simpa [KEnv.restoreCheckCachesOnError] using hget))
+  | natSuccStuck hmem =>
+    exact hbefore (.natSuccStuck (by
+      simpa [KEnv.restoreCheckCachesOnError] using hmem))
+  | isProp hget =>
+    exact hbefore (.isProp (by
+      simpa [KEnv.restoreCheckCachesOnError] using hget))
+  | isRec hget =>
+    exact hbefore (.isRec (by
+      simpa [KEnv.restoreCheckCachesOnError] using hget))
+  | recursor hget =>
+    exact hbefore (.recursor (by
+      simpa [KEnv.restoreCheckCachesOnError] using hget))
+  | recMajors hget =>
+    exact hbefore (.recMajors (by
+      simpa [KEnv.restoreCheckCachesOnError] using hget))
+  | blockPeer hmem =>
+    exact hbefore (.blockPeer (by
+      simpa [KEnv.restoreCheckCachesOnError] using hmem))
+  | @blockResult block value hget =>
+    change (KEnv.restoreBlockCheckResultsOnError
+      before.blockCheckResults after.blockCheckResults)[block]? =
+        some value at hget
+    rcases KEnv.restoreBlockCheckResultsOnError_origin _ _ hget with
+      hold | ⟨err, rfl⟩
+    · exact hbefore (.blockResult hold)
+    · exact CacheProvenance.blockError semantics authority support block err
+
+end CacheInvariant
+
+/-! ## Concrete error/reset equations -/
+
+namespace KEnv
+
+@[simp] theorem restoreCheckCachesOnError_whnfCache
+    (before after : KEnv m) :
+    (restoreCheckCachesOnError before after).whnfCache = before.whnfCache := rfl
+
+@[simp] theorem restoreCheckCachesOnError_inferCache
+    (before after : KEnv m) :
+    (restoreCheckCachesOnError before after).inferCache = before.inferCache := rfl
+
+@[simp] theorem restoreCheckCachesOnError_defEqCache
+    (before after : KEnv m) :
+    (restoreCheckCachesOnError before after).defEqCache = before.defEqCache := rfl
+
+@[simp] theorem restoreCheckCachesOnError_unfoldCache
+    (before after : KEnv m) :
+    (restoreCheckCachesOnError before after).unfoldCache = before.unfoldCache := rfl
+
+@[simp] theorem restoreCheckCachesOnError_isRecCache
+    (before after : KEnv m) :
+    (restoreCheckCachesOnError before after).isRecCache = before.isRecCache := rfl
+
+@[simp] theorem restoreCheckCachesOnError_recursorCache
+    (before after : KEnv m) :
+    (restoreCheckCachesOnError before after).recursorCache =
+      before.recursorCache := rfl
+
+/-- Cache rollback never rolls back loaded constants. -/
+@[simp] theorem restoreCheckCachesOnError_consts
+    (before after : KEnv m) :
+    (restoreCheckCachesOnError before after).consts = after.consts := rfl
+
+/-- Cache rollback never rolls back the intern table. -/
+@[simp] theorem restoreCheckCachesOnError_intern
+    (before after : KEnv m) :
+    (restoreCheckCachesOnError before after).intern = after.intern := rfl
+
+end KEnv
+
+namespace TcM
+
+theorem isolateCheckErrors_ok {x : TcM m α} {s s' : TcState m} {a : α}
+    (h : x s = .ok a s') :
+    isolateCheckErrors x s = .ok a s' := by
+  simp [isolateCheckErrors, h]
+
+theorem isolateCheckErrors_error {x : TcM m α} {s s' : TcState m}
+    {err : TcError m} (h : x s = .error err s') :
+    isolateCheckErrors x s =
+      .error err (s.restoreCheckCachesOnError s') := by
+  simp [isolateCheckErrors, h]
+
+/-- `reset` leaves all environment-level warm caches untouched, while clearing
+the two per-check memo structures. -/
+theorem reset_cache_frame (s : TcState m) :
+    match TcM.reset s with
+    | .ok () s' => s'.env = s.env ∧ s'.equivManager = {} ∧
+        s'.ctxAddrCache = {}
+    | .error _ _ => False := by
+  change s.env = s.env ∧ ({} : EquivManager) = {} ∧
+    ({} : Std.HashMap (Address × UInt64) Address) = {}
+  exact ⟨rfl, rfl, rfl⟩
+
+end TcM
+
+end Ix.Tc
diff --git a/Ix/Tc/Verify/Ctx.lean b/Ix/Tc/Verify/Ctx.lean
index 579743a8..27140975 100644
--- a/Ix/Tc/Verify/Ctx.lean
+++ b/Ix/Tc/Verify/Ctx.lean
@@ -39,9 +39,10 @@ equations) so they are robust to record-update spelling; the pop
 lemmas require the Δ-head to be the popped `(none, d)` entry — Δ is
 per-call ghost data, so the soundness layers always know the head form at a
 pop site (popping under live newer fvars would be a scoping bug and is
-deliberately unrepresentable). `truncate`/`restoreDepth` step lemmas
-are deferred with the Tier-B rewrites (both are `while`-loops —
-partial `Loop.forIn`, opaque to the logic).
+deliberately unrepresentable). K0 has replaced the `truncate` and
+`restoreDepth` `while` loops with explicit Nat recursion; their exact
+production equations live in `Verify/Totalization`. Preservation lemmas for
+`CtxRecon` over more than one pop remain part of the checker-soundness layer.
 -/
 
 namespace Ix.Tc
@@ -715,6 +716,40 @@ theorem lctxFind? {fv : FVarId} {d : LocalDecl .anon}
     exact hd
   exact h.recon.fvar_frame h.fvars_nodup hj
 
+/-- A let-valued fvar lookup yields a translation of the concrete stored
+    value at the current mixed context, provided that value is closed with
+    respect to the legacy de Bruijn stack.  This premise is operationally
+    significant: production fvar zeta returns `val` unchanged, while a
+    stale value with loose bvars would instead need the `dn` lift exposed by
+    `lctxFind?`. -/
+theorem lctxFindLetVal {fv : FVarId} {nm : Mode.anon.F Name}
+    {ty val : KExpr .anon}
+    (h : CtxRecon env uvars nameOf trProj s Δ)
+    (henv : env.Ordered) (htp : TrProjOK env uvars trProj)
+    (hf : s.lctx.find? fv = some (.ldecl nm ty val))
+    (hcon : KExpr.Constructed val) (hclosed : val.lbr = 0)
+    (hbig : Δ.bvars + val.size < UInt64.size) :
+    ∃ e A, KVLCtx.find? Δ (.inr fv) = some (e, A) ∧
+      TrKExprS env uvars nameOf trProj Δ val e := by
+  obtain ⟨Δ₀, vd, dn, m, W, hfind, hsub, htr⟩ := h.lctxFind? hf
+  cases htr with
+  | vlet hty hval hvalTy =>
+    refine ⟨_, _, hfind, ?_⟩
+    have hdn : dn < UInt64.size := by
+      have hb := W.bvars_eq
+      omega
+    have hshift : dn.toUInt64.toNat = dn := by
+      rw [Nat.toUInt64_eq]
+      exact UInt64.toNat_ofNat_of_lt' hdn
+    have hw := hval.weakBV henv htp.weakN
+      (shift := dn.toUInt64) (cutoff := 0) W hshift rfl hbig
+    have hid : KExpr.liftSpec val dn.toUInt64 0 = val := by
+      apply KExpr.liftSpec_id hcon
+        (by simpa using (show val.size < UInt64.size by omega))
+      simp [hclosed]
+    rw [hid] at hw
+    simpa [Lean4Lean.VLocalDecl.value, Lean4Lean.VLocalDecl.depth] using hw
+
 /-- Fvar leaves resolve — the bare `TrKExprS.fvar` premise. -/
 theorem fvar_resolves {fv : FVarId} {d : LocalDecl .anon}
     (h : CtxRecon env uvars nameOf trProj s Δ)
diff --git a/Ix/Tc/Verify/Decl.lean b/Ix/Tc/Verify/Decl.lean
new file mode 100644
index 00000000..1b6afe35
--- /dev/null
+++ b/Ix/Tc/Verify/Decl.lean
@@ -0,0 +1,563 @@
+import Ix.Tc.Verify.World
+import Ix.Tc.Verify.Level
+import Lean4Lean.Verify.Typing.Expr
+import Lean4Lean.Theory.Typing.Lemmas
+
+/-!
+# Raw, pending, and trusted declarations
+
+This is the additive G1b boundary between a catalogued declaration and a
+Theory declaration.  The distinction is deliberately sharp:
+
+* `RawExprRel` is syntax-directed.  In particular, it has no typing premises,
+  no level-well-formedness premises, and no literal-well-formedness premises.
+  Constant and projection heads must nevertheless resolve in the current
+  trusted `VEnv`; that is representation linkage, not a typing judgment.
+* `RawDeclRel` preserves the standalone declaration kind and translates its
+  type and (for definitions) value.  This slice covers axioms and the three
+  definition kinds.  Quotient and inductive-family declarations require an
+  atomic multi-target relation and are intentionally left to the corresponding
+  block milestone.
+* `PendingDecl` contains raw correspondence, catalog closure, and absence of
+  the target from both the trusted index and the Theory constant table.  It
+  contains no `VConstant.WF`, `VDecl.WF`, or equivalent field.
+* `TrustedDecl` is intentionally stronger: it records an actual `VDecl.WF`
+  transition whose result is installed in the world's `VEnv`.
+
+The adversarial fixture at the end of the file is a raw axiom whose type is
+`Sort (param 0)` while the declaration has zero universe parameters.  It is
+catalogued, pending, and raw-translatable, but cannot be a well-formed Theory
+declaration in the empty trusted environment.
+-/
+
+namespace Ix.Tc
+
+open Lean4Lean (VExpr VLevel VEnv VConstant VConstVal VDefVal VDecl)
+
+/-- The abstract projection component used by raw expression translation.
+It has the same shape as the projection parameter of `TrKExprS`, but carries
+no closure or typing contract at the raw boundary. -/
+abbrev RawProjRel :=
+  List VExpr → Lean.Name → Nat → VExpr → VExpr → Prop
+
+namespace RawProjRel
+
+/-- A projection relation suitable for fixtures containing no projections. -/
+def none : RawProjRel := fun _ _ _ _ _ => False
+
+end RawProjRel
+
+/-- Raw syntax translation from `KExpr` to Theory `VExpr`.
+
+Unlike `TrKExprS`, this relation is intentionally usable before the checker
+has established typing.  Bound variables translate by index even when they
+are loose; universe levels translate without a `VLevel.WF` premise; and the
+structural application/binder cases carry no `HasType`/`IsType` evidence.
+
+There is no `fvar` constructor because Theory `VExpr` has no free-variable
+node.  A valid top-level declaration is closed, while an invalid declaration
+with an `fvar` simply has no raw Theory representation. -/
+inductive RawExprRel (env : VEnv) (nameOf : Address → Option Lean.Name)
+    (trProj : RawProjRel) : List VExpr → KExpr .anon → VExpr → Prop
+  | var {ctx : List VExpr} {i : UInt64} {nm : Mode.anon.F Name}
+      {md : ExprInfo .anon} :
+    RawExprRel env nameOf trProj ctx (.var i nm md) (.bvar i.toNat)
+  | sort {ctx : List VExpr} {u : KUniv .anon} {md : ExprInfo .anon} :
+    RawExprRel env nameOf trProj ctx (.sort u md) (.sort u.toVLevel)
+  | const {ctx : List VExpr} {id : KId .anon}
+      {us : Array (KUniv .anon)} {md : ExprInfo .anon}
+      {name : Lean.Name} {ci : VConstant} :
+    nameOf id.addr = some name →
+    env.constants name = some ci →
+    us.size = ci.uvars →
+    RawExprRel env nameOf trProj ctx (.const id us md)
+      (.const name (us.toList.map KUniv.toVLevel))
+  | app {ctx : List VExpr} {f a : KExpr .anon} {md : ExprInfo .anon}
+      {f' a' : VExpr} :
+    RawExprRel env nameOf trProj ctx f f' →
+    RawExprRel env nameOf trProj ctx a a' →
+    RawExprRel env nameOf trProj ctx (.app f a md) (.app f' a')
+  | lam {ctx : List VExpr} {nm : Mode.anon.F Name}
+      {bi : Mode.anon.F Lean.BinderInfo} {ty body : KExpr .anon}
+      {md : ExprInfo .anon} {ty' body' : VExpr} :
+    RawExprRel env nameOf trProj ctx ty ty' →
+    RawExprRel env nameOf trProj (ty' :: ctx) body body' →
+    RawExprRel env nameOf trProj ctx (.lam nm bi ty body md)
+      (.lam ty' body')
+  | all {ctx : List VExpr} {nm : Mode.anon.F Name}
+      {bi : Mode.anon.F Lean.BinderInfo} {ty body : KExpr .anon}
+      {md : ExprInfo .anon} {ty' body' : VExpr} :
+    RawExprRel env nameOf trProj ctx ty ty' →
+    RawExprRel env nameOf trProj (ty' :: ctx) body body' →
+    RawExprRel env nameOf trProj ctx (.all nm bi ty body md)
+      (.forallE ty' body')
+  | letE {ctx : List VExpr} {nm : Mode.anon.F Name}
+      {ty val body : KExpr .anon} {nonDep : Bool} {md : ExprInfo .anon}
+      {ty' val' body' : VExpr} :
+    RawExprRel env nameOf trProj ctx ty ty' →
+    RawExprRel env nameOf trProj ctx val val' →
+    RawExprRel env nameOf trProj (ty' :: ctx) body body' →
+    RawExprRel env nameOf trProj ctx (.letE nm ty val body nonDep md)
+      (body'.inst val')
+  | prj {ctx : List VExpr} {id : KId .anon} {field : UInt64}
+      {val : KExpr .anon} {md : ExprInfo .anon} {name : Lean.Name}
+      {ci : VConstant} {val' out : VExpr} :
+    nameOf id.addr = some name →
+    env.constants name = some ci →
+    RawExprRel env nameOf trProj ctx val val' →
+    trProj ctx name field.toNat val' out →
+    RawExprRel env nameOf trProj ctx (.prj id field val md) out
+  | nat {ctx : List VExpr} {n : Nat} {blob : Address}
+      {md : ExprInfo .anon} :
+    RawExprRel env nameOf trProj ctx (.nat n blob md) (.natLit n)
+  | str {ctx : List VExpr} {s : String} {blob : Address}
+      {md : ExprInfo .anon} :
+    RawExprRel env nameOf trProj ctx (.str s blob md)
+      (.trLiteral (.strVal s))
+
+namespace RawExprRel
+
+/-- Raw translation is monotone in the trusted Theory environment.  The
+proof transports only constant-table lookups; it never manufactures typing
+evidence. -/
+theorem mono {env env' : VEnv} (henv : env ≤ env')
+    {nameOf : Address → Option Lean.Name} {trProj : RawProjRel}
+    {ctx : List VExpr} {e : KExpr .anon} {e' : VExpr}
+    (h : RawExprRel env nameOf trProj ctx e e') :
+    RawExprRel env' nameOf trProj ctx e e' := by
+  induction h with
+  | var => exact .var
+  | sort => exact .sort
+  | const hname hlookup harity =>
+    exact .const hname (henv.constants hlookup) harity
+  | app _ _ ihf iha => exact .app ihf iha
+  | lam _ _ ihty ihbody => exact .lam ihty ihbody
+  | all _ _ ihty ihbody => exact .all ihty ihbody
+  | letE _ _ _ ihty ihval ihbody => exact .letE ihty ihval ihbody
+  | prj hname hlookup _ hproj ihval =>
+    exact .prj hname (henv.constants hlookup) ihval hproj
+  | nat => exact .nat
+  | str => exact .str
+
+end RawExprRel
+
+/-! ## Declaration references and catalog closure -/
+
+/-- A direct constant/projection reference occurring in an expression. -/
+def KExpr.References (e : KExpr .anon) (id : KId .anon) : Prop :=
+  match e with
+  | .var .. | .fvar .. | .sort .. | .nat .. | .str .. => False
+  | .const ref .. => ref = id
+  | .app f a _ => f.References id ∨ a.References id
+  | .lam _ _ ty body _ | .all _ _ ty body _ =>
+    ty.References id ∨ body.References id
+  | .letE _ ty val body _ _ =>
+    ty.References id ∨ val.References id ∨ body.References id
+  | .prj ref _ val _ => ref = id ∨ val.References id
+
+/-- Every expression reference admitted by raw translation resolves in the
+current Theory environment.  This is a lookup fact only, not a WF fact. -/
+theorem RawExprRel.reference_resolved
+    {env : VEnv} {nameOf : Address → Option Lean.Name}
+    {trProj : RawProjRel} {ctx : List VExpr} {e : KExpr .anon}
+    {e' : VExpr} (h : RawExprRel env nameOf trProj ctx e e')
+    {id : KId .anon} (href : e.References id) :
+    ∃ name ci, nameOf id.addr = some name ∧
+      env.constants name = some ci := by
+  induction h with
+  | var => simp [KExpr.References] at href
+  | sort => simp [KExpr.References] at href
+  | const hname hlookup _ =>
+    simp only [KExpr.References] at href
+    subst id
+    exact ⟨_, _, hname, hlookup⟩
+  | app _ _ ihf iha =>
+    rcases href with href | href
+    · exact ihf href
+    · exact iha href
+  | lam _ _ ihty ihbody | all _ _ ihty ihbody =>
+    rcases href with href | href
+    · exact ihty href
+    · exact ihbody href
+  | letE _ _ _ ihty ihval ihbody =>
+    rcases href with href | href | href
+    · exact ihty href
+    · exact ihval href
+    · exact ihbody href
+  | prj hname hlookup _ _ ihval =>
+    rcases href with href | href
+    · subst id
+      exact ⟨_, _, hname, hlookup⟩
+    · exact ihval href
+  | nat => simp [KExpr.References] at href
+  | str => simp [KExpr.References] at href
+
+/-- A raw expression cannot refer to an id whose assigned Theory name is
+absent from the environment. -/
+theorem RawExprRel.not_references_of_absent
+    {env : VEnv} {nameOf : Address → Option Lean.Name}
+    {trProj : RawProjRel} {ctx : List VExpr} {e : KExpr .anon}
+    {e' : VExpr} (h : RawExprRel env nameOf trProj ctx e e')
+    {id : KId .anon} {name : Lean.Name}
+    (hname : nameOf id.addr = some name)
+    (habsent : env.constants name = none) :
+    ¬e.References id := by
+  intro href
+  obtain ⟨name', ci, hname', hlookup⟩ := h.reference_resolved href
+  rw [hname] at hname'
+  cases hname'
+  rw [habsent] at hlookup
+  cases hlookup
+
+/-- Every constant id consulted directly by declaration checking.  Besides
+expression occurrences this includes block/member links and constructor ids. -/
+def KConst.References (c : KConst .anon) (id : KId .anon) : Prop :=
+  match c with
+  | .defn (ty := ty) (val := val) (block := block) .. =>
+    ty.References id ∨ val.References id ∨ block = id
+  | .recr (block := block) (ty := ty) (rules := rules) .. =>
+    block = id ∨ ty.References id ∨
+      ∃ rule ∈ rules, rule.rhs.References id
+  | .axio (ty := ty) .. | .quot (ty := ty) .. => ty.References id
+  | .indc (block := block) (ty := ty) (ctors := ctors) .. =>
+    block = id ∨ ty.References id ∨ id ∈ ctors
+  | .ctor (induct := induct) (ty := ty) .. =>
+    induct = id ∨ ty.References id
+
+/-- Expression occurrences that could justify a target through Theory
+constant lookup or unfolding.  Coordination links (`block`, `induct`, and
+constructor arrays) remain in `KConst.References`, but are excluded here. -/
+def KConst.ExprReferences (c : KConst .anon) (id : KId .anon) : Prop :=
+  match c with
+  | .defn (ty := ty) (val := val) .. =>
+    ty.References id ∨ val.References id
+  | .recr (ty := ty) (rules := rules) .. =>
+    ty.References id ∨ ∃ rule ∈ rules, rule.rhs.References id
+  | .axio (ty := ty) .. | .quot (ty := ty) .. |
+    .indc (ty := ty) .. | .ctor (ty := ty) .. => ty.References id
+
+/-- Every declaration reference is committed by the immutable catalog. -/
+def CatalogClosed (catalog : Catalog) (c : KConst .anon) : Prop :=
+  ∀ ⦃id⦄, c.References id → Catalog.Contains catalog id
+
+/-! ## Raw declaration correspondence -/
+
+/-- Preservation of Ix's three definition kinds in Theory declarations.
+Theorems and opaque definitions are both non-unfolding Theory declarations;
+ordinary definitions install their definitional equation. -/
+inductive RawDefKindRel (ci : VDefVal) : Ix.DefKind → VDecl → Prop
+  | defn : RawDefKindRel ci .defn (.def ci)
+  | opaq : RawDefKindRel ci .opaq (.opaque ci)
+  | thm : RawDefKindRel ci .thm (.opaque ci)
+
+/-- Raw standalone declaration correspondence.
+
+No constructor asks for `ci.WF` or `d.WF`.  Quotients and inductive-family
+members cannot be represented soundly one constant at a time in
+Lean4Lean.Theory, so they intentionally have no constructor here; their
+future relation is atomic at the block level. -/
+inductive RawDeclRel (env : VEnv) (nameOf : Address → Option Lean.Name)
+    (trProj : RawProjRel) (id : KId .anon) : KConst .anon → VDecl → Prop
+  | axiom {nm : Mode.anon.F Name} {lps : Mode.anon.F (Array Name)}
+      {isUnsafe : Bool} {lvls : UInt64} {ty : KExpr .anon}
+      {name : Lean.Name} {ty' : VExpr} :
+    nameOf id.addr = some name →
+    RawExprRel env nameOf trProj [] ty ty' →
+    RawDeclRel env nameOf trProj id (.axio nm lps isUnsafe lvls ty)
+      (.axiom { name, uvars := lvls.toNat, type := ty' })
+  | defn {nm : Mode.anon.F Name} {lps : Mode.anon.F (Array Name)}
+      {kind : Ix.DefKind} {safety : Ix.DefinitionSafety}
+      {hints : Lean.ReducibilityHints} {lvls : UInt64}
+      {ty val : KExpr .anon} {leanAll : Mode.anon.F (Array (KId .anon))}
+      {block : KId .anon} {name : Lean.Name} {ty' val' : VExpr}
+      {d : VDecl} :
+    nameOf id.addr = some name →
+    RawExprRel env nameOf trProj [] ty ty' →
+    RawExprRel env nameOf trProj [] val val' →
+    RawDefKindRel
+      { name, uvars := lvls.toNat, type := ty', value := val' } kind d →
+    RawDeclRel env nameOf trProj id
+      (.defn nm lps kind safety hints lvls ty val leanAll block) d
+
+namespace RawDeclRel
+
+/-- Every raw standalone declaration has the target's ghost name. -/
+theorem nameOf {env : VEnv} {nameOf : Address → Option Lean.Name}
+    {trProj : RawProjRel} {id : KId .anon} {c : KConst .anon}
+    {d : VDecl} (h : RawDeclRel env nameOf trProj id c d) :
+    ∃ name, nameOf id.addr = some name := by
+  cases h with
+  | «axiom» hname _ => exact ⟨_, hname⟩
+  | defn hname _ _ _ => exact ⟨_, hname⟩
+
+/-- Raw declaration correspondence is monotone in the trusted `VEnv`. -/
+theorem mono {env env' : VEnv} (henv : env ≤ env')
+    {nameOf : Address → Option Lean.Name} {trProj : RawProjRel}
+    {id : KId .anon} {c : KConst .anon} {d : VDecl}
+    (h : RawDeclRel env nameOf trProj id c d) :
+    RawDeclRel env' nameOf trProj id c d := by
+  cases h with
+  | «axiom» hname hty => exact .axiom hname (hty.mono henv)
+  | defn hname hty hval hkind =>
+    exact .defn hname (hty.mono henv) (hval.mono henv) hkind
+
+/-- A WF transition for a raw standalone declaration extends its input
+environment.  Lean4Lean does not provide this for arbitrary `VDecl.WF`
+(notably, its abstract `addInduct` has no extension theorem), but it follows
+constructively for exactly the axiom/definition/opaque cases admitted by
+`RawDeclRel`. -/
+theorem wf_le {env env' : VEnv} {nameOf : Address → Option Lean.Name}
+    {trProj : RawProjRel} {id : KId .anon} {c : KConst .anon}
+    {d : VDecl} (hraw : RawDeclRel env nameOf trProj id c d)
+    (hwf : VDecl.WF env d env') : env ≤ env' := by
+  cases hraw with
+  | «axiom» =>
+    cases hwf with
+    | «axiom» _ hadd => exact Lean4Lean.VEnv.addConst_le hadd
+  | defn _ _ _ hkind =>
+    cases hkind with
+    | defn =>
+      cases hwf with
+      | «def» _ hadd =>
+        exact (Lean4Lean.VEnv.addConst_le hadd).trans
+          Lean4Lean.VEnv.addDefEq_le
+    | opaq | thm =>
+      cases hwf with
+      | «opaque» _ hadd => exact Lean4Lean.VEnv.addConst_le hadd
+
+/-- Target freshness rules out self-reference in every expression translated
+by a raw standalone declaration. -/
+theorem no_self_expr_reference
+    {env : VEnv} {nameOf : Address → Option Lean.Name}
+    {trProj : RawProjRel} {id : KId .anon} {c : KConst .anon}
+    {d : VDecl} (h : RawDeclRel env nameOf trProj id c d)
+    (hfresh : ∀ ⦃name⦄, nameOf id.addr = some name →
+      env.constants name = none) :
+    ¬c.ExprReferences id := by
+  cases h with
+  | «axiom» hname hty =>
+    exact hty.not_references_of_absent hname (hfresh hname)
+  | defn hname hty hval _ =>
+    intro href
+    rcases href with href | href
+    · exact hty.not_references_of_absent hname (hfresh hname) href
+    · exact hval.not_references_of_absent hname (hfresh hname) href
+
+end RawDeclRel
+
+/-! ## Pending versus trusted -/
+
+/-- The target's Theory name is not already installed.  Together with an
+untrusted target id, this blocks self-justification through constant lookup.
+Warm-cache provenance and isolation are state-specific G4 obligations. -/
+def TargetFresh (world : VerifyWorld) (id : KId .anon) : Prop :=
+  ∀ ⦃name⦄, world.nameOf id.addr = some name →
+    world.venv.constants name = none
+
+/-- A declaration ready to be checked but not yet admitted.
+
+The conjunct list is itself the important interface: there is no
+declaration-WF premise. -/
+def PendingDecl (trProj : RawProjRel) (world : VerifyWorld)
+    (id : KId .anon) (d : VDecl) : Prop :=
+  ∃ concrete,
+    world.catalog id = some concrete ∧
+    RawDeclRel world.venv world.nameOf trProj id concrete d ∧
+    ¬world.trusted id ∧
+    CatalogClosed world.catalog concrete ∧
+    TargetFresh world id
+
+/-- A declaration already admitted to the semantic world.  Unlike
+`PendingDecl`, this status contains the actual Theory WF transition and proof
+that its result is present in the world's `VEnv`. -/
+def TrustedDecl (trProj : RawProjRel) (world : VerifyWorld)
+    (id : KId .anon) (d : VDecl) : Prop :=
+  ∃ concrete before after,
+    world.catalog id = some concrete ∧
+    RawDeclRel world.venv world.nameOf trProj id concrete d ∧
+    world.trusted id ∧
+    VDecl.WF before d after ∧
+    after ≤ world.venv
+
+/-- The single Theory constant installed by a standalone declaration. -/
+inductive VDeclInstalls : VDecl → Lean.Name → VConstant → Prop
+  | axiom (ci : VConstVal) :
+    VDeclInstalls (.axiom ci) ci.name ci.toVConstant
+  | defn (ci : VDefVal) :
+    VDeclInstalls (.def ci) ci.name ci.toVConstant
+  | opaque (ci : VDefVal) :
+    VDeclInstalls (.opaque ci) ci.name ci.toVConstant
+
+namespace TrustedDecl
+
+/-- Trusted standalone lookup reaches the exact constant installed by its
+recorded WF transition. -/
+theorem lookup {trProj : RawProjRel} {world : VerifyWorld}
+    {id : KId .anon} {d : VDecl} (h : TrustedDecl trProj world id d) :
+    ∃ name ci,
+      VDeclInstalls d name ci ∧
+      world.nameOf id.addr = some name ∧
+      world.venv.constants name = some ci := by
+  obtain ⟨c, before, after, hcat, hraw, htrusted, hwf, hinstalled⟩ := h
+  cases hraw with
+  | «axiom» hname hty =>
+    cases hwf with
+    | «axiom» hconstant hadd =>
+      exact ⟨_, _, .axiom _, hname,
+        hinstalled.constants (Lean4Lean.VEnv.addConst_self hadd)⟩
+  | defn hname hty hval hkind =>
+    cases hkind with
+    | defn =>
+      cases hwf with
+      | «def» hconstant hadd =>
+        exact ⟨_, _, .defn _, hname,
+          hinstalled.constants
+            (Lean4Lean.VEnv.addDefEq_le.constants
+              (Lean4Lean.VEnv.addConst_self hadd))⟩
+    | opaq | thm =>
+      cases hwf with
+      | «opaque» hconstant hadd =>
+        exact ⟨_, _, .opaque _, hname,
+          hinstalled.constants (Lean4Lean.VEnv.addConst_self hadd)⟩
+
+end TrustedDecl
+
+namespace PendingDecl
+
+theorem catalogued {trProj : RawProjRel} {world : VerifyWorld}
+    {id : KId .anon} {d : VDecl} (h : PendingDecl trProj world id d) :
+    Catalog.Contains world.catalog id := by
+  obtain ⟨concrete, hcatalog, _⟩ := h
+  exact ⟨concrete, hcatalog⟩
+
+/-- A pending target has no constant-table entry under its assigned name. -/
+theorem no_target_lookup {trProj : RawProjRel} {world : VerifyWorld}
+    {id : KId .anon} {d : VDecl} (h : PendingDecl trProj world id d) :
+    ∃ name, world.nameOf id.addr = some name ∧
+      world.venv.constants name = none := by
+  obtain ⟨_, _, hraw, _, _, hfresh⟩ := h
+  obtain ⟨name, hname⟩ := hraw.nameOf
+  exact ⟨name, hname, hfresh hname⟩
+
+/-- The pending target cannot occur as a constant/projection head in its own
+translated type or value.  This is the G1b self-unfolding barrier; cache
+provenance and collision-mediated aliasing are addressed in G4/G3. -/
+theorem no_self_expr_reference {trProj : RawProjRel} {world : VerifyWorld}
+    {id : KId .anon} {d : VDecl} (h : PendingDecl trProj world id d) :
+    ∃ concrete, world.catalog id = some concrete ∧
+      ¬concrete.ExprReferences id := by
+  obtain ⟨concrete, hcatalog, hraw, _, _, hfresh⟩ := h
+  exact ⟨concrete, hcatalog, hraw.no_self_expr_reference hfresh⟩
+
+/-- Pending and trusted status are disjoint without inspecting any typing
+derivation. -/
+theorem not_trustedDecl {trProj : RawProjRel} {world : VerifyWorld}
+    {id : KId .anon} {d : VDecl} (h : PendingDecl trProj world id d) :
+    ¬TrustedDecl trProj world id d := by
+  obtain ⟨_, _, _, huntrusted, _, _⟩ := h
+  rintro ⟨_, _, _, _, _, htrusted, _⟩
+  exact huntrusted htrusted
+
+end PendingDecl
+
+/-! ## Adversarial non-WF pending fixture -/
+
+namespace IllTypedPending
+
+def targetName : Lean.Name := `Ix.Tc.Verify.illTypedPending
+
+/-- A fixed 32-byte address keeps the fixture independent of the Blake3 FFI
+and its generated `native_decide` axiom.  Address coherence is a separate
+ingress obligation; only typing is under attack here. -/
+def fixtureAddress : Address :=
+  ⟨⟨Array.replicate 32 0⟩⟩
+
+def targetId : KId .anon := ⟨fixtureAddress, ()⟩
+
+def badLevel : KUniv .anon := .param 0 () fixtureAddress
+
+def exprInfo : ExprInfo .anon where
+  addr := fixtureAddress
+  lbr := 0
+  count0 := 0
+  hasFVars := false
+  mdata := ()
+  metaAddr := ()
+
+def badType : KExpr .anon := .sort badLevel exprInfo
+
+def concrete : KConst .anon := .axio () () false 0 badType
+
+def theoryConstant : VConstVal where
+  name := targetName
+  uvars := 0
+  type := .sort (.param 0)
+
+def theoryDecl : VDecl := .axiom theoryConstant
+
+def catalog : Catalog := fun _ => some concrete
+
+def world : VerifyWorld where
+  catalog := catalog
+  trusted := fun _ => False
+  venv := .empty
+  nameOf := fun _ => some targetName
+  venvWF := ⟨[], .empty⟩
+  trustedCatalogued := fun {_} h => False.elim h
+
+theorem raw : RawDeclRel world.venv world.nameOf RawProjRel.none
+    targetId concrete theoryDecl := by
+  apply RawDeclRel.axiom rfl
+  exact RawExprRel.sort
+
+theorem pending : PendingDecl RawProjRel.none world targetId theoryDecl := by
+  refine ⟨concrete, rfl, raw, (fun h => h), ?_, ?_⟩
+  · intro id href
+    exact ⟨concrete, rfl⟩
+  · intro name hname
+    rfl
+
+/-- The raw target type uses universe parameter zero while declaring zero
+universe parameters, so the Theory constant is not well-formed. -/
+theorem theoryConstant_not_wf :
+    ¬theoryConstant.toVConstant.WF world.venv := by
+  intro hwf
+  have hlevel : (VLevel.param 0).WF 0 :=
+    hwf.sort_inv Lean4Lean.VEnv.Ordered.empty
+  exact (Nat.not_lt_zero 0) hlevel
+
+/-- Consequently there is no Theory declaration-WF step from the pending
+world. -/
+theorem theoryDecl_not_wf :
+    ¬∃ env', VDecl.WF world.venv theoryDecl env' := by
+  rintro ⟨env', hwf⟩
+  cases hwf with
+  | «axiom» hconstant _ => exact theoryConstant_not_wf hconstant
+
+/-- Machine-checked G1b acceptance witness: raw correspondence and pending
+status are constructible for a declaration whose Theory WF judgment is
+false. -/
+theorem pending_but_not_wf :
+    PendingDecl RawProjRel.none world targetId theoryDecl ∧
+      ¬∃ env', VDecl.WF world.venv theoryDecl env' :=
+  ⟨pending, theoryDecl_not_wf⟩
+
+section Loaded
+
+variable [LawfulBEq (KId .anon)] [LawfulHashable (KId .anon)]
+
+/-- The same ill-typed pending target may already be present in the concrete
+lazy-load cache; loading still does not confer trust or WF. -/
+theorem loaded_pending_but_not_wf :
+    LoadedAgrees world.catalog
+        (({} : KEnv .anon).insert targetId concrete) ∧
+      PendingDecl RawProjRel.none world targetId theoryDecl ∧
+      ¬∃ env', VDecl.WF world.venv theoryDecl env' :=
+  ⟨LoadedAgrees.insert (LoadedAgrees.empty catalog) rfl,
+    pending, theoryDecl_not_wf⟩
+
+end Loaded
+
+end IllTypedPending
+
+end Ix.Tc
diff --git a/Ix/Tc/Verify/Env.lean b/Ix/Tc/Verify/Env.lean
index 4f59b42d..3524e5e8 100644
--- a/Ix/Tc/Verify/Env.lean
+++ b/Ix/Tc/Verify/Env.lean
@@ -1,4 +1,6 @@
 import Ix.Tc.Verify.Trans
+import Ix.Tc.Verify.Decl
+import Ix.Tc.Verify.Inductive
 import Ix.Tc.Const
 import Ix.Tc.Env
 
@@ -31,14 +33,15 @@ content-addressed environment. The structural divergences:
   (Check.lean:43-76) verification at the infer/checkConst soundness
   layers. The v1 headline
   instantiates `safety := .safe`.
-- **Remaining debts**: the `quot` step, the
-  `thm`/`opaque` kind refinement of `defn` (it currently registers the
-  defeq for every kind), and `AddKInduct` — an EMPTY inductive (exact
-  upstream parity: their `AddInduct` is an empty `-- TODO`), so the
-  relation is uninhabited for envs containing inductives until the
-  inductive layer supplies the block translation. The whnf/infer
-  soundness layers consume `TrKEnv` as a hypothesis, so their lemmas
-  are unaffected.
+- **Remaining legacy debts**: the `quot` step, the `thm`/`opaque` kind
+  refinement of `defn` (it currently registers the defeq for every kind),
+  and `AddKInduct` — an EMPTY inductive (exact upstream parity: their
+  `AddInduct` is an empty `-- TODO`). Thus this legacy relation remains
+  uninhabited for envs containing inductives. The trusted-world path below
+  does not use it: `TrustedCatalogLog.ambient` admits an explicit
+  `InductiveOracle`. G2b removes the legacy relation from the remaining
+  C1--C3 consumer interfaces; E2 eventually replaces the oracle with checked
+  block construction.
 -/
 
 namespace Ix.DefinitionSafety
@@ -206,10 +209,10 @@ theorem TrKDefVal.mono {safety : Ix.DefinitionSafety}
 
 /-! ### The environment log -/
 
-/-- Block-level inductive translation — upstream-parity STUB (their
-    `AddInduct` is an empty inductive pending the `addInduct` spec).
-    The inductive layer fills this; until then `TrKEnv'` is uninhabited for
-    environments containing inductives, exactly like upstream. -/
+/-- Block-level inductive translation in the legacy whole-`KEnv` relation —
+    upstream-parity STUB (their `AddInduct` is an empty inductive pending the
+    `addInduct` spec). `TrustedCatalogLog.ambient` below is the live G2 path;
+    this constructor remains only as a quarantined compatibility interface. -/
 inductive AddKInduct :
     HashMap (KId .anon) (KConst .anon) → VEnv → VInductDecl →
     HashMap (KId .anon) (KConst .anon) → VEnv → Prop
@@ -403,4 +406,498 @@ theorem TrKEnv.find? {safety : Ix.DefinitionSafety}
   let ⟨_, H⟩ := H
   H.find? h hs
 
+/-! ## G1c: trusted-catalog log
+
+The legacy `TrKEnv'` above indexes its semantic log by the entire concrete
+hash map, forcing pending declarations to be WF before `checkConst` runs.
+`TrustedCatalogLog` instead indexes only the ghost trusted predicate.  The
+immutable catalog is consulted at each admission step, but pending and
+unrelated catalog entries never occur in the log and therefore carry no WF
+obligation.
+
+This relation is kept as an explicit proof object over `VerifyWorld` rather
+than a field of the structure.  That preserves the acyclic dependency
+`World -> Decl -> Env`: `RawDeclRel` needs `VerifyWorld` for pending status,
+while the trusted log needs `RawDeclRel`.  `Verify/State.lean` conjoins this
+relation with loaded-catalog and intern-table coherence.
+-/
+
+/-- Add one id to a trusted predicate. -/
+def TrustInsert (trusted : KId .anon → Prop) (id : KId .anon) :
+    KId .anon → Prop :=
+  fun target => target = id ∨ trusted target
+
+namespace TrustInsert
+
+theorem self {trusted : KId .anon → Prop} {id : KId .anon} :
+    TrustInsert trusted id id :=
+  Or.inl rfl
+
+theorem old {trusted : KId .anon → Prop} {id target : KId .anon}
+    (h : trusted target) : TrustInsert trusted id target :=
+  Or.inr h
+
+end TrustInsert
+
+/-! ### Trusted entry provenance -/
+
+/-- Provenance for one trusted catalog id.  Standalone entries retain their
+actual declaration-WF transition.  Ambient inductive-family entries retain
+the oracle's raw translation, exact Theory lookup, and constant-WF fact. -/
+inductive TrustedCatalogEntry (trProj : RawProjRel) (catalog : Catalog)
+    (nameOf : Address → Option Lean.Name) (env : VEnv)
+    (id : KId .anon) : Prop
+  | standalone {c : KConst .anon} {d : VDecl} {before after : VEnv} :
+    catalog id = some c →
+    RawDeclRel env nameOf trProj id c d →
+    VDecl.WF before d after →
+    after ≤ env →
+    TrustedCatalogEntry trProj catalog nameOf env id
+  | ambient {c : KConst .anon} {name : Lean.Name} {ci : VConstant} :
+    catalog id = some c →
+    RawInductiveConstRel env nameOf trProj id c name ci →
+    env.constants name = some ci →
+    ci.WF env →
+    TrustedCatalogEntry trProj catalog nameOf env id
+
+namespace TrustedCatalogEntry
+
+theorem mono {trProj : RawProjRel} {catalog : Catalog}
+    {nameOf : Address → Option Lean.Name} {env env' : VEnv}
+    {id : KId .anon} (henv : env ≤ env')
+    (h : TrustedCatalogEntry trProj catalog nameOf env id) :
+    TrustedCatalogEntry trProj catalog nameOf env' id := by
+  cases h with
+  | standalone hcat hraw hwf hinstalled =>
+    exact .standalone hcat (hraw.mono henv) hwf (hinstalled.trans henv)
+  | ambient hcat hraw hlookup hwf =>
+    exact .ambient hcat (hraw.mono henv) (henv.constants hlookup)
+      (hwf.mono henv)
+
+/-- Both provenance cases expose the exact catalog/name/Theory lookup needed
+by expression translation. -/
+theorem lookup {trProj : RawProjRel} {catalog : Catalog}
+    {nameOf : Address → Option Lean.Name} {env : VEnv}
+    {id : KId .anon} (h : TrustedCatalogEntry trProj catalog nameOf env id) :
+    ∃ c name ci,
+      catalog id = some c ∧
+      nameOf id.addr = some name ∧
+      env.constants name = some ci := by
+  cases h with
+  | @standalone c d before after hcat hraw hwf hinstalled =>
+    cases hraw with
+    | «axiom» hname hty =>
+      cases hwf with
+      | «axiom» _ hadd =>
+        exact ⟨_, _, _, hcat, hname,
+          hinstalled.constants (VEnv.addConst_self hadd)⟩
+    | defn hname hty hval hkind =>
+      cases hkind with
+      | defn =>
+        cases hwf with
+        | «def» _ hadd =>
+          exact ⟨_, _, _, hcat, hname,
+            hinstalled.constants
+              (VEnv.addDefEq_le.constants (VEnv.addConst_self hadd))⟩
+      | opaq | thm =>
+        cases hwf with
+        | «opaque» _ hadd =>
+          exact ⟨_, _, _, hcat, hname,
+            hinstalled.constants (VEnv.addConst_self hadd)⟩
+  | ambient hcat hraw hlookup hwf =>
+    exact ⟨_, _, _, hcat, hraw.nameEq, hlookup⟩
+
+end TrustedCatalogEntry
+
+/-! ### Unified trusted-constant view -/
+
+/-- Consumer-facing provenance for one exact concrete constant.
+
+Unlike legacy `TrKConstant`, this relation does not require a translation log
+over the whole concrete `KEnv`.  It states only what C1--C3 consumers need at
+a trusted lookup: the immutable catalog entry is exactly `c`; its assigned
+Theory constant is installed and well-formed; universe arities agree; and the
+concrete type has a raw translation to that Theory type.  Both standalone
+promotion and ambient inductive admission construct the same relation.
+Definition-safety authorization remains a per-reference `checkNoUnsafeRefs`
+obligation; this relation supplies semantic resolution, not that operational
+check. -/
+structure TrustedConstRel (trProj : RawProjRel) (world : VerifyWorld)
+    (id : KId .anon) (c : KConst .anon) (name : Lean.Name)
+    (ci : VConstant) : Prop where
+  catalog : world.catalog id = some c
+  trusted : world.trusted id
+  nameEq : world.nameOf id.addr = some name
+  lookup : world.venv.constants name = some ci
+  uvars : c.lvls.toNat = ci.uvars
+  type : RawExprRel world.venv world.nameOf trProj [] c.ty ci.type
+  wf : ci.WF world.venv
+
+namespace TrustedConstRel
+
+/-- Trusted-constant provenance transports along world extension. -/
+theorem mono {trProj : RawProjRel} {before after : VerifyWorld}
+    (hle : before ≤ after) {id : KId .anon} {c : KConst .anon}
+    {name : Lean.Name} {ci : VConstant}
+    (h : TrustedConstRel trProj before id c name ci) :
+    TrustedConstRel trProj after id c name ci := by
+  refine ⟨?_, hle.trusted h.trusted, ?_, hle.venv.constants h.lookup,
+    h.uvars, ?_, h.wf.mono hle.venv⟩
+  · rw [← hle.catalog]
+    exact h.catalog
+  · rw [← hle.nameOf]
+    exact h.nameEq
+  · rw [← hle.nameOf]
+    exact h.type.mono hle.venv
+
+/-- A resolved trusted constant supplies the constant-expression constructor
+used by whnf/infer/checking consumers.  The caller contributes only the
+per-occurrence universe-level WF and the checker's arity equality. -/
+theorem trKExprS_const {trProj : RawProjRel} {world : VerifyWorld}
+    {id : KId .anon} {c : KConst .anon} {name : Lean.Name}
+    {ci : VConstant} (h : TrustedConstRel trProj world id c name ci)
+    {us : Array (KUniv .anon)} {info : ExprInfo .anon} {ctx : KVLCtx}
+    (hlevels : ∀ u ∈ us, u.toVLevel.WF ci.uvars)
+    (harity : us.size = c.lvls.toNat) :
+    TrKExprS world.venv ci.uvars world.nameOf trProj ctx
+      (.const id us info)
+      (.const name (us.toList.map KUniv.toVLevel)) :=
+  .const h.nameEq h.lookup hlevels (harity.trans h.uvars)
+
+end TrustedConstRel
+
+/-- Event log for exactly the declarations admitted to the Theory world.
+
+The `promote` constructor is the only way to grow the trusted set.  Its final
+premise is the new declaration-WF evidence supplied by successful checking;
+neither catalog membership nor raw correspondence can synthesize it. -/
+inductive TrustedCatalogLog (trProj : RawProjRel) (catalog : Catalog)
+    (nameOf : Address → Option Lean.Name) :
+    (KId .anon → Prop) → VEnv → Prop
+  | empty :
+    TrustedCatalogLog trProj catalog nameOf (fun _ => False) .empty
+  | promote {trusted : KId .anon → Prop} {env env' : VEnv}
+      {id : KId .anon} {c : KConst .anon} {d : VDecl} :
+    TrustedCatalogLog trProj catalog nameOf trusted env →
+    catalog id = some c →
+    RawDeclRel env nameOf trProj id c d →
+    CatalogClosed catalog c →
+    ¬trusted id →
+    VDecl.WF env d env' →
+    TrustedCatalogLog trProj catalog nameOf (TrustInsert trusted id) env'
+  | ambient {trusted : KId .anon → Prop} {env : VEnv}
+      (oracle : InductiveOracle trProj catalog nameOf trusted env) :
+    TrustedCatalogLog trProj catalog nameOf trusted env →
+    TrustedCatalogLog trProj catalog nameOf oracle.TrustBlock oracle.after
+
+namespace TrustedCatalogLog
+
+/-- Replaying the trusted log constructs a well-formed Theory environment. -/
+theorem wf {trProj : RawProjRel} {catalog : Catalog}
+    {nameOf : Address → Option Lean.Name} {trusted : KId .anon → Prop}
+    {env : VEnv}
+    (h : TrustedCatalogLog trProj catalog nameOf trusted env) : env.WF := by
+  induction h with
+  | empty => exact ⟨[], .empty⟩
+  | promote _ _ _ _ _ hwf ih =>
+    obtain ⟨ds, hds⟩ := ih
+    exact ⟨_, .decl hwf hds⟩
+  | ambient oracle _ _ => exact oracle.blockWF
+
+/-- Every trusted id is committed by the immutable catalog. -/
+theorem catalogued {trProj : RawProjRel} {catalog : Catalog}
+    {nameOf : Address → Option Lean.Name} {trusted : KId .anon → Prop}
+    {env : VEnv}
+    (h : TrustedCatalogLog trProj catalog nameOf trusted env)
+    {id : KId .anon} (htrusted : trusted id) :
+    Catalog.Contains catalog id := by
+  induction h with
+  | empty => exact False.elim htrusted
+  | @promote trusted env env' newId c d hlog hcat hraw hclosed huntrusted hwf ih =>
+    change id = newId ∨ trusted id at htrusted
+    rcases htrusted with hnew | hold
+    · subst id
+      exact ⟨c, hcat⟩
+    · exact ih hold
+  | @ambient trusted env oracle hlog ih =>
+    change oracle.members id ∨ trusted id at htrusted
+    rcases htrusted with hnew | hold
+    · exact oracle.catalogued hnew
+    · exact ih hold
+
+/-- Read a trusted log entry.  The raw relation is transported to the final
+environment, while the original WF transition and its installed prefix are
+retained. -/
+theorem find {trProj : RawProjRel} {catalog : Catalog}
+    {nameOf : Address → Option Lean.Name} {trusted : KId .anon → Prop}
+    {env : VEnv}
+    (h : TrustedCatalogLog trProj catalog nameOf trusted env)
+    {id : KId .anon} (htrusted : trusted id) :
+    TrustedCatalogEntry trProj catalog nameOf env id := by
+  induction h with
+  | empty => exact False.elim htrusted
+  | @promote trusted env env' newId c d hlog hcat hraw hclosed huntrusted hwf ih =>
+    have hle : env ≤ env' := RawDeclRel.wf_le hraw hwf
+    change id = newId ∨ trusted id at htrusted
+    rcases htrusted with hnew | hold
+    · subst id
+      exact .standalone hcat (hraw.mono hle) hwf VEnv.LE.rfl
+    · exact (ih hold).mono hle
+  | @ambient trusted env oracle hlog ih =>
+    change oracle.members id ∨ trusted id at htrusted
+    rcases htrusted with hnew | hold
+    · obtain ⟨c, name, ci, hcat, hraw, hlookup, hwf⟩ :=
+        oracle.translateBlock hnew
+      exact .ambient hcat hraw hlookup hwf
+    · exact (ih hold).mono oracle.envLE
+
+end TrustedCatalogLog
+
+/-- A `VerifyWorld` is semantically justified by a trusted-only event log.
+This is independent of the concrete lazy-load `KEnv`. -/
+def TrustedCatalogRel (trProj : RawProjRel) (world : VerifyWorld) : Prop :=
+  TrustedCatalogLog trProj world.catalog world.nameOf world.trusted world.venv
+
+namespace TrustedCatalogRel
+
+/-- Every arbitrary catalog starts with an empty trusted semantic log; no
+catalog declaration is required to be WF. -/
+theorem ofCatalog (catalog : Catalog) {trProj : RawProjRel} :
+    TrustedCatalogRel trProj (VerifyWorld.ofCatalog catalog) :=
+  TrustedCatalogLog.empty
+
+/-- The log justifies the `VerifyWorld` well-formedness field independently. -/
+theorem wf {trProj : RawProjRel} {world : VerifyWorld}
+    (h : TrustedCatalogRel trProj world) : world.venv.WF :=
+  TrustedCatalogLog.wf h
+
+/-- Trusted lookup yields provenance for either a standalone WF transition or
+an oracle-backed ambient inductive member. -/
+theorem find {trProj : RawProjRel} {world : VerifyWorld}
+    (h : TrustedCatalogRel trProj world) {id : KId .anon}
+    (htrusted : world.trusted id) :
+    TrustedCatalogEntry trProj world.catalog world.nameOf world.venv id :=
+  TrustedCatalogLog.find h htrusted
+
+/-- Resolve an exact catalog constant through either standalone or ambient
+trusted provenance.  This is the whole-`KEnv`-free replacement for the
+consumer use of `TrKEnv.find?`. -/
+theorem resolve {trProj : RawProjRel} {world : VerifyWorld}
+    (h : TrustedCatalogRel trProj world) {id : KId .anon}
+    {c : KConst .anon} (htrusted : world.trusted id)
+    (hcatalog : world.catalog id = some c) :
+    ∃ name ci, TrustedConstRel trProj world id c name ci := by
+  have hordered := h.wf.ordered
+  cases h.find htrusted with
+  | @standalone c' d before after hcatalog' hraw hwf hinstalled =>
+    have hc : c' = c := Option.some.inj (hcatalog'.symm.trans hcatalog)
+    subst c'
+    cases hraw with
+    | «axiom» hname htype =>
+      cases hwf with
+      | «axiom» _ hadd =>
+        have hlookup := hinstalled.constants (VEnv.addConst_self hadd)
+        exact ⟨_, _, hcatalog, htrusted, hname, hlookup, rfl, htype,
+          hordered.constWF hlookup⟩
+    | defn hname htype hvalue hkind =>
+      cases hkind with
+      | defn =>
+        cases hwf with
+        | «def» _ hadd =>
+          have hlookup := hinstalled.constants
+            (VEnv.addDefEq_le.constants (VEnv.addConst_self hadd))
+          exact ⟨_, _, hcatalog, htrusted, hname, hlookup, rfl, htype,
+            hordered.constWF hlookup⟩
+      | opaq | thm =>
+        cases hwf with
+        | «opaque» _ hadd =>
+          have hlookup := hinstalled.constants (VEnv.addConst_self hadd)
+          exact ⟨_, _, hcatalog, htrusted, hname, hlookup, rfl, htype,
+            hordered.constWF hlookup⟩
+  | @ambient c' name ci hcatalog' hraw hlookup hwf =>
+    have hc : c' = c := Option.some.inj (hcatalog'.symm.trans hcatalog)
+    subst c'
+    exact ⟨name, ci, hcatalog, htrusted, hraw.nameEq, hlookup,
+      hraw.uvars, hraw.type, hwf⟩
+
+/-- Operational trusted lookup: the id's assigned Theory name resolves to
+the exact constant supplied by its recorded provenance. -/
+theorem lookup {trProj : RawProjRel} {world : VerifyWorld}
+    (h : TrustedCatalogRel trProj world) {id : KId .anon}
+    (htrusted : world.trusted id) :
+    ∃ c name ci,
+      world.catalog id = some c ∧
+      world.nameOf id.addr = some name ∧
+      world.venv.constants name = some ci := by
+  exact (TrustedCatalogRel.find h htrusted).lookup
+
+end TrustedCatalogRel
+
+/-! ### Ghost promotion -/
+
+/-- World promotion keeps immutable ghost input fixed, grows the trusted set
+and Theory environment, and includes every requested id. -/
+def Promotes (before : VerifyWorld) (ids : KId .anon → Prop)
+    (after : VerifyWorld) : Prop :=
+  before ≤ after ∧ ∀ ⦃id⦄, ids id → after.trusted id
+
+namespace Promotes
+
+theorem catalog {before after : VerifyWorld} {ids : KId .anon → Prop}
+    (h : Promotes before ids after) : before.catalog = after.catalog :=
+  h.1.catalog
+
+theorem nameOf {before after : VerifyWorld} {ids : KId .anon → Prop}
+    (h : Promotes before ids after) : before.nameOf = after.nameOf :=
+  h.1.nameOf
+
+theorem trusted {before after : VerifyWorld} {ids : KId .anon → Prop}
+    (h : Promotes before ids after) {id : KId .anon}
+    (hid : ids id) : after.trusted id :=
+  h.2 hid
+
+theorem trans {a b c : VerifyWorld} {ids ids' : KId .anon → Prop}
+    (hab : Promotes a ids b) (hbc : Promotes b ids' c) :
+    Promotes a (fun id => ids id ∨ ids' id) c := by
+  refine ⟨hab.1.trans hbc.1, ?_⟩
+  intro id hid
+  rcases hid with hid | hid
+  · exact hbc.1.trusted (hab.2 hid)
+  · exact hbc.2 hid
+
+end Promotes
+
+/-- Admit one pending standalone declaration.  The declaration-WF argument is
+unavoidable and explicit: it is the new fact supplied by checker success.
+The concrete `KEnv` is not mutated. -/
+theorem TrustedCatalogRel.promote
+    {trProj : RawProjRel} {world : VerifyWorld} {id : KId .anon}
+    {d : VDecl} {venv' : VEnv}
+    (hrel : TrustedCatalogRel trProj world)
+    (hpending : PendingDecl trProj world id d)
+    (hwf : VDecl.WF world.venv d venv') :
+    ∃ world',
+      Promotes world (fun target => target = id) world' ∧
+      TrustedCatalogRel trProj world' ∧
+      TrustedDecl trProj world' id d := by
+  obtain ⟨c, hcat, hraw, huntrusted, hclosed, hfresh⟩ := hpending
+  have hle : world.venv ≤ venv' := RawDeclRel.wf_le hraw hwf
+  let world' : VerifyWorld :=
+    { catalog := world.catalog
+      trusted := TrustInsert world.trusted id
+      venv := venv'
+      nameOf := world.nameOf
+      venvWF := by
+        obtain ⟨ds, hds⟩ := world.venvWF
+        exact ⟨_, .decl hwf hds⟩
+      trustedCatalogued := by
+        intro target htrusted
+        change target = id ∨ world.trusted target at htrusted
+        rcases htrusted with hnew | hold
+        · subst target
+          exact ⟨c, hcat⟩
+        · exact world.trustedCatalogued hold }
+  refine ⟨world', ?_, ?_, ?_⟩
+  · refine ⟨⟨rfl, rfl, ?_, hle⟩, ?_⟩
+    · intro target hold
+      exact TrustInsert.old hold
+    · intro target htarget
+      subst target
+      exact TrustInsert.self
+  · exact TrustedCatalogLog.promote hrel hcat hraw hclosed huntrusted hwf
+  · exact ⟨c, world.venv, venv', hcat, hraw.mono hle,
+      TrustInsert.self, hwf, VEnv.LE.rfl⟩
+
+/-- The G1b ill-typed pending world already satisfies the G1c trusted-log
+invariant: its catalog entry remains completely outside the empty log. -/
+theorem IllTypedPending.trustedCatalogRel :
+    TrustedCatalogRel RawProjRel.none IllTypedPending.world :=
+  TrustedCatalogLog.empty
+
+/-! ### Executable-shape promotion fixture -/
+
+namespace WellTypedPromotion
+
+def targetName : Lean.Name := `Ix.Tc.Verify.wellTypedPromotion
+
+def fixtureAddress : Address :=
+  ⟨⟨Array.replicate 32 1⟩⟩
+
+def targetId : KId .anon := ⟨fixtureAddress, ()⟩
+
+def level : KUniv .anon := .zero fixtureAddress
+
+def exprInfo : ExprInfo .anon where
+  addr := fixtureAddress
+  lbr := 0
+  count0 := 0
+  hasFVars := false
+  mdata := ()
+  metaAddr := ()
+
+def sourceType : KExpr .anon := .sort level exprInfo
+
+def concrete : KConst .anon := .axio () () false 0 sourceType
+
+def theoryConstant : VConstVal where
+  name := targetName
+  uvars := 0
+  type := .sort .zero
+
+def theoryDecl : VDecl := .axiom theoryConstant
+
+def catalog : Catalog := fun _ => some concrete
+
+def world : VerifyWorld where
+  catalog := catalog
+  trusted := fun _ => False
+  venv := .empty
+  nameOf := fun _ => some targetName
+  venvWF := ⟨[], .empty⟩
+  trustedCatalogued := fun {_} h => False.elim h
+
+def promotedVEnv : VEnv where
+  constants := fun name =>
+    if targetName = name then some theoryConstant.toVConstant else none
+  defeqs := fun _ => False
+
+theorem raw : RawDeclRel world.venv world.nameOf RawProjRel.none
+    targetId concrete theoryDecl := by
+  apply RawDeclRel.axiom rfl
+  exact RawExprRel.sort
+
+theorem pending : PendingDecl RawProjRel.none world targetId theoryDecl := by
+  refine ⟨concrete, rfl, raw, (fun h => h), ?_, ?_⟩
+  · intro id href
+    exact ⟨concrete, rfl⟩
+  · intro name hname
+    rfl
+
+theorem theoryConstant_wf :
+    theoryConstant.toVConstant.WF world.venv := by
+  exact ⟨.succ .zero, Lean4Lean.VEnv.HasType.sort (l := .zero) trivial⟩
+
+theorem addConst :
+    world.venv.addConst targetName theoryConstant.toVConstant =
+      some promotedVEnv := by
+  rfl
+
+theorem declWF : VDecl.WF world.venv theoryDecl promotedVEnv :=
+  .axiom theoryConstant_wf addConst
+
+theorem trustedCatalogRel :
+    TrustedCatalogRel RawProjRel.none world :=
+  TrustedCatalogLog.empty
+
+/-- Positive G1c fixture: supplying the new WF derivation promotes exactly
+the pending id and immediately yields trusted lookup evidence. -/
+theorem promotes :
+    ∃ world',
+      Promotes world (fun target => target = targetId) world' ∧
+      TrustedCatalogRel RawProjRel.none world' ∧
+      TrustedDecl RawProjRel.none world' targetId theoryDecl :=
+  TrustedCatalogRel.promote trustedCatalogRel pending declWF
+
+end WellTypedPromotion
+
 end Ix.Tc
diff --git a/Ix/Tc/Verify/Execution.lean b/Ix/Tc/Verify/Execution.lean
new file mode 100644
index 00000000..7c801e98
--- /dev/null
+++ b/Ix/Tc/Verify/Execution.lean
@@ -0,0 +1,132 @@
+import Ix.Tc.Verify.Support
+
+/-!
+# G3b: execution-indexed finite run assumptions
+
+An explicit request list is not evidence that it describes a checker run:
+choosing `[]` would make coverage and bounds vacuous. `ExecutionRequests` is
+therefore indexed by the actual `TcM` computation *and its concrete initial
+state*. Its atomic constructors are the audited interning operations, its
+composition constructors follow the actual success/error state transition,
+and it deliberately has no constructor for an arbitrary silent computation.
+
+This module intentionally imports no translation/world layer. Statement
+skeletons can use its concrete execution and support boundary without
+colliding with their temporary translation-relation placeholders.
+-/
+
+namespace Ix.Tc
+
+/-- A proof-level decomposition of a `TcM` computation into audited
+interning operations. Lists conservatively include all continuation/handler
+branches and may be finitely weakened. -/
+inductive ExecutionRequests : {α : Type} →
+    TcM .anon α → TcState .anon → List WalkerRequest → Prop where
+  | pure (s : TcState .anon) (a : α) :
+      ExecutionRequests (Pure.pure a : TcM .anon α) s []
+  | throw (s : TcState .anon) (err : TcError .anon) :
+      ExecutionRequests (throw err : TcM .anon α) s []
+  | get (s : TcState .anon) :
+      ExecutionRequests (get : TcM .anon (TcState .anon)) s []
+  | set (initial target : TcState .anon) :
+      ExecutionRequests (set target : TcM .anon PUnit) initial []
+  | modifyGet (s : TcState .anon)
+      (f : TcState .anon → α × TcState .anon) :
+      ExecutionRequests (modifyGet f : TcM .anon α) s []
+  | internExpr (s : TcState .anon) (e : KExpr .anon) :
+      ExecutionRequests (TcM.intern e) s [.internExpr e]
+  | internUniv (s : TcState .anon) (u : KUniv .anon) :
+      ExecutionRequests (TcM.internUniv u) s [.internUniv u]
+  | lift (s : TcState .anon) (e : KExpr .anon)
+      (shift cutoff : UInt64) :
+      ExecutionRequests (TcM.runIntern (lift e shift cutoff)) s
+        [.lift e shift cutoff]
+  | subst (s : TcState .anon) (body arg : KExpr .anon) (depth : UInt64) :
+      ExecutionRequests (TcM.runIntern (subst body arg depth)) s
+        [.subst body arg depth]
+  | simulSubst (s : TcState .anon) (body : KExpr .anon)
+      (substs : Array (KExpr .anon)) (depth : UInt64) :
+      ExecutionRequests (TcM.runIntern (simulSubst body substs depth)) s
+        [.simulSubst body substs depth]
+  | instRev (s : TcState .anon) (body : KExpr .anon)
+      (fvars : Array (KExpr .anon)) :
+      ExecutionRequests (TcM.runIntern (instantiateRev body fvars)) s
+        [.instRev body fvars]
+  | abstractFVars (s : TcState .anon) (body : KExpr .anon)
+      (fvars : Array FVarId) :
+      ExecutionRequests (TcM.runIntern (abstractFVars body fvars)) s
+        [.abstractFVars body fvars]
+  | instUniv (s : TcState .anon) (e : KExpr .anon)
+      (us : Array (KUniv .anon)) :
+      ExecutionRequests (TcM.instantiateUnivParams e us) s
+        [.instUniv e us]
+  | bind {s : TcState .anon} {x : TcM .anon α}
+      {f : α → TcM .anon β}
+      {before after : List WalkerRequest}
+      (hx : ExecutionRequests x s before)
+      (hf : ∀ a s', x s = .ok a s' →
+        ExecutionRequests (f a) s' after) :
+      ExecutionRequests (x >>= f) s (before ++ after)
+  | tryCatch {s : TcState .anon} {x : TcM .anon α}
+      {handler : TcError .anon → TcM .anon α}
+      {body caught : List WalkerRequest}
+      (hx : ExecutionRequests x s body)
+      (hh : ∀ err s', x s = .error err s' →
+        ExecutionRequests (handler err) s' caught) :
+      ExecutionRequests (EStateM.tryCatch x handler) s (body ++ caught)
+  | weaken {s : TcState .anon} {x : TcM .anon α}
+      {used planned : List WalkerRequest}
+      (hx : ExecutionRequests x s used)
+      (hsub : ∀ request, request ∈ used → request ∈ planned) :
+      ExecutionRequests x s planned
+  | of_eq {s : TcState .anon} {x y : TcM .anon α}
+      {requests : List WalkerRequest}
+      (hxy : x = y) (hy : ExecutionRequests y s requests) :
+      ExecutionRequests x s requests
+
+namespace ExecutionRequests
+
+theorem pure_weaken (s : TcState .anon) (a : α)
+    (requests : List WalkerRequest) :
+    ExecutionRequests (Pure.pure a : TcM .anon α) s requests :=
+  .weaken (.pure s a) (by simp)
+
+theorem throw_weaken (s : TcState .anon) (err : TcError .anon)
+    (requests : List WalkerRequest) :
+    ExecutionRequests (MonadExcept.throw err : TcM .anon α) s requests :=
+  .weaken (ExecutionRequests.throw s err) (by
+    intro request h
+    simp at h)
+
+end ExecutionRequests
+
+/-- All finite-support assumptions for one concrete computation. The exact
+same request-list index occurs in every field. -/
+structure RunAssumptions {α : Type} (initial : TcState .anon)
+    (program : TcM .anon α) (requests : List WalkerRequest)
+    (support : RunSupport) : Prop where
+  execution : ExecutionRequests program initial requests
+  collisionFree : support.CollisionFree
+  coverage : CheckConstSupport initial.env.intern requests support
+  bounds : ResourceBounds requests
+
+namespace RunAssumptions
+
+theorem initial {α : Type} {initial : TcState .anon}
+    {program : TcM .anon α} {requests : List WalkerRequest}
+    {support : RunSupport}
+    (h : RunAssumptions initial program requests support) :
+    support.CoversIntern initial.env.intern :=
+  h.coverage.initial
+
+theorem requestBounds {α : Type} {initial : TcState .anon}
+    {program : TcM .anon α} {requests : List WalkerRequest}
+    {support : RunSupport}
+    (h : RunAssumptions initial program requests support)
+    {request : WalkerRequest} (hmem : request ∈ requests) :
+    request.Bounds :=
+  h.bounds.request request hmem
+
+end RunAssumptions
+
+end Ix.Tc
diff --git a/Ix/Tc/Verify/Frame.lean b/Ix/Tc/Verify/Frame.lean
new file mode 100644
index 00000000..76107197
--- /dev/null
+++ b/Ix/Tc/Verify/Frame.lean
@@ -0,0 +1,834 @@
+import Ix.Tc.Verify.Subst
+
+/-!
+# Intern-table frame lemmas
+
+The expression walkers in `Ix.Tc.Subst` mutate only the expression side of
+`InternTable`.  Their semantic master theorems establish expression support
+and table well-formedness, but the run-scoped invariant also tracks the finite
+universe range.  This file proves the missing operational frame directly from
+the walker definitions: every persistent write is `internExpr`, whose universe
+map is unchanged.
+
+The small effect predicates make sequential state threading explicit.  They
+are intentionally restricted to anon mode, matching the verified kernel.
+-/
+
+namespace Ix.Tc
+
+/-- An `InternM` action leaves the universe intern map unchanged. -/
+def InternPreservesUnivs (x : InternM .anon α) : Prop :=
+  ∀ it, (x it).2.univs = it.univs
+
+/-- A cached walker leaves the universe intern map unchanged (scratch is
+irrelevant and may change). -/
+def WalkPreservesUnivs (x : WalkM .anon α) : Prop :=
+  ∀ it sc, (x (it, sc)).2.1.univs = it.univs
+
+namespace InternPreservesUnivs
+
+theorem pure (a : α) : InternPreservesUnivs (pure a) := by
+  intro it
+  rfl
+
+theorem runWalk {x : WalkM .anon α} (h : WalkPreservesUnivs x) :
+    InternPreservesUnivs (Ix.Tc.runWalk x) := by
+  intro it
+  exact h it {}
+
+end InternPreservesUnivs
+
+namespace WalkPreservesUnivs
+
+theorem pure (a : α) : WalkPreservesUnivs (pure a) := by
+  intro it sc
+  rfl
+
+theorem bind {x : WalkM .anon α} {f : α → WalkM .anon β}
+    (hx : WalkPreservesUnivs x)
+    (hf : ∀ a, WalkPreservesUnivs (f a)) :
+    WalkPreservesUnivs (x >>= f) := by
+  intro it sc
+  change (f (x (it, sc)).1 (x (it, sc)).2).2.1.univs = it.univs
+  exact (hf _ _ _).trans (hx _ _)
+
+theorem scratchGet (key : Address × UInt64) :
+    WalkPreservesUnivs (Ix.Tc.scratchGet? key) := by
+  intro it sc
+  rfl
+
+theorem scratchInsert (key : Address × UInt64) (e : KExpr .anon) :
+    WalkPreservesUnivs (Ix.Tc.scratchInsert key e) := by
+  intro it sc
+  rfl
+
+theorem liftIntern {x : InternM .anon α} (h : InternPreservesUnivs x) :
+    WalkPreservesUnivs (liftInternW x) := by
+  intro it sc
+  exact h it
+
+theorem internExpr (e : KExpr .anon) :
+    WalkPreservesUnivs (liftInternW (internExprM e)) := by
+  intro it sc
+  exact InternTable.internExpr_univs (it := it) e
+
+end WalkPreservesUnivs
+
+/-! ## Lift -/
+
+private theorem liftCached_preservesUnivs (e : KExpr .anon)
+    (shift cutoff : UInt64) :
+    WalkPreservesUnivs (liftCached e shift cutoff) := by
+  induction e generalizing cutoff with
+  | var i name info =>
+      rw [liftCached]
+      simp only
+      split
+      · exact .pure _
+      · exact .bind (.pure _) fun _ =>
+          .bind (.scratchGet _) fun
+            | some cached => .pure cached
+            | none => .bind (.pure _) fun _ => by
+              split
+              · exact .bind (.pure _) fun result =>
+                  .bind (.internExpr result) fun interned =>
+                    .bind (.scratchInsert _ interned) fun _ => .pure interned
+              · exact .bind (.scratchInsert _ _) fun _ => .pure _
+  | fvar id name info =>
+      rw [liftCached]
+      simp only
+      split
+      · exact .pure _
+      · exact .bind (.pure _) fun _ =>
+          .bind (.scratchGet _) fun
+            | some cached => .pure cached
+            | none => .bind (.pure _) fun _ =>
+              .bind (.scratchInsert _ _) fun _ => .pure _
+  | sort u info =>
+      rw [liftCached]
+      simp only
+      split
+      · exact .pure _
+      · exact .bind (.pure _) fun _ =>
+          .bind (.scratchGet _) fun
+            | some cached => .pure cached
+            | none => .bind (.pure _) fun _ =>
+              .bind (.scratchInsert _ _) fun _ => .pure _
+  | const id us info =>
+      rw [liftCached]
+      simp only
+      split
+      · exact .pure _
+      · exact .bind (.pure _) fun _ =>
+          .bind (.scratchGet _) fun
+            | some cached => .pure cached
+            | none => .bind (.pure _) fun _ =>
+              .bind (.scratchInsert _ _) fun _ => .pure _
+  | app f a info ihf iha =>
+      rw [liftCached]
+      simp only
+      split
+      · exact .pure _
+      · exact .bind (.pure _) fun _ =>
+          .bind (.scratchGet _) fun
+            | some cached => .pure cached
+            | none => .bind (.pure _) fun _ =>
+              .bind (ihf cutoff) fun rf =>
+                .bind (iha cutoff) fun ra =>
+                  .bind (.pure _) fun result =>
+                    .bind (.internExpr result) fun interned =>
+                      .bind (.scratchInsert _ interned) fun _ => .pure interned
+  | lam name bi ty body info ihty ihbody =>
+      rw [liftCached]
+      simp only
+      split
+      · exact .pure _
+      · exact .bind (.pure _) fun _ =>
+          .bind (.scratchGet _) fun
+            | some cached => .pure cached
+            | none => .bind (.pure _) fun _ =>
+              .bind (ihty cutoff) fun rty =>
+                .bind (ihbody (cutoff + 1)) fun rbody =>
+                  .bind (.pure _) fun result =>
+                    .bind (.internExpr result) fun interned =>
+                      .bind (.scratchInsert _ interned) fun _ => .pure interned
+  | all name bi ty body info ihty ihbody =>
+      rw [liftCached]
+      simp only
+      split
+      · exact .pure _
+      · exact .bind (.pure _) fun _ =>
+          .bind (.scratchGet _) fun
+            | some cached => .pure cached
+            | none => .bind (.pure _) fun _ =>
+              .bind (ihty cutoff) fun rty =>
+                .bind (ihbody (cutoff + 1)) fun rbody =>
+                  .bind (.pure _) fun result =>
+                    .bind (.internExpr result) fun interned =>
+                      .bind (.scratchInsert _ interned) fun _ => .pure interned
+  | letE name ty val body nd info ihty ihval ihbody =>
+      rw [liftCached]
+      simp only
+      split
+      · exact .pure _
+      · exact .bind (.pure _) fun _ =>
+          .bind (.scratchGet _) fun
+            | some cached => .pure cached
+            | none => .bind (.pure _) fun _ =>
+              .bind (ihty cutoff) fun rty =>
+                .bind (ihval cutoff) fun rval =>
+                  .bind (ihbody (cutoff + 1)) fun rbody =>
+                    .bind (.pure _) fun result =>
+                      .bind (.internExpr result) fun interned =>
+                        .bind (.scratchInsert _ interned) fun _ => .pure interned
+  | prj id field val info ihval =>
+      rw [liftCached]
+      simp only
+      split
+      · exact .pure _
+      · exact .bind (.pure _) fun _ =>
+          .bind (.scratchGet _) fun
+            | some cached => .pure cached
+            | none => .bind (.pure _) fun _ =>
+              .bind (ihval cutoff) fun rval =>
+                .bind (.pure _) fun result =>
+                  .bind (.internExpr result) fun interned =>
+                    .bind (.scratchInsert _ interned) fun _ => .pure interned
+  | nat v blob info =>
+      rw [liftCached]
+      simp only
+      split
+      · exact .pure _
+      · exact .bind (.pure _) fun _ =>
+          .bind (.scratchGet _) fun
+            | some cached => .pure cached
+            | none => .bind (.pure _) fun _ =>
+              .bind (.scratchInsert _ _) fun _ => .pure _
+  | str v blob info =>
+      rw [liftCached]
+      simp only
+      split
+      · exact .pure _
+      · exact .bind (.pure _) fun _ =>
+          .bind (.scratchGet _) fun
+            | some cached => .pure cached
+            | none => .bind (.pure _) fun _ =>
+              .bind (.scratchInsert _ _) fun _ => .pure _
+
+theorem lift_preservesUnivs (e : KExpr .anon) (shift cutoff : UInt64) :
+    InternPreservesUnivs (lift e shift cutoff) := by
+  rw [lift]
+  split
+  · exact .pure _
+  · exact .runWalk (liftCached_preservesUnivs e shift cutoff)
+
+/-! ## Single substitution -/
+
+private theorem substCached_preservesUnivs (body arg : KExpr .anon)
+    (depth : UInt64) :
+    WalkPreservesUnivs (substCached body arg depth) := by
+  induction body generalizing depth with
+  | var i name info =>
+      rw [substCached]
+      simp only
+      split
+      · exact .pure _
+      · exact .bind (.pure _) fun _ =>
+          .bind (.scratchGet _) fun
+            | some cached => .pure cached
+            | none => .bind (.pure _) fun _ => by
+              split
+              · exact .bind (.liftIntern (lift_preservesUnivs arg depth 0))
+                  fun result =>
+                    .bind (.internExpr result) fun interned =>
+                      .bind (.scratchInsert _ interned) fun _ => .pure interned
+              · split
+                · exact .bind (.pure _) fun result =>
+                    .bind (.internExpr result) fun interned =>
+                      .bind (.scratchInsert _ interned) fun _ => .pure interned
+                · exact .bind (.scratchInsert _ _) fun _ => .pure _
+  | fvar id name info =>
+      rw [substCached]
+      simp only
+      split
+      · exact .pure _
+      · exact .bind (.pure _) fun _ =>
+          .bind (.scratchGet _) fun
+            | some cached => .pure cached
+            | none => .bind (.pure _) fun _ =>
+              .bind (.scratchInsert _ _) fun _ => .pure _
+  | sort u info =>
+      rw [substCached]
+      simp only
+      split
+      · exact .pure _
+      · exact .bind (.pure _) fun _ =>
+          .bind (.scratchGet _) fun
+            | some cached => .pure cached
+            | none => .bind (.pure _) fun _ =>
+              .bind (.scratchInsert _ _) fun _ => .pure _
+  | const id us info =>
+      rw [substCached]
+      simp only
+      split
+      · exact .pure _
+      · exact .bind (.pure _) fun _ =>
+          .bind (.scratchGet _) fun
+            | some cached => .pure cached
+            | none => .bind (.pure _) fun _ =>
+              .bind (.scratchInsert _ _) fun _ => .pure _
+  | app f a info ihf iha =>
+      rw [substCached]
+      simp only
+      split
+      · exact .pure _
+      · exact .bind (.pure _) fun _ =>
+          .bind (.scratchGet _) fun
+            | some cached => .pure cached
+            | none => .bind (.pure _) fun _ =>
+              .bind (ihf depth) fun rf =>
+                .bind (iha depth) fun ra =>
+                  .bind (.pure _) fun result =>
+                    .bind (.internExpr result) fun interned =>
+                      .bind (.scratchInsert _ interned) fun _ => .pure interned
+  | lam name bi ty inner info ihty ihinner =>
+      rw [substCached]
+      simp only
+      split
+      · exact .pure _
+      · exact .bind (.pure _) fun _ =>
+          .bind (.scratchGet _) fun
+            | some cached => .pure cached
+            | none => .bind (.pure _) fun _ =>
+              .bind (ihty depth) fun rty =>
+                .bind (ihinner (depth + 1)) fun rinner =>
+                  .bind (.pure _) fun result =>
+                    .bind (.internExpr result) fun interned =>
+                      .bind (.scratchInsert _ interned) fun _ => .pure interned
+  | all name bi ty inner info ihty ihinner =>
+      rw [substCached]
+      simp only
+      split
+      · exact .pure _
+      · exact .bind (.pure _) fun _ =>
+          .bind (.scratchGet _) fun
+            | some cached => .pure cached
+            | none => .bind (.pure _) fun _ =>
+              .bind (ihty depth) fun rty =>
+                .bind (ihinner (depth + 1)) fun rinner =>
+                  .bind (.pure _) fun result =>
+                    .bind (.internExpr result) fun interned =>
+                      .bind (.scratchInsert _ interned) fun _ => .pure interned
+  | letE name ty val inner nd info ihty ihval ihinner =>
+      rw [substCached]
+      simp only
+      split
+      · exact .pure _
+      · exact .bind (.pure _) fun _ =>
+          .bind (.scratchGet _) fun
+            | some cached => .pure cached
+            | none => .bind (.pure _) fun _ =>
+              .bind (ihty depth) fun rty =>
+                .bind (ihval depth) fun rval =>
+                  .bind (ihinner (depth + 1)) fun rinner =>
+                    .bind (.pure _) fun result =>
+                      .bind (.internExpr result) fun interned =>
+                        .bind (.scratchInsert _ interned) fun _ => .pure interned
+  | prj id field val info ihval =>
+      rw [substCached]
+      simp only
+      split
+      · exact .pure _
+      · exact .bind (.pure _) fun _ =>
+          .bind (.scratchGet _) fun
+            | some cached => .pure cached
+            | none => .bind (.pure _) fun _ =>
+              .bind (ihval depth) fun rval =>
+                .bind (.pure _) fun result =>
+                  .bind (.internExpr result) fun interned =>
+                    .bind (.scratchInsert _ interned) fun _ => .pure interned
+  | nat v blob info =>
+      rw [substCached]
+      simp only
+      split
+      · exact .pure _
+      · exact .bind (.pure _) fun _ =>
+          .bind (.scratchGet _) fun
+            | some cached => .pure cached
+            | none => .bind (.pure _) fun _ =>
+              .bind (.scratchInsert _ _) fun _ => .pure _
+  | str v blob info =>
+      rw [substCached]
+      simp only
+      split
+      · exact .pure _
+      · exact .bind (.pure _) fun _ =>
+          .bind (.scratchGet _) fun
+            | some cached => .pure cached
+            | none => .bind (.pure _) fun _ =>
+              .bind (.scratchInsert _ _) fun _ => .pure _
+
+theorem subst_preservesUnivs (body arg : KExpr .anon) (depth : UInt64) :
+    InternPreservesUnivs (subst body arg depth) := by
+  rw [subst]
+  split
+  · exact .pure _
+  · exact .runWalk (substCached_preservesUnivs body arg depth)
+
+/-! ## Simultaneous substitution -/
+
+private theorem simulSubstCached_preservesUnivs (body : KExpr .anon)
+    (substs : Array (KExpr .anon)) (depth : UInt64) :
+    WalkPreservesUnivs (simulSubstCached body substs depth) := by
+  induction body generalizing depth with
+  | var i name info =>
+      rw [simulSubstCached]
+      simp only
+      split
+      · exact .pure _
+      · exact .bind (.pure _) fun _ =>
+          .bind (.scratchGet _) fun
+            | some cached => .pure cached
+            | none => .bind (.pure _) fun _ => by
+              split
+              · exact .bind (.liftIntern (lift_preservesUnivs _ depth 0))
+                  fun result =>
+                    .bind (.scratchInsert _ result) fun _ => .pure result
+              · split
+                · exact .bind (.pure _) fun result =>
+                    .bind (.internExpr result) fun interned =>
+                      .bind (.scratchInsert _ interned) fun _ => .pure interned
+                · exact .bind (.scratchInsert _ _) fun _ => .pure _
+  | fvar id name info =>
+      rw [simulSubstCached]
+      simp only
+      split
+      · exact .pure _
+      · exact .bind (.pure _) fun _ =>
+          .bind (.scratchGet _) fun
+            | some cached => .pure cached
+            | none => .bind (.pure _) fun _ =>
+              .bind (.scratchInsert _ _) fun _ => .pure _
+  | sort u info =>
+      rw [simulSubstCached]
+      simp only
+      split
+      · exact .pure _
+      · exact .bind (.pure _) fun _ =>
+          .bind (.scratchGet _) fun
+            | some cached => .pure cached
+            | none => .bind (.pure _) fun _ =>
+              .bind (.scratchInsert _ _) fun _ => .pure _
+  | const id us info =>
+      rw [simulSubstCached]
+      simp only
+      split
+      · exact .pure _
+      · exact .bind (.pure _) fun _ =>
+          .bind (.scratchGet _) fun
+            | some cached => .pure cached
+            | none => .bind (.pure _) fun _ =>
+              .bind (.scratchInsert _ _) fun _ => .pure _
+  | app f a info ihf iha =>
+      rw [simulSubstCached]
+      simp only
+      split
+      · exact .pure _
+      · exact .bind (.pure _) fun _ =>
+          .bind (.scratchGet _) fun
+            | some cached => .pure cached
+            | none => .bind (.pure _) fun _ =>
+              .bind (ihf depth) fun rf =>
+                .bind (iha depth) fun ra =>
+                  .bind (.pure _) fun result =>
+                    .bind (.internExpr result) fun interned =>
+                      .bind (.scratchInsert _ interned) fun _ => .pure interned
+  | lam name bi ty inner info ihty ihinner =>
+      rw [simulSubstCached]
+      simp only
+      split
+      · exact .pure _
+      · exact .bind (.pure _) fun _ =>
+          .bind (.scratchGet _) fun
+            | some cached => .pure cached
+            | none => .bind (.pure _) fun _ =>
+              .bind (ihty depth) fun rty =>
+                .bind (ihinner (depth + 1)) fun rinner =>
+                  .bind (.pure _) fun result =>
+                    .bind (.internExpr result) fun interned =>
+                      .bind (.scratchInsert _ interned) fun _ => .pure interned
+  | all name bi ty inner info ihty ihinner =>
+      rw [simulSubstCached]
+      simp only
+      split
+      · exact .pure _
+      · exact .bind (.pure _) fun _ =>
+          .bind (.scratchGet _) fun
+            | some cached => .pure cached
+            | none => .bind (.pure _) fun _ =>
+              .bind (ihty depth) fun rty =>
+                .bind (ihinner (depth + 1)) fun rinner =>
+                  .bind (.pure _) fun result =>
+                    .bind (.internExpr result) fun interned =>
+                      .bind (.scratchInsert _ interned) fun _ => .pure interned
+  | letE name ty val inner nd info ihty ihval ihinner =>
+      rw [simulSubstCached]
+      simp only
+      split
+      · exact .pure _
+      · exact .bind (.pure _) fun _ =>
+          .bind (.scratchGet _) fun
+            | some cached => .pure cached
+            | none => .bind (.pure _) fun _ =>
+              .bind (ihty depth) fun rty =>
+                .bind (ihval depth) fun rval =>
+                  .bind (ihinner (depth + 1)) fun rinner =>
+                    .bind (.pure _) fun result =>
+                      .bind (.internExpr result) fun interned =>
+                        .bind (.scratchInsert _ interned) fun _ => .pure interned
+  | prj id field val info ihval =>
+      rw [simulSubstCached]
+      simp only
+      split
+      · exact .pure _
+      · exact .bind (.pure _) fun _ =>
+          .bind (.scratchGet _) fun
+            | some cached => .pure cached
+            | none => .bind (.pure _) fun _ =>
+              .bind (ihval depth) fun rval =>
+                .bind (.pure _) fun result =>
+                  .bind (.internExpr result) fun interned =>
+                    .bind (.scratchInsert _ interned) fun _ => .pure interned
+  | nat v blob info =>
+      rw [simulSubstCached]
+      simp only
+      split
+      · exact .pure _
+      · exact .bind (.pure _) fun _ =>
+          .bind (.scratchGet _) fun
+            | some cached => .pure cached
+            | none => .bind (.pure _) fun _ =>
+              .bind (.scratchInsert _ _) fun _ => .pure _
+  | str v blob info =>
+      rw [simulSubstCached]
+      simp only
+      split
+      · exact .pure _
+      · exact .bind (.pure _) fun _ =>
+          .bind (.scratchGet _) fun
+            | some cached => .pure cached
+            | none => .bind (.pure _) fun _ =>
+              .bind (.scratchInsert _ _) fun _ => .pure _
+
+theorem simulSubst_preservesUnivs (body : KExpr .anon)
+    (substs : Array (KExpr .anon)) (depth : UInt64) :
+    InternPreservesUnivs (simulSubst body substs depth) := by
+  rw [simulSubst]
+  split
+  · exact .pure _
+  · exact .runWalk (simulSubstCached_preservesUnivs body substs depth)
+
+/-! ## Reverse instantiation -/
+
+private theorem instantiateRevCached_preservesUnivs (body : KExpr .anon)
+    (fvars : Array (KExpr .anon)) (depth : UInt64) :
+    WalkPreservesUnivs (instantiateRevCached body fvars depth) := by
+  induction body generalizing depth with
+  | var i name info =>
+      rw [instantiateRevCached]
+      simp only
+      split
+      · exact .pure _
+      · exact .bind (.pure _) fun _ =>
+          .bind (.scratchGet _) fun
+            | some cached => .pure cached
+            | none => .bind (.pure _) fun _ => by
+              split
+              · exact .bind (.scratchInsert _ _) fun _ => .pure _
+              · split
+                · exact .bind (.pure _) fun result =>
+                    .bind (.internExpr result) fun interned =>
+                      .bind (.scratchInsert _ interned) fun _ => .pure interned
+                · exact .bind (.scratchInsert _ _) fun _ => .pure _
+  | fvar id name info =>
+      rw [instantiateRevCached]
+      simp only
+      split
+      · exact .pure _
+      · exact .bind (.pure _) fun _ =>
+          .bind (.scratchGet _) fun
+            | some cached => .pure cached
+            | none => .bind (.pure _) fun _ =>
+              .bind (.scratchInsert _ _) fun _ => .pure _
+  | sort u info =>
+      rw [instantiateRevCached]
+      simp only
+      split
+      · exact .pure _
+      · exact .bind (.pure _) fun _ =>
+          .bind (.scratchGet _) fun
+            | some cached => .pure cached
+            | none => .bind (.pure _) fun _ =>
+              .bind (.scratchInsert _ _) fun _ => .pure _
+  | const id us info =>
+      rw [instantiateRevCached]
+      simp only
+      split
+      · exact .pure _
+      · exact .bind (.pure _) fun _ =>
+          .bind (.scratchGet _) fun
+            | some cached => .pure cached
+            | none => .bind (.pure _) fun _ =>
+              .bind (.scratchInsert _ _) fun _ => .pure _
+  | app f a info ihf iha =>
+      rw [instantiateRevCached]
+      simp only
+      split
+      · exact .pure _
+      · exact .bind (.pure _) fun _ =>
+          .bind (.scratchGet _) fun
+            | some cached => .pure cached
+            | none => .bind (.pure _) fun _ =>
+              .bind (ihf depth) fun rf =>
+                .bind (iha depth) fun ra =>
+                  .bind (.pure _) fun result =>
+                    .bind (.internExpr result) fun interned =>
+                      .bind (.scratchInsert _ interned) fun _ => .pure interned
+  | lam name bi ty inner info ihty ihinner =>
+      rw [instantiateRevCached]
+      simp only
+      split
+      · exact .pure _
+      · exact .bind (.pure _) fun _ =>
+          .bind (.scratchGet _) fun
+            | some cached => .pure cached
+            | none => .bind (.pure _) fun _ =>
+              .bind (ihty depth) fun rty =>
+                .bind (ihinner (depth + 1)) fun rinner =>
+                  .bind (.pure _) fun result =>
+                    .bind (.internExpr result) fun interned =>
+                      .bind (.scratchInsert _ interned) fun _ => .pure interned
+  | all name bi ty inner info ihty ihinner =>
+      rw [instantiateRevCached]
+      simp only
+      split
+      · exact .pure _
+      · exact .bind (.pure _) fun _ =>
+          .bind (.scratchGet _) fun
+            | some cached => .pure cached
+            | none => .bind (.pure _) fun _ =>
+              .bind (ihty depth) fun rty =>
+                .bind (ihinner (depth + 1)) fun rinner =>
+                  .bind (.pure _) fun result =>
+                    .bind (.internExpr result) fun interned =>
+                      .bind (.scratchInsert _ interned) fun _ => .pure interned
+  | letE name ty val inner nd info ihty ihval ihinner =>
+      rw [instantiateRevCached]
+      simp only
+      split
+      · exact .pure _
+      · exact .bind (.pure _) fun _ =>
+          .bind (.scratchGet _) fun
+            | some cached => .pure cached
+            | none => .bind (.pure _) fun _ =>
+              .bind (ihty depth) fun rty =>
+                .bind (ihval depth) fun rval =>
+                  .bind (ihinner (depth + 1)) fun rinner =>
+                    .bind (.pure _) fun result =>
+                      .bind (.internExpr result) fun interned =>
+                        .bind (.scratchInsert _ interned) fun _ => .pure interned
+  | prj id field val info ihval =>
+      rw [instantiateRevCached]
+      simp only
+      split
+      · exact .pure _
+      · exact .bind (.pure _) fun _ =>
+          .bind (.scratchGet _) fun
+            | some cached => .pure cached
+            | none => .bind (.pure _) fun _ =>
+              .bind (ihval depth) fun rval =>
+                .bind (.pure _) fun result =>
+                  .bind (.internExpr result) fun interned =>
+                    .bind (.scratchInsert _ interned) fun _ => .pure interned
+  | nat v blob info =>
+      rw [instantiateRevCached]
+      simp only
+      split
+      · exact .pure _
+      · exact .bind (.pure _) fun _ =>
+          .bind (.scratchGet _) fun
+            | some cached => .pure cached
+            | none => .bind (.pure _) fun _ =>
+              .bind (.scratchInsert _ _) fun _ => .pure _
+  | str v blob info =>
+      rw [instantiateRevCached]
+      simp only
+      split
+      · exact .pure _
+      · exact .bind (.pure _) fun _ =>
+          .bind (.scratchGet _) fun
+            | some cached => .pure cached
+            | none => .bind (.pure _) fun _ =>
+              .bind (.scratchInsert _ _) fun _ => .pure _
+
+theorem instantiateRev_preservesUnivs (body : KExpr .anon)
+    (fvars : Array (KExpr .anon)) :
+    InternPreservesUnivs (instantiateRev body fvars) := by
+  rw [instantiateRev]
+  split
+  · exact .pure _
+  · exact .runWalk (instantiateRevCached_preservesUnivs body fvars 0)
+
+/-! ## Free-variable abstraction -/
+
+private theorem abstractFVarsCached_preservesUnivs (body : KExpr .anon)
+    (pos : Std.HashMap FVarId UInt64) (n depth : UInt64) :
+    WalkPreservesUnivs (abstractFVarsCached body pos n depth) := by
+  induction body generalizing depth with
+  | var i name info =>
+      rw [abstractFVarsCached]
+      simp only
+      split
+      · exact .pure _
+      · exact .bind (.pure _) fun _ =>
+          .bind (.scratchGet _) fun
+            | some cached => .pure cached
+            | none => .bind (.pure _) fun _ => by
+              split
+              · exact .bind (.pure _) fun result =>
+                  .bind (.internExpr result) fun interned =>
+                    .bind (.scratchInsert _ interned) fun _ => .pure interned
+              · exact .bind (.scratchInsert _ _) fun _ => .pure _
+  | fvar id name info =>
+      rw [abstractFVarsCached]
+      simp only
+      split
+      · exact .pure _
+      · exact .bind (.pure _) fun _ =>
+          .bind (.scratchGet _) fun
+            | some cached => .pure cached
+            | none => .bind (.pure _) fun _ => by
+              split
+              · exact .bind (.internExpr _) fun interned =>
+                  .bind (.scratchInsert _ interned) fun _ => .pure interned
+              · exact .bind (.scratchInsert _ _) fun _ => .pure _
+  | sort u info =>
+      rw [abstractFVarsCached]
+      simp only
+      split
+      · exact .pure _
+      · exact .bind (.pure _) fun _ =>
+          .bind (.scratchGet _) fun
+            | some cached => .pure cached
+            | none => .bind (.pure _) fun _ =>
+              .bind (.scratchInsert _ _) fun _ => .pure _
+  | const id us info =>
+      rw [abstractFVarsCached]
+      simp only
+      split
+      · exact .pure _
+      · exact .bind (.pure _) fun _ =>
+          .bind (.scratchGet _) fun
+            | some cached => .pure cached
+            | none => .bind (.pure _) fun _ =>
+              .bind (.scratchInsert _ _) fun _ => .pure _
+  | app f a info ihf iha =>
+      rw [abstractFVarsCached]
+      simp only
+      split
+      · exact .pure _
+      · exact .bind (.pure _) fun _ =>
+          .bind (.scratchGet _) fun
+            | some cached => .pure cached
+            | none => .bind (.pure _) fun _ =>
+              .bind (ihf depth) fun rf =>
+                .bind (iha depth) fun ra =>
+                  .bind (.pure _) fun result =>
+                    .bind (.internExpr result) fun interned =>
+                      .bind (.scratchInsert _ interned) fun _ => .pure interned
+  | lam name bi ty inner info ihty ihinner =>
+      rw [abstractFVarsCached]
+      simp only
+      split
+      · exact .pure _
+      · exact .bind (.pure _) fun _ =>
+          .bind (.scratchGet _) fun
+            | some cached => .pure cached
+            | none => .bind (.pure _) fun _ =>
+              .bind (ihty depth) fun rty =>
+                .bind (ihinner (depth + 1)) fun rinner =>
+                  .bind (.pure _) fun result =>
+                    .bind (.internExpr result) fun interned =>
+                      .bind (.scratchInsert _ interned) fun _ => .pure interned
+  | all name bi ty inner info ihty ihinner =>
+      rw [abstractFVarsCached]
+      simp only
+      split
+      · exact .pure _
+      · exact .bind (.pure _) fun _ =>
+          .bind (.scratchGet _) fun
+            | some cached => .pure cached
+            | none => .bind (.pure _) fun _ =>
+              .bind (ihty depth) fun rty =>
+                .bind (ihinner (depth + 1)) fun rinner =>
+                  .bind (.pure _) fun result =>
+                    .bind (.internExpr result) fun interned =>
+                      .bind (.scratchInsert _ interned) fun _ => .pure interned
+  | letE name ty val inner nd info ihty ihval ihinner =>
+      rw [abstractFVarsCached]
+      simp only
+      split
+      · exact .pure _
+      · exact .bind (.pure _) fun _ =>
+          .bind (.scratchGet _) fun
+            | some cached => .pure cached
+            | none => .bind (.pure _) fun _ =>
+              .bind (ihty depth) fun rty =>
+                .bind (ihval depth) fun rval =>
+                  .bind (ihinner (depth + 1)) fun rinner =>
+                    .bind (.pure _) fun result =>
+                      .bind (.internExpr result) fun interned =>
+                        .bind (.scratchInsert _ interned) fun _ => .pure interned
+  | prj id field val info ihval =>
+      rw [abstractFVarsCached]
+      simp only
+      split
+      · exact .pure _
+      · exact .bind (.pure _) fun _ =>
+          .bind (.scratchGet _) fun
+            | some cached => .pure cached
+            | none => .bind (.pure _) fun _ =>
+              .bind (ihval depth) fun rval =>
+                .bind (.pure _) fun result =>
+                  .bind (.internExpr result) fun interned =>
+                    .bind (.scratchInsert _ interned) fun _ => .pure interned
+  | nat v blob info =>
+      rw [abstractFVarsCached]
+      simp only
+      split
+      · exact .pure _
+      · exact .bind (.pure _) fun _ =>
+          .bind (.scratchGet _) fun
+            | some cached => .pure cached
+            | none => .bind (.pure _) fun _ =>
+              .bind (.scratchInsert _ _) fun _ => .pure _
+  | str v blob info =>
+      rw [abstractFVarsCached]
+      simp only
+      split
+      · exact .pure _
+      · exact .bind (.pure _) fun _ =>
+          .bind (.scratchGet _) fun
+            | some cached => .pure cached
+            | none => .bind (.pure _) fun _ =>
+              .bind (.scratchInsert _ _) fun _ => .pure _
+
+theorem abstractFVars_preservesUnivs (body : KExpr .anon)
+    (fvars : Array FVarId) :
+    InternPreservesUnivs (abstractFVars body fvars) := by
+  rw [abstractFVars]
+  split
+  · exact .pure _
+  · exact .runWalk (abstractFVarsCached_preservesUnivs body _ _ 0)
+
+end Ix.Tc
diff --git a/Ix/Tc/Verify/Inductive.lean b/Ix/Tc/Verify/Inductive.lean
new file mode 100644
index 00000000..6f911f16
--- /dev/null
+++ b/Ix/Tc/Verify/Inductive.lean
@@ -0,0 +1,162 @@
+import Ix.Tc.Verify.Decl
+
+/-!
+# Ambient inductive oracle
+
+Lean4Lean currently leaves both `VInductDecl.WF` and `VEnv.addInduct` as
+opaque `sorry` definitions.  Requiring an equation involving that operation
+here would make the ambient-inductive precondition impossible to instantiate
+without adding another axiom.  G2 therefore records the semantic consequences
+needed by the checker directly:
+
+* every admitted concrete inductive-family constant has an exact raw Theory
+  translation and lookup;
+* its Theory constant is well-formed;
+* the post-environment is well-formed and extends the prior environment;
+* every concrete recursor rule has an explicit, well-formed Theory defeq
+  witness headed by that recursor.
+
+`InductiveOracle` is an explicit assumption boundary, not a claim that Ix's
+inductive checker has already been verified.  The later inductive milestone
+must construct this interface from block checking and a completed
+Lean4Lean `addInduct` specification.  Keeping the interface in terms of
+semantic consequences permits a closed Nat model with no new Lean axiom now,
+while the recursor clause prevents future whnf proofs from treating
+computation rules as an unrecorded ambient fact.
+-/
+
+namespace Ix.Tc
+
+open Lean4Lean (VConstant VDefEq VEnv VExpr)
+
+/-- Concrete declaration kinds admitted through an ambient inductive block.
+Standalone declarations and quotients cannot cross this boundary. -/
+def KConst.IsInductiveMember : KConst .anon → Prop
+  | .indc .. | .ctor .. | .recr .. => True
+  | _ => False
+
+/-- Membership of a concrete rule in a recursor declaration. -/
+def KConst.HasRecursorRule (c : KConst .anon) (rule : RecRule .anon) : Prop :=
+  match c with
+  | .recr (rules := rules) .. => rule ∈ rules
+  | _ => False
+
+/-- A Theory expression is an application spine headed by `name`. -/
+inductive HeadConst (name : Lean.Name) : VExpr → Prop
+  | const (levels : List Lean4Lean.VLevel) :
+    HeadConst name (.const name levels)
+  | app {fn arg : VExpr} : HeadConst name fn → HeadConst name (.app fn arg)
+
+/-- Raw translation of one constant supplied by an ambient inductive block.
+There is intentionally no block-typing derivation here; that semantic fact is
+the oracle boundary. -/
+structure RawInductiveConstRel (env : VEnv)
+    (nameOf : Address → Option Lean.Name) (trProj : RawProjRel)
+    (id : KId .anon) (c : KConst .anon) (name : Lean.Name)
+    (ci : VConstant) : Prop where
+  kind : c.IsInductiveMember
+  nameEq : nameOf id.addr = some name
+  uvars : c.lvls.toNat = ci.uvars
+  type : RawExprRel env nameOf trProj [] c.ty ci.type
+
+namespace RawInductiveConstRel
+
+theorem mono {env env' : VEnv} (henv : env ≤ env')
+    {nameOf : Address → Option Lean.Name} {trProj : RawProjRel}
+    {id : KId .anon} {c : KConst .anon} {name : Lean.Name}
+    {ci : VConstant}
+    (h : RawInductiveConstRel env nameOf trProj id c name ci) :
+    RawInductiveConstRel env' nameOf trProj id c name ci :=
+  ⟨h.kind, h.nameEq, h.uvars, h.type.mono henv⟩
+
+end RawInductiveConstRel
+
+/-- Semantic evidence for one concrete recursor rule.  The registered Theory
+defeq is well-formed, its left side is headed by the translated recursor, and
+its right side is the raw translation of the concrete rule body.  K1 will
+refine the exact argument-spine correspondence used by reduction. -/
+def RawRecursorRuleRel (env : VEnv)
+    (nameOf : Address → Option Lean.Name) (trProj : RawProjRel)
+    (id : KId .anon) (c : KConst .anon) (rule : RecRule .anon) : Prop :=
+  ∃ name constant defeq,
+    RawInductiveConstRel env nameOf trProj id c name constant ∧
+    env.constants name = some constant ∧
+    env.defeqs defeq ∧
+    defeq.WF env ∧
+    HeadConst name defeq.lhs ∧
+    RawExprRel env nameOf trProj [] rule.rhs defeq.rhs
+
+namespace RawRecursorRuleRel
+
+theorem mono {env env' : VEnv} (henv : env ≤ env')
+    {nameOf : Address → Option Lean.Name} {trProj : RawProjRel}
+    {id : KId .anon} {c : KConst .anon} {rule : RecRule .anon}
+    (h : RawRecursorRuleRel env nameOf trProj id c rule) :
+    RawRecursorRuleRel env' nameOf trProj id c rule := by
+  obtain ⟨name, constant, defeq, hraw, hlookup, hregistered, hwf, hhead,
+    hrhs⟩ := h
+  exact ⟨name, constant, defeq, hraw.mono henv,
+    henv.constants hlookup, henv.defeqs hregistered, hwf.mono henv, hhead,
+    hrhs.mono henv⟩
+
+end RawRecursorRuleRel
+
+/-- One oracle-backed admission of an already-validated ambient inductive
+block.  `members` is exact for this admission step; `fresh` prevents the
+oracle from re-certifying an existing trusted id.
+
+The oracle records `before ≤ after` rather than an opaque
+`before.addInduct = some after` equation.  These are exactly the consequences
+used before E2, and unlike the unfinished upstream operation they admit real
+models. -/
+structure InductiveOracle (trProj : RawProjRel) (catalog : Catalog)
+    (nameOf : Address → Option Lean.Name) (trusted : KId .anon → Prop)
+    (before : VEnv) where
+  members : KId .anon → Prop
+  nonempty : ∃ id, members id
+  fresh : ∀ ⦃id⦄, members id → ¬trusted id
+  after : VEnv
+  envLE : before ≤ after
+  blockWF : after.WF
+  translateBlock : ∀ ⦃id⦄, members id →
+    ∃ c name ci,
+      catalog id = some c ∧
+      RawInductiveConstRel after nameOf trProj id c name ci ∧
+      after.constants name = some ci ∧
+      ci.WF after
+  recursorFacts : ∀ ⦃id c rule⦄,
+    members id → catalog id = some c → c.HasRecursorRule rule →
+      RawRecursorRuleRel after nameOf trProj id c rule
+
+namespace InductiveOracle
+
+/-- Add exactly this oracle block to the trusted predicate. -/
+def TrustBlock {trProj : RawProjRel} {catalog : Catalog}
+    {nameOf : Address → Option Lean.Name} {trusted : KId .anon → Prop}
+    {before : VEnv}
+    (oracle : InductiveOracle trProj catalog nameOf trusted before) :
+    KId .anon → Prop :=
+  fun id => oracle.members id ∨ trusted id
+
+theorem trust_member {trProj : RawProjRel} {catalog : Catalog}
+    {nameOf : Address → Option Lean.Name} {trusted : KId .anon → Prop}
+    {before : VEnv} (oracle : InductiveOracle trProj catalog nameOf trusted before)
+    {id : KId .anon} (h : oracle.members id) : oracle.TrustBlock id :=
+  Or.inl h
+
+theorem trust_old {trProj : RawProjRel} {catalog : Catalog}
+    {nameOf : Address → Option Lean.Name} {trusted : KId .anon → Prop}
+    {before : VEnv} (oracle : InductiveOracle trProj catalog nameOf trusted before)
+    {id : KId .anon} (h : trusted id) : oracle.TrustBlock id :=
+  Or.inr h
+
+theorem catalogued {trProj : RawProjRel} {catalog : Catalog}
+    {nameOf : Address → Option Lean.Name} {trusted : KId .anon → Prop}
+    {before : VEnv} (oracle : InductiveOracle trProj catalog nameOf trusted before)
+    {id : KId .anon} (h : oracle.members id) : Catalog.Contains catalog id := by
+  obtain ⟨c, _, _, hcat, _⟩ := oracle.translateBlock h
+  exact ⟨c, hcat⟩
+
+end InductiveOracle
+
+end Ix.Tc
diff --git a/Ix/Tc/Verify/InstUniv.lean b/Ix/Tc/Verify/InstUniv.lean
index 004839e5..a1f1a3dc 100644
--- a/Ix/Tc/Verify/InstUniv.lean
+++ b/Ix/Tc/Verify/InstUniv.lean
@@ -132,31 +132,33 @@ theorem InstUnivScratchInv.insert {S : KExpr .anon → Prop}
   · exact hsc _ _ hv
 
 /-- Intern-side invariant plus the frame: the table is key-coherent with
-    support inside `S`, and the rest of the checker state is untouched
+    expression support inside `S`, its universe map is unchanged, and the
+    rest of the checker state is untouched
     relative to the entry state `s₀` — the walker writes exactly
     `env.intern` (and the `StateT` memo layer, which is not part of
     `TcState`). -/
 def InstUnivStateOK (S : KExpr .anon → Prop) (s₀ s : TcState .anon) :
     Prop :=
   s.env.intern.WF ∧ (∀ x, s.env.intern.ExprSupport x → S x) ∧
+    s.env.intern.univs = s₀.env.intern.univs ∧
     s = { s₀ with env := { s₀.env with intern := s.env.intern } }
 
 theorem InstUnivStateOK.refl {S : KExpr .anon → Prop} {s : TcState .anon}
     (hwf : s.env.intern.WF) (hsup : ∀ x, s.env.intern.ExprSupport x → S x) :
     InstUnivStateOK S s s :=
-  ⟨hwf, hsup, rfl⟩
+  ⟨hwf, hsup, rfl, rfl⟩
 
 theorem InstUnivStateOK.trans {S : KExpr .anon → Prop}
     {s₀ s₁ s₂ : TcState .anon} (h₁ : InstUnivStateOK S s₀ s₁)
     (h₂ : InstUnivStateOK S s₁ s₂) : InstUnivStateOK S s₀ s₂ := by
-  refine ⟨h₂.1, h₂.2.1, ?_⟩
-  rw [h₂.2.2, h₁.2.2]
+  refine ⟨h₂.1, h₂.2.1, h₂.2.2.1.trans h₁.2.2.1, ?_⟩
+  rw [h₂.2.2.2, h₁.2.2.2]
 
 /-! ### The post-relation -/
 
 /-- What a finished walker run means, on both outcomes: on success the
     result is the spec value and every threaded invariant survives; on
-    error the state invariants and the frame still hold (EStateM is
+    error the state invariants and both frames still hold (EStateM is
     non-backtracking — the partially extended intern table survives the
     throw, and it is still key-coherent inside `S`). -/
 def InstUnivPost (S : KExpr .anon → Prop) (us : Array (KUniv .anon))
@@ -351,7 +353,7 @@ private theorem instUnivPost_jp {S : KExpr .anon → Prop}
           sc₁.insert e.addr (s₁.env.intern.internExpr cand).1)
         { s₁ with env :=
           { s₁.env with intern := (s₁.env.intern.internExpr cand).2 } }) := by
-  obtain ⟨hwf, hsup, hframe⟩ := hok
+  obtain ⟨hwf, hsup, hunivs, hframe⟩ := hok
   have hkcf : KExpr.KeyCollisionFree
       (fun v => s₁.env.intern.ExprSupport v ∨ v = cand) :=
     KExpr.keyCollisionFree_anon.mpr
@@ -361,8 +363,8 @@ private theorem instUnivPost_jp {S : KExpr .anon → Prop}
     rwa [KExpr.eraseMeta_anon, KExpr.eraseMeta_anon] at h
   refine ⟨by rw [hcanon]; exact hcand, ?_,
     hsc.insert hSe (by rw [hcanon]; exact hcand)⟩
-  refine InstUnivStateOK.trans ⟨hwf, hsup, hframe⟩
-    ⟨hwf.internExpr cand, ?_, rfl⟩
+  refine InstUnivStateOK.trans ⟨hwf, hsup, hunivs, hframe⟩
+    ⟨hwf.internExpr cand, ?_, InternTable.internExpr_univs cand, rfl⟩
   intro x hx
   rcases InternTable.ExprSupport.of_internExpr hx with h | h
   · exact hsup x h
@@ -902,9 +904,11 @@ theorem TcM.instantiateUnivParams_wf {S : KExpr .anon → Prop}
         ∀ x, s.env.intern.ExprSupport x → S x) s
       (TcM.instantiateUnivParams e us)
       (fun r s' => KExpr.instantiateUnivParamsSpec e us = .ok r ∧
-        s' = { s with env := { s.env with intern := s'.env.intern } })
+        s' = { s with env := { s.env with intern := s'.env.intern } } ∧
+        s'.env.intern.univs = s.env.intern.univs)
       (fun _ s' =>
-        s' = { s with env := { s.env with intern := s'.env.intern } }) := by
+        s' = { s with env := { s.env with intern := s'.env.intern } } ∧
+        s'.env.intern.univs = s.env.intern.univs) := by
   intro hI
   obtain ⟨hwf, hsup⟩ := hI
   by_cases hemp : us.isEmpty
@@ -913,14 +917,14 @@ theorem TcM.instantiateUnivParams_wf {S : KExpr .anon → Prop}
       try rfl
     rw [hrun]
     exact ⟨⟨hwf, hsup⟩,
-      by rw [KExpr.instantiateUnivParamsSpec, if_pos hemp], rfl⟩
+      by rw [KExpr.instantiateUnivParamsSpec, if_pos hemp], rfl, rfl⟩
   · have post := TcM.instUnivInner_spec hcf (e := e) (sc := {}) (s := s)
       hreach hwf hsup (InstUnivScratchInv.empty S us)
     cases hrec : TcM.instUnivInner e us {} s with
     | ok v s' =>
       obtain ⟨r, sc'⟩ := v
       rw [hrec] at post
-      obtain ⟨hspec, ⟨hwf', hsup', hframe⟩, -⟩ := post
+      obtain ⟨hspec, ⟨hwf', hsup', hunivs, hframe⟩, -⟩ := post
       have hrun : TcM.instantiateUnivParams e us s = .ok r s' := by
         rw [TcM.instantiateUnivParams, if_neg hemp]
         show ((TcM.instUnivInner e us).run' {}) s = _
@@ -929,17 +933,17 @@ theorem TcM.instantiateUnivParams_wf {S : KExpr .anon → Prop}
       rw [hrun]
       exact ⟨⟨hwf', hsup'⟩,
         by rw [KExpr.instantiateUnivParamsSpec, if_neg hemp]; exact hspec,
-        hframe⟩
+        hframe, hunivs⟩
     | error err s' =>
       rw [hrec] at post
-      obtain ⟨hwf', hsup', hframe⟩ := post
+      obtain ⟨hwf', hsup', hunivs, hframe⟩ := post
       have hrun : TcM.instantiateUnivParams e us s = .error err s' := by
         rw [TcM.instantiateUnivParams, if_neg hemp]
         show ((TcM.instUnivInner e us).run' {}) s = _
         rw [run_run', hrec]
         try rfl
       rw [hrun]
-      exact ⟨⟨hwf', hsup'⟩, hframe⟩
+      exact ⟨⟨hwf', hsup'⟩, hframe, hunivs⟩
 
 /-! ### `substUniv` Theory correspondence (level side)
 
diff --git a/Ix/Tc/Verify/Monad.lean b/Ix/Tc/Verify/Monad.lean
index 8de9cafe..9b01b4dd 100644
--- a/Ix/Tc/Verify/Monad.lean
+++ b/Ix/Tc/Verify/Monad.lean
@@ -13,9 +13,9 @@ success *and* error, `Q` on success, `E` on error (default trivial — most
 proofs never mention it; nontrivial `E` only at catch-and-continue sites).
 
 Scope here: the invariant is a plain predicate over `TcState`.
-Verify/State.lean upgrades this to the ghost `VState` (venv + cache
-views) with a monotone extension order; the combinator lemmas below
-carry over verbatim — only the state type enriches.
+Verify/State.lean instantiates it with a monotone `VerifyWorld` containing an
+immutable catalog and a growing trusted semantic environment; the combinator
+lemmas below carry over verbatim.
 -/
 
 namespace Ix.Tc
diff --git a/Ix/Tc/Verify/NatFixture.lean b/Ix/Tc/Verify/NatFixture.lean
new file mode 100644
index 00000000..f38feefa
--- /dev/null
+++ b/Ix/Tc/Verify/NatFixture.lean
@@ -0,0 +1,2983 @@
+import Ix.Tc.Verify.Run
+import Ix.Tc.Verify.Whnf
+
+/-!
+# G2a ambient-Nat fixture
+
+This file instantiates `InductiveOracle` with a small, closed Theory model of
+`Nat`, `Nat.zero`, and `Nat.succ`.  The concrete catalog entries retain their
+inductive/constructor kinds, while the Theory model contains the semantic
+constants those entries denote.  The constants are installed through
+object-language `VDecl.axiom` steps; those are ordinary constructors of the
+Theory judgment, not new Lean axioms.  This is deliberately an ambient model:
+it does not claim an eliminator or pretend that Lean4Lean's still-opaque
+`VEnv.addInduct` has been verified.
+
+The fixture then promotes one ordinary axiom whose type is `Nat` and leaves a
+second, raw-translatable but ill-typed axiom pending.  Thus adding an ambient
+inductive family does not collapse the pending/trusted boundary established
+in G1. G3a first instantiated finite run support for lift, substitution, and
+universe instantiation. As in the G1
+adversarial fixture, fixed distinct addresses keep this logical model
+independent of the Blake3 FFI; it establishes semantic
+inhabitation, not ingress hash-integrity or Rust parity. G3b extends that
+witness to direct expression/universe interning, every currently formalized
+walker family, and a non-empty `ExecutionRequests` certificate for the exact
+same request list.
+-/
+
+namespace Ix.Tc
+
+open Lean4Lean (VConstant VConstVal VDecl VEnv VExpr VLevel)
+
+namespace AmbientNat
+
+def address (byte : UInt8) : Address :=
+  ⟨⟨Array.replicate 32 byte⟩⟩
+
+def natAddress : Address := address 10
+def zeroAddress : Address := address 11
+def succAddress : Address := address 12
+def goodAddress : Address := address 13
+def iotaAddress : Address := address 14
+
+def natId : KId .anon := ⟨natAddress, ()⟩
+def zeroId : KId .anon := ⟨zeroAddress, ()⟩
+def succId : KId .anon := ⟨succAddress, ()⟩
+def goodId : KId .anon := ⟨goodAddress, ()⟩
+def iotaId : KId .anon := ⟨iotaAddress, ()⟩
+
+def natName : Lean.Name := `Nat
+def zeroName : Lean.Name := `Nat.zero
+def succName : Lean.Name := `Nat.succ
+def goodName : Lean.Name := `Ix.Tc.Verify.ambientNatWitness
+
+def info (addr : Address) : ExprInfo .anon where
+  addr := addr
+  lbr := 0
+  count0 := 0
+  hasFVars := false
+  mdata := ()
+  metaAddr := ()
+
+def zeroLevel : KUniv .anon := .zero natAddress
+def oneLevel : KUniv .anon := .succ zeroLevel zeroAddress
+
+def natType : KExpr .anon := .sort oneLevel (info natAddress)
+def natRef : KExpr .anon := .const natId #[] (info zeroAddress)
+def succType : KExpr .anon :=
+  .all () () natRef natRef (info succAddress)
+
+def natConcrete : KConst .anon :=
+  .indc () () 0 0 0 false natId 0 natType #[zeroId, succId] ()
+
+def zeroConcrete : KConst .anon :=
+  .ctor () () false 0 natId 0 0 0 natRef
+
+def succConcrete : KConst .anon :=
+  .ctor () () false 0 natId 1 0 1 succType
+
+def goodConcrete : KConst .anon :=
+  .axio () () false 0 natRef
+
+/-- Deliberately untrusted recursor-shaped catalog entry used by the K1e
+adversarial execution fixture.  Its rule is operationally consumable, but it
+has no `nameOf` entry and is never added to the trusted log. -/
+def iotaResult : KExpr .anon := .const zeroId #[] (info iotaAddress)
+
+def iotaRule : RecRule .anon :=
+  { ctor := (), fields := 0, rhs := iotaResult }
+
+def iotaConcrete : KConst .anon :=
+  .recr () () false false 0 0 0 0 0 natId 0 natRef #[iotaRule] ()
+
+def catalog : Catalog := fun id =>
+  if id == natId then some natConcrete
+  else if id == zeroId then some zeroConcrete
+  else if id == succId then some succConcrete
+  else if id == goodId then some goodConcrete
+  else if id == IllTypedPending.targetId then some IllTypedPending.concrete
+  else if id == iotaId then some iotaConcrete
+  else none
+
+def nameOf : Address → Option Lean.Name := fun addr =>
+  if addr == natAddress then some natName
+  else if addr == zeroAddress then some zeroName
+  else if addr == succAddress then some succName
+  else if addr == goodAddress then some goodName
+  else if addr == IllTypedPending.fixtureAddress then
+    some IllTypedPending.targetName
+  else none
+
+theorem address_ne {a b : UInt8} (h : a ≠ b) : address a ≠ address b := by
+  intro hab
+  have hbyte := congrArg (fun x : Address => x.hash.get! 0) hab
+  simp [address] at hbyte
+  exact h hbyte
+
+theorem zeroAddress_ne_natAddress : zeroAddress ≠ natAddress := by
+  exact address_ne (by decide)
+
+theorem succAddress_ne_natAddress : succAddress ≠ natAddress := by
+  exact address_ne (by decide)
+
+theorem succAddress_ne_zeroAddress : succAddress ≠ zeroAddress := by
+  exact address_ne (by decide)
+
+theorem goodAddress_ne_natAddress : goodAddress ≠ natAddress := by
+  exact address_ne (by decide)
+
+theorem goodAddress_ne_zeroAddress : goodAddress ≠ zeroAddress := by
+  exact address_ne (by decide)
+
+theorem goodAddress_ne_succAddress : goodAddress ≠ succAddress := by
+  exact address_ne (by decide)
+
+theorem badAddress_ne_natAddress :
+    IllTypedPending.fixtureAddress ≠ natAddress := by
+  exact address_ne (by decide)
+
+theorem badAddress_ne_zeroAddress :
+    IllTypedPending.fixtureAddress ≠ zeroAddress := by
+  exact address_ne (by decide)
+
+theorem badAddress_ne_succAddress :
+    IllTypedPending.fixtureAddress ≠ succAddress := by
+  exact address_ne (by decide)
+
+theorem badAddress_ne_goodAddress :
+    IllTypedPending.fixtureAddress ≠ goodAddress := by
+  exact address_ne (by decide)
+
+theorem natId_ne_zeroId : natId ≠ zeroId := by
+  intro h
+  exact address_ne (a := 10) (b := 11) (by decide)
+    (congrArg KId.addr h)
+
+theorem natId_ne_succId : natId ≠ succId := by
+  intro h
+  exact address_ne (a := 10) (b := 12) (by decide)
+    (congrArg KId.addr h)
+
+theorem zeroId_ne_succId : zeroId ≠ succId := by
+  intro h
+  exact address_ne (a := 11) (b := 12) (by decide)
+    (congrArg KId.addr h)
+
+theorem goodId_ne_natId : goodId ≠ natId := by
+  intro h
+  exact address_ne (a := 13) (b := 10) (by decide)
+    (congrArg KId.addr h)
+
+theorem goodId_ne_zeroId : goodId ≠ zeroId := by
+  intro h
+  exact address_ne (a := 13) (b := 11) (by decide)
+    (congrArg KId.addr h)
+
+theorem goodId_ne_succId : goodId ≠ succId := by
+  intro h
+  exact address_ne (a := 13) (b := 12) (by decide)
+    (congrArg KId.addr h)
+
+theorem badId_ne_natId : IllTypedPending.targetId ≠ natId := by
+  intro h
+  exact address_ne (a := 0) (b := 10) (by decide)
+    (congrArg KId.addr h)
+
+theorem badId_ne_zeroId : IllTypedPending.targetId ≠ zeroId := by
+  intro h
+  exact address_ne (a := 0) (b := 11) (by decide)
+    (congrArg KId.addr h)
+
+theorem badId_ne_succId : IllTypedPending.targetId ≠ succId := by
+  intro h
+  exact address_ne (a := 0) (b := 12) (by decide)
+    (congrArg KId.addr h)
+
+theorem badId_ne_goodId : IllTypedPending.targetId ≠ goodId := by
+  intro h
+  exact address_ne (a := 0) (b := 13) (by decide)
+    (congrArg KId.addr h)
+
+@[simp] theorem catalog_nat : catalog natId = some natConcrete := by
+  rfl
+
+@[simp] theorem catalog_zero : catalog zeroId = some zeroConcrete := by
+  rfl
+
+@[simp] theorem catalog_succ : catalog succId = some succConcrete := by
+  rfl
+
+@[simp] theorem catalog_good : catalog goodId = some goodConcrete := by
+  rfl
+
+@[simp] theorem catalog_bad :
+    catalog IllTypedPending.targetId = some IllTypedPending.concrete := by
+  rfl
+
+@[simp] theorem catalog_iota : catalog iotaId = some iotaConcrete := by
+  rfl
+
+@[simp] theorem nameOf_nat : nameOf natAddress = some natName := by
+  rfl
+
+@[simp] theorem nameOf_zero : nameOf zeroAddress = some zeroName := by
+  rfl
+
+@[simp] theorem nameOf_succ : nameOf succAddress = some succName := by
+  rfl
+
+@[simp] theorem nameOf_good : nameOf goodAddress = some goodName := by
+  rfl
+
+@[simp] theorem nameOf_bad :
+    nameOf IllTypedPending.fixtureAddress = some IllTypedPending.targetName := by
+  rfl
+
+def natConstant : VConstant where
+  uvars := 0
+  type := .sort (.succ .zero)
+
+def zeroConstant : VConstant where
+  uvars := 0
+  type := .const natName []
+
+def succConstant : VConstant where
+  uvars := 0
+  type := .forallE (.const natName []) (.const natName [])
+
+def natVal : VConstVal := { natConstant with name := natName }
+def zeroVal : VConstVal := { zeroConstant with name := zeroName }
+def succVal : VConstVal := { succConstant with name := succName }
+
+def natEnv₁ : VEnv where
+  constants := fun name =>
+    if natName = name then some natConstant else none
+  defeqs := fun _ => False
+
+def natEnv₂ : VEnv where
+  constants := fun name =>
+    if zeroName = name then some zeroConstant else natEnv₁.constants name
+  defeqs := fun _ => False
+
+def natEnv : VEnv where
+  constants := fun name =>
+    if succName = name then some succConstant else natEnv₂.constants name
+  defeqs := fun _ => False
+
+theorem addNat :
+    VEnv.empty.addConst natName natConstant = some natEnv₁ := by
+  rfl
+
+theorem addZero :
+    natEnv₁.addConst zeroName zeroConstant = some natEnv₂ := by
+  rfl
+
+theorem addSucc :
+    natEnv₂.addConst succName succConstant = some natEnv := by
+  rfl
+
+@[simp] theorem natEnv_nat : natEnv.constants natName = some natConstant := by
+  simp [natEnv, natEnv₂, natEnv₁, natName, zeroName, succName]
+
+@[simp] theorem natEnv_zero : natEnv.constants zeroName = some zeroConstant := by
+  simp [natEnv, natEnv₂, natEnv₁, natName, zeroName, succName]
+
+@[simp] theorem natEnv_succ : natEnv.constants succName = some succConstant := by
+  simp [natEnv, natEnv₂, natEnv₁, natName, zeroName, succName]
+
+theorem natConstant_wf : natConstant.WF VEnv.empty := by
+  exact ⟨_, VEnv.HasType.sort trivial⟩
+
+theorem zeroConstant_wf : zeroConstant.WF natEnv₁ := by
+  refine ⟨.succ .zero, ?_⟩
+  exact VEnv.HasType.const (VEnv.addConst_self addNat) (by simp) rfl
+
+theorem succConstant_wf : succConstant.WF natEnv₂ := by
+  apply VEnv.IsType.forallE
+  · refine ⟨.succ .zero, ?_⟩
+    exact VEnv.HasType.const
+      ((VEnv.addConst_le addZero).constants (VEnv.addConst_self addNat))
+      (by simp) rfl
+  · refine ⟨.succ .zero, ?_⟩
+    exact VEnv.HasType.const
+      ((VEnv.addConst_le addZero).constants (VEnv.addConst_self addNat))
+      (by simp) rfl
+
+theorem natEnv_wf : natEnv.WF := by
+  refine ⟨[.axiom succVal, .axiom zeroVal, .axiom natVal], ?_⟩
+  exact .decl (.axiom succConstant_wf addSucc)
+    (.decl (.axiom zeroConstant_wf addZero)
+      (.decl (.axiom natConstant_wf addNat) .empty))
+
+theorem natEnv_ordered : natEnv.Ordered :=
+  .const
+    (.const
+      (.const .empty natConstant_wf addNat)
+      zeroConstant_wf addZero)
+    succConstant_wf addSucc
+
+theorem empty_le_natEnv : VEnv.empty ≤ natEnv :=
+  (VEnv.addConst_le addNat).trans
+    ((VEnv.addConst_le addZero).trans (VEnv.addConst_le addSucc))
+
+theorem natConstant_wf_final : natConstant.WF natEnv :=
+  natConstant_wf.mono empty_le_natEnv
+
+theorem zeroConstant_wf_final : zeroConstant.WF natEnv :=
+  zeroConstant_wf.mono
+    ((VEnv.addConst_le addZero).trans (VEnv.addConst_le addSucc))
+
+theorem succConstant_wf_final : succConstant.WF natEnv :=
+  succConstant_wf.mono (VEnv.addConst_le addSucc)
+
+/-! ## Ambient-block translation -/
+
+def members (id : KId .anon) : Prop :=
+  id = natId ∨ id = zeroId ∨ id = succId
+
+theorem natRaw : RawInductiveConstRel natEnv nameOf RawProjRel.none
+    natId natConcrete natName natConstant := by
+  refine ⟨?_, nameOf_nat, rfl, ?_⟩
+  · trivial
+  · exact RawExprRel.sort
+
+theorem zeroRaw : RawInductiveConstRel natEnv nameOf RawProjRel.none
+    zeroId zeroConcrete zeroName zeroConstant := by
+  refine ⟨?_, nameOf_zero, rfl, ?_⟩
+  · trivial
+  · exact RawExprRel.const nameOf_nat natEnv_nat rfl
+
+theorem succRaw : RawInductiveConstRel natEnv nameOf RawProjRel.none
+    succId succConcrete succName succConstant := by
+  refine ⟨?_, nameOf_succ, rfl, ?_⟩
+  · trivial
+  · apply RawExprRel.all
+    · exact RawExprRel.const nameOf_nat natEnv_nat rfl
+    · exact RawExprRel.const nameOf_nat natEnv_nat rfl
+
+/-- A real model of the G2a assumption boundary.  This particular block has
+no recursor declaration, so `recursorFacts` is vacuous; any later block that
+contains a `.recr` entry must supply its Theory defeq witnesses explicitly. -/
+def oracle : InductiveOracle RawProjRel.none catalog nameOf
+    (fun _ => False) VEnv.empty where
+  members := members
+  nonempty := ⟨natId, Or.inl rfl⟩
+  fresh := by
+    intro id _ h
+    exact h
+  after := natEnv
+  envLE := empty_le_natEnv
+  blockWF := natEnv_wf
+  translateBlock := by
+    intro id hmember
+    rcases hmember with rfl | rfl | rfl
+    · exact ⟨natConcrete, natName, natConstant, catalog_nat, natRaw,
+        natEnv_nat, natConstant_wf_final⟩
+    · exact ⟨zeroConcrete, zeroName, zeroConstant, catalog_zero, zeroRaw,
+        natEnv_zero, zeroConstant_wf_final⟩
+    · exact ⟨succConcrete, succName, succConstant, catalog_succ, succRaw,
+        natEnv_succ, succConstant_wf_final⟩
+  recursorFacts := by
+    intro id c rule hmember hcatalog hrule
+    rcases hmember with rfl | rfl | rfl
+    · rw [catalog_nat] at hcatalog
+      cases hcatalog
+      exact False.elim hrule
+    · rw [catalog_zero] at hcatalog
+      cases hcatalog
+      exact False.elim hrule
+    · rw [catalog_succ] at hcatalog
+      cases hcatalog
+      exact False.elim hrule
+
+def worldNat : VerifyWorld where
+  catalog := catalog
+  trusted := oracle.TrustBlock
+  venv := natEnv
+  nameOf := nameOf
+  venvWF := natEnv_wf
+  trustedCatalogued := by
+    intro id htrusted
+    rcases htrusted with hmember | hold
+    · exact oracle.catalogued hmember
+    · exact False.elim hold
+
+theorem trustedCatalogRelNat :
+    TrustedCatalogRel RawProjRel.none worldNat :=
+  TrustedCatalogLog.ambient oracle TrustedCatalogLog.empty
+
+theorem nat_trusted : worldNat.trusted natId :=
+  oracle.trust_member (Or.inl rfl)
+
+theorem zero_trusted : worldNat.trusted zeroId :=
+  oracle.trust_member (Or.inr (Or.inl rfl))
+
+theorem succ_trusted : worldNat.trusted succId :=
+  oracle.trust_member (Or.inr (Or.inr rfl))
+
+/-- The ambient trusted-log path exposes the same exact operational lookup
+contract as an ordinary promoted declaration. -/
+theorem nat_trusted_lookup :
+    ∃ c name ci,
+      worldNat.catalog natId = some c ∧
+      worldNat.nameOf natId.addr = some name ∧
+      worldNat.venv.constants name = some ci :=
+  trustedCatalogRelNat.lookup nat_trusted
+
+/-! ## A valid standalone declaration over ambient Nat -/
+
+def goodConstant : VConstVal where
+  name := goodName
+  uvars := 0
+  type := .const natName []
+
+def goodDecl : VDecl := .axiom goodConstant
+
+theorem goodRaw : RawDeclRel worldNat.venv worldNat.nameOf
+    RawProjRel.none goodId goodConcrete goodDecl := by
+  apply RawDeclRel.axiom nameOf_good
+  exact RawExprRel.const nameOf_nat natEnv_nat rfl
+
+theorem good_not_trusted : ¬worldNat.trusted goodId := by
+  rintro (hmember | hold)
+  · rcases hmember with h | h | h
+    · exact goodId_ne_natId h
+    · exact goodId_ne_zeroId h
+    · exact goodId_ne_succId h
+  · exact hold
+
+theorem good_closed : CatalogClosed catalog goodConcrete := by
+  intro id href
+  change natId = id at href
+  subst id
+  exact ⟨natConcrete, catalog_nat⟩
+
+theorem natEnv_good_absent : natEnv.constants goodName = none := by
+  rfl
+
+theorem good_fresh : TargetFresh worldNat goodId := by
+  intro name hname
+  change nameOf goodAddress = some name at hname
+  change natEnv.constants name = none
+  rw [nameOf_good] at hname
+  cases hname
+  exact natEnv_good_absent
+
+theorem goodPending :
+    PendingDecl RawProjRel.none worldNat goodId goodDecl :=
+  ⟨goodConcrete, catalog_good, goodRaw, good_not_trusted,
+    good_closed, good_fresh⟩
+
+def goodEnv : VEnv where
+  constants := fun name =>
+    if goodName = name then some goodConstant.toVConstant
+    else natEnv.constants name
+  defeqs := natEnv.defeqs
+
+theorem addGood :
+    natEnv.addConst goodName goodConstant.toVConstant = some goodEnv := by
+  rfl
+
+theorem goodConstant_wf : goodConstant.toVConstant.WF natEnv := by
+  refine ⟨.succ .zero, ?_⟩
+  exact VEnv.HasType.const natEnv_nat (by simp) rfl
+
+theorem goodDecl_wf : VDecl.WF natEnv goodDecl goodEnv :=
+  .axiom goodConstant_wf addGood
+
+theorem goodEnv_ordered : goodEnv.Ordered :=
+  .const natEnv_ordered goodConstant_wf addGood
+
+def worldGood : VerifyWorld where
+  catalog := catalog
+  trusted := TrustInsert worldNat.trusted goodId
+  venv := goodEnv
+  nameOf := nameOf
+  venvWF := by
+    obtain ⟨ds, hds⟩ := natEnv_wf
+    exact ⟨goodDecl :: ds, .decl goodDecl_wf hds⟩
+  trustedCatalogued := by
+    intro id htrusted
+    rcases htrusted with hnew | hold
+    · subst id
+      exact ⟨goodConcrete, catalog_good⟩
+    · exact worldNat.trustedCatalogued hold
+
+theorem nat_le_good : worldNat ≤ worldGood := by
+  exact ⟨rfl, rfl, TrustInsert.old, VEnv.addConst_le addGood⟩
+
+theorem trustedCatalogRelGood :
+    TrustedCatalogRel RawProjRel.none worldGood :=
+  TrustedCatalogLog.promote trustedCatalogRelNat catalog_good goodRaw
+    good_closed good_not_trusted goodDecl_wf
+
+theorem good_trusted : worldGood.trusted goodId :=
+  TrustInsert.self
+
+theorem goodTrustedDecl :
+    TrustedDecl RawProjRel.none worldGood goodId goodDecl := by
+  exact ⟨goodConcrete, natEnv, goodEnv, catalog_good,
+    goodRaw.mono (VEnv.addConst_le addGood), good_trusted,
+    goodDecl_wf, VEnv.LE.rfl⟩
+
+theorem nat_trusted_good : worldGood.trusted natId :=
+  TrustInsert.old nat_trusted
+
+theorem nat_lookup_good :
+    ∃ c name ci,
+      worldGood.catalog natId = some c ∧
+      worldGood.nameOf natId.addr = some name ∧
+      worldGood.venv.constants name = some ci :=
+  trustedCatalogRelGood.lookup nat_trusted_good
+
+/-! ## Ill-typed pending declaration in the Nat world -/
+
+theorem badRaw : RawDeclRel worldGood.venv worldGood.nameOf
+    RawProjRel.none IllTypedPending.targetId IllTypedPending.concrete
+    IllTypedPending.theoryDecl := by
+  apply RawDeclRel.axiom nameOf_bad
+  exact RawExprRel.sort
+
+theorem bad_not_trusted : ¬worldGood.trusted IllTypedPending.targetId := by
+  rintro (hgood | hold)
+  · exact badId_ne_goodId hgood
+  · rcases hold with hmember | hfalse
+    · rcases hmember with hnat | hzero | hsucc
+      · exact badId_ne_natId hnat
+      · exact badId_ne_zeroId hzero
+      · exact badId_ne_succId hsucc
+    · exact hfalse
+
+theorem bad_closed :
+    CatalogClosed catalog IllTypedPending.concrete := by
+  intro id href
+  change False at href
+  exact False.elim href
+
+theorem goodEnv_bad_absent :
+    goodEnv.constants IllTypedPending.targetName = none := by
+  rfl
+
+theorem bad_fresh : TargetFresh worldGood IllTypedPending.targetId := by
+  intro name hname
+  change nameOf IllTypedPending.fixtureAddress = some name at hname
+  change goodEnv.constants name = none
+  rw [nameOf_bad] at hname
+  cases hname
+  exact goodEnv_bad_absent
+
+theorem badPending : PendingDecl RawProjRel.none worldGood
+    IllTypedPending.targetId IllTypedPending.theoryDecl :=
+  ⟨IllTypedPending.concrete, catalog_bad, badRaw, bad_not_trusted,
+    bad_closed, bad_fresh⟩
+
+/-- The bad universe parameter remains impossible in the larger Nat world;
+ambient constants cannot repair a malformed declared universe arity. -/
+theorem badConstant_not_wf :
+    ¬IllTypedPending.theoryConstant.toVConstant.WF goodEnv := by
+  intro hwf
+  have hlevel : (VLevel.param 0).WF 0 :=
+    hwf.sort_inv goodEnv_ordered
+  exact (Nat.not_lt_zero 0) hlevel
+
+theorem badDecl_not_wf :
+    ¬∃ env', VDecl.WF worldGood.venv IllTypedPending.theoryDecl env' := by
+  rintro ⟨env', hwf⟩
+  cases hwf with
+  | «axiom» hconstant _ => exact badConstant_not_wf hconstant
+
+/-! ## Concrete loaded-state witness -/
+
+def loadedEnv : KEnv .anon :=
+  ((((({} : KEnv .anon).insert natId natConcrete)
+    |>.insert zeroId zeroConcrete)
+    |>.insert succId succConcrete)
+    |>.insert goodId goodConcrete)
+    |>.insert IllTypedPending.targetId IllTypedPending.concrete
+
+theorem loadedAgrees : LoadedAgrees catalog loadedEnv := by
+  exact LoadedAgrees.insert
+    (LoadedAgrees.insert
+      (LoadedAgrees.insert
+        (LoadedAgrees.insert
+          (LoadedAgrees.insert (LoadedAgrees.empty catalog) catalog_nat)
+          catalog_zero)
+        catalog_succ)
+      catalog_good)
+    catalog_bad
+
+@[simp] theorem loadedEnv_nat : loadedEnv.get? natId = some natConcrete := by
+  simp only [loadedEnv, KEnv.get?, KEnv.insert,
+    Std.HashMap.getElem?_insert]
+  split
+  · next h => exact False.elim (badId_ne_natId (eq_of_beq h))
+  split
+  · next h => exact False.elim (goodId_ne_natId (eq_of_beq h))
+  split
+  · next h => exact False.elim (natId_ne_succId (eq_of_beq h).symm)
+  split
+  · next h => exact False.elim (natId_ne_zeroId (eq_of_beq h).symm)
+  · rfl
+
+def state (prims : Primitives .anon) : TcState .anon :=
+  { env := loadedEnv, prims, ctxId := natAddress }
+
+theorem stateWF (prims : Primitives .anon) :
+    TcStateWF RawProjRel.none (state prims) worldGood :=
+  ⟨trustedCatalogRelGood, loadedAgrees, InternTable.WF.empty⟩
+
+/-- The G2b consumer lookup is inhabited by an ambient inductive member in a
+real concrete state; no legacy whole-environment translation is involved. -/
+theorem natResolved (prims : Primitives .anon) :
+    ∃ name ci,
+      TrustedConstRel RawProjRel.none worldGood natId natConcrete name ci :=
+  (stateWF prims).resolve loadedEnv_nat nat_trusted_good
+
+/-- Resolution supplies the exact `TrKExprS.const` premise package used by
+later reduction and inference proofs. -/
+theorem natReferenceTranslates (prims : Primitives .anon) :
+    ∃ name ci,
+      TrustedConstRel RawProjRel.none worldGood natId natConcrete name ci ∧
+      TrKExprS worldGood.venv ci.uvars worldGood.nameOf RawProjRel.none []
+        natRef (.const name []) := by
+  obtain ⟨name, ci, hresolved⟩ := natResolved prims
+  refine ⟨name, ci, hresolved, ?_⟩
+  simpa [natRef] using hresolved.trKExprS_const
+    (ctx := []) (us := #[]) (info := info zeroAddress)
+    (by simp) (by rfl)
+
+/-- Concrete loading alone still cannot resolve the pending declaration
+through the trusted consumer interface. -/
+theorem bad_not_resolved :
+    ¬∃ name ci, TrustedConstRel RawProjRel.none worldGood
+      IllTypedPending.targetId IllTypedPending.concrete name ci := by
+  rintro ⟨_, _, hresolved⟩
+  exact bad_not_trusted hresolved.trusted
+
+/-- The existential-world form used by C1--C3 consumers is non-vacuous on the
+same ambient Nat state. -/
+theorem natResolvedInv (prims : Primitives .anon) :
+    ∃ world, worldGood ≤ world ∧
+      ∃ name ci,
+        TrustedConstRel RawProjRel.none world natId natConcrete name ci :=
+  (stateWF prims).tcInv.resolve loadedEnv_nat nat_trusted_good
+
+/-! ## G3 finite run-support and execution witness -/
+
+/-- A constructed constant reference to the ambient Nat family.  Recording
+the smart constructor's own info makes it both a concrete Nat reference and a
+`KExpr.Constructed` witness for the resource-bound interface. -/
+def supportExpr : KExpr .anon :=
+  .const natId #[] (KExpr.mkConst natId #[] ()).info
+
+theorem supportExpr_eq_mkConst :
+    supportExpr = KExpr.mkConst natId #[] () :=
+  (KExpr.mkConst_shape natId #[] ()).symm
+
+theorem supportExpr_constructed : KExpr.Constructed supportExpr := by
+  rw [supportExpr_eq_mkConst]
+  exact .const
+
+@[simp] theorem supportExpr_size : supportExpr.size = 1 := rfl
+
+@[simp] theorem supportExpr_lbr : supportExpr.lbr = 0 := by
+  rw [supportExpr_eq_mkConst]
+  exact KExpr.mkConst_lbr natId #[] ()
+
+/-- The run-scope model exercises direct interning and every walker family
+currently covered by the proof library. -/
+def supportRequests : List WalkerRequest := [
+  .internExpr supportExpr,
+  .internUniv zeroLevel,
+  .lift supportExpr 0 0,
+  .subst supportExpr supportExpr 0,
+  .simulSubst supportExpr #[] 0,
+  .instRev supportExpr #[],
+  .abstractFVars supportExpr #[],
+  .instUniv supportExpr #[]
+]
+
+def support : RunSupport := RunSupport.pair supportExpr zeroLevel
+
+private theorem support_lift {x : KExpr .anon}
+    (h : KExpr.LiftReach 0 supportExpr 0 x) : support x := by
+  change x = supportExpr
+  simpa [supportExpr, KExpr.LiftReach, KExpr.liftSpec] using h
+
+private theorem support_subst {x : KExpr .anon}
+    (h : KExpr.SubstReach supportExpr supportExpr 0 x) : support x := by
+  change x = supportExpr
+  simpa [supportExpr, KExpr.SubstReach, KExpr.substSpec] using h
+
+private theorem support_simulSubst {x : KExpr .anon}
+    (h : KExpr.SimulSubstReach #[] supportExpr 0 x) : support x := by
+  change x = supportExpr
+  simpa [supportExpr, KExpr.SimulSubstReach,
+    KExpr.simulSubstSpec] using h
+
+private theorem support_instRev {x : KExpr .anon}
+    (h : KExpr.InstRevReach #[] supportExpr 0 x) : support x := by
+  change x = supportExpr
+  simpa [supportExpr, KExpr.InstRevReach,
+    KExpr.instantiateRevSpec] using h
+
+private theorem support_abstractFVars {x : KExpr .anon}
+    (h : KExpr.AbstractReach (abstractFVarPositions #[]) 0
+      supportExpr 0 x) : support x := by
+  change x = supportExpr
+  simpa [supportExpr, abstractFVarPositions, KExpr.AbstractReach,
+    KExpr.abstractFVarsSpec] using h
+
+private theorem supportExpr_instUniv :
+    KExpr.instUnivSpec supportExpr #[] = .ok supportExpr := by
+  unfold supportExpr
+  rw [KExpr.instUnivSpec]
+  simp only [Array.mapM_empty]
+  change Except.ok (KExpr.mkConst natId #[] ()) =
+    Except.ok (.const natId #[] (KExpr.mkConst natId #[] ()).info)
+  exact congrArg Except.ok (KExpr.mkConst_shape natId #[] ())
+
+private theorem support_instUniv {x : KExpr .anon}
+    (h : KExpr.InstUnivReach #[] supportExpr x) : support x := by
+  change x = supportExpr
+  change x = supportExpr ∨
+    KExpr.instUnivSpec supportExpr #[] = .ok x ∨ False at h
+  rcases h with h | h | h
+  · exact h
+  · rw [supportExpr_instUniv] at h
+    cases h
+    rfl
+  · exact False.elim h
+
+/-- The paired support covers both empty initial intern ranges and all eight
+recorded operation footprints. -/
+theorem checkSupport (prims : Primitives .anon) :
+    CheckConstSupport (state prims).env.intern supportRequests support := by
+  constructor
+  · constructor
+    · intro x hx
+      obtain ⟨a, ha⟩ := hx
+      simp [state, loadedEnv, KEnv.insert] at ha
+    · intro u hu
+      obtain ⟨a, ha⟩ := hu
+      simp [state, loadedEnv, KEnv.insert] at ha
+  · intro request hmem
+    simp [supportRequests] at hmem
+    rcases hmem with rfl | rfl | rfl | rfl | rfl | rfl | rfl | rfl
+    · constructor
+      · exact fun _ hx => hx
+      · exact fun _ hu => False.elim hu
+    · constructor
+      · exact fun _ hx => False.elim hx
+      · exact fun _ hu => hu
+    · constructor
+      · exact fun _ hx => support_lift hx
+      · exact fun _ hu => False.elim hu
+    · constructor
+      · exact fun _ hx => support_subst hx
+      · exact fun _ hu => False.elim hu
+    · constructor
+      · exact fun _ hx => support_simulSubst hx
+      · exact fun _ hu => False.elim hu
+    · constructor
+      · exact fun _ hx => support_instRev hx
+      · exact fun _ hu => False.elim hu
+    · constructor
+      · exact fun _ hx => support_abstractFVars hx
+      · exact fun _ hu => False.elim hu
+    · constructor
+      · exact fun _ hx => support_instUniv hx
+      · exact fun _ hu => False.elim hu
+
+/-- Source traversal and generated-result arithmetic are simultaneously
+bounded for the concrete G3b request list. -/
+theorem resourceBounds : ResourceBounds supportRequests := by
+  constructor
+  intro request hmem
+  simp [supportRequests] at hmem
+  rcases hmem with rfl | rfl | rfl | rfl | rfl | rfl | rfl | rfl
+  · exact supportExpr_constructed
+  · trivial
+  · refine ⟨supportExpr_constructed, ?_, ?_⟩
+    · simp [UInt64.size]
+    · simp [UInt64.size]
+  · refine ⟨supportExpr_constructed, supportExpr_constructed, ?_, ?_, ?_⟩
+    · simp [UInt64.size]
+    · simp [UInt64.size]
+    · simp [UInt64.size]
+  · refine ⟨supportExpr_constructed, ?_, ?_, ?_, ?_⟩
+    · intro k hk
+      simp at hk
+    · intro k hk
+      simp at hk
+    · simp [UInt64.size]
+    · intro k hk
+      simp at hk
+  · refine ⟨supportExpr_constructed, ?_, ?_⟩
+    · intro k hk
+      simp at hk
+    · simp [UInt64.size]
+  · refine ⟨supportExpr_constructed, ?_, ?_, ?_⟩
+    · intro id p hp
+      simp [abstractFVarPositions] at hp
+    · simp [UInt64.size]
+    · simp [UInt64.size]
+  · trivial
+
+/-- A small real `TcM` computation containing exactly the eight recorded
+interning operations.  It is a proof fixture, not a claim about `checkConst`;
+later K1--K3 proofs build the same certificate compositionally for the
+production entry points. -/
+def supportProgram : TcM .anon Unit := do
+  let _ ← TcM.intern supportExpr
+  let _ ← TcM.internUniv zeroLevel
+  let _ ← TcM.runIntern (lift supportExpr 0 0)
+  let _ ← TcM.runIntern (subst supportExpr supportExpr 0)
+  let _ ← TcM.runIntern (simulSubst supportExpr #[] 0)
+  let _ ← TcM.runIntern (instantiateRev supportExpr #[])
+  let _ ← TcM.runIntern (abstractFVars supportExpr #[])
+  let _ ← TcM.instantiateUnivParams supportExpr #[]
+  return ()
+
+theorem supportExecution (prims : Primitives .anon) :
+    ExecutionRequests supportProgram (state prims) supportRequests := by
+  unfold supportProgram supportRequests
+  exact .bind (.internExpr (state prims) supportExpr) fun _ s₁ _ =>
+    .bind (.internUniv s₁ zeroLevel) fun _ s₂ _ =>
+    .bind (.lift s₂ supportExpr 0 0) fun _ s₃ _ =>
+    .bind (.subst s₃ supportExpr supportExpr 0) fun _ s₄ _ =>
+    .bind (.simulSubst s₄ supportExpr #[] 0) fun _ s₅ _ =>
+    .bind (.instRev s₅ supportExpr #[]) fun _ s₆ _ =>
+    .bind (.abstractFVars s₆ supportExpr #[]) fun _ s₇ _ =>
+    .bind (.instUniv s₇ supportExpr #[]) fun _ s₈ _ => .pure s₈ ()
+
+theorem runAssumptions (prims : Primitives .anon) :
+    RunAssumptions (state prims) supportProgram
+      supportRequests support :=
+  ⟨supportExecution prims,
+    RunSupport.pair_collisionFree supportExpr zeroLevel,
+    checkSupport prims, resourceBounds⟩
+
+/-- G3b is non-vacuous in the same state that contains a trusted ambient Nat
+family and a loaded ill-typed pending declaration.  Its execution list cannot
+be replaced by `[]`: it is indexed by the concrete eight-operation program. -/
+theorem supportAcceptance (prims : Primitives .anon) :
+    TcStateWF RawProjRel.none (state prims) worldGood ∧
+    worldGood.trusted natId ∧
+    PendingDecl RawProjRel.none worldGood IllTypedPending.targetId
+      IllTypedPending.theoryDecl ∧
+    RunAssumptions (state prims) supportProgram
+      supportRequests support :=
+  ⟨stateWF prims, nat_trusted_good, badPending,
+    runAssumptions prims⟩
+
+/-! ## K1 exact nonempty warm-cache witness -/
+
+/-- This fixture contains only closed source expressions, so its context-key
+model relates the distinguished empty key to the empty semantic context. -/
+def whnfContextKeys : WhnfContextKeys :=
+  WhnfContextKeys.closed 0
+
+/-- Exact K1 semantics for all five WHNF cache families.  Non-WHNF semantic
+caches are absent from the fixture; cached block errors remain replayable. -/
+def whnfSemantics : CacheSemantics :=
+  whnfCacheSemantics whnfContextKeys RawProjRel.none
+    CacheSemantics.blockErrorsOnly
+
+/-- The closed Nat reference is definitionally equal to itself in the real
+ambient-Nat Theory world.  This is the semantic fact stored by the warm
+cache, replacing G4's former address-only identity contract. -/
+theorem supportExpr_whnfMeaning :
+    WhnfMeaning RawProjRel.none worldNat 0 [] supportExpr supportExpr := by
+  obtain ⟨name, ci, hresolved⟩ :=
+    trustedCatalogRelNat.resolve nat_trusted catalog_nat
+  have huvars : ci.uvars = 0 := by
+    simpa [natConcrete] using hresolved.uvars.symm
+  have htr0 := hresolved.trKExprS_const
+    (ctx := []) (us := #[]) (info := supportExpr.info)
+    (by simp) (by rfl)
+  have htr :
+      TrKExprS worldNat.venv 0 worldNat.nameOf RawProjRel.none []
+        supportExpr (.const name []) := by
+    simpa [supportExpr, huvars] using htr0
+  have hwf0 :
+      VExpr.WF worldNat.venv ci.uvars [] (.const name []) := by
+    refine ⟨_, VEnv.HasType.const hresolved.lookup (by simp) ?_⟩
+    simp [huvars]
+  have hwf : VExpr.WF worldNat.venv 0 [] (.const name []) := by
+    simpa [huvars] using hwf0
+  exact WhnfMeaning.refl htr hwf
+
+def warmKey : Address × Address :=
+  (supportExpr.addr, emptyCtxAddr)
+
+def warmEntry : CacheEntry :=
+  .expr .whnf warmKey supportExpr
+
+def warmEnv : KEnv .anon :=
+  { loadedEnv with
+    whnfCache := loadedEnv.whnfCache.insert warmKey supportExpr }
+
+def warmState (prims : Primitives .anon) : TcState .anon :=
+  { env := warmEnv, prims, ctxId := natAddress }
+
+/-- The loaded ambient-Nat environment has constants but no semantic cache
+entries. This is the fresh side of the G4 fresh/warm comparison. -/
+theorem loadedEnv_noCacheEntries (entry : CacheEntry) :
+    ¬loadedEnv.HasCacheEntry entry := by
+  intro hentry
+  cases hentry <;> simp [loadedEnv, KEnv.insert] at *
+
+private theorem supportExpr_references {id : KId .anon}
+    (h : supportExpr.References id) : id = natId := by
+  change natId = id at h
+  exact h.symm
+
+/-- The nonempty entry has finite support, depends only on trusted ambient
+Nat, and satisfies the fixture's semantic identity contract. -/
+theorem warmProvenanceNat :
+    CacheProvenance whnfSemantics
+      (CacheAuthority.stable worldNat) support warmEntry := by
+  refine ⟨?_, ?_, ?_⟩
+  · change support.HasExprAddr supportExpr.addr ∧ support supportExpr
+    constructor
+    · exact ⟨supportExpr, rfl, rfl⟩
+    · rfl
+  · intro id href
+    left
+    change CacheEntry.SourceReferences support supportExpr.addr id ∨
+      supportExpr.References id at href
+    rcases href with href | href
+    · obtain ⟨e, he, _, heref⟩ := href
+      change e = supportExpr at he
+      subst e
+      have hid := supportExpr_references heref
+      subst id
+      exact nat_trusted
+    · have hid := supportExpr_references href
+      subst id
+      exact nat_trusted
+  · intro source hsource haddr Δ hctx
+    change source = supportExpr at hsource
+    subst source
+    have hΔ : Δ = [] := by
+      simpa [whnfContextKeys, warmKey] using hctx.2
+    subst Δ
+    exact supportExpr_whnfMeaning
+
+theorem loadedCacheInvariantNat :
+    CacheInvariant whnfSemantics
+      (CacheAuthority.stable worldNat) support loadedEnv :=
+  CacheInvariant.of_no_entries loadedEnv_noCacheEntries
+
+/-- The reusable insertion rule constructs a genuinely nonempty invariant. -/
+theorem warmCacheInvariantNat :
+    CacheInvariant whnfSemantics
+      (CacheAuthority.stable worldNat) support warmEnv := by
+  exact CacheInvariant.insertWhnf loadedCacheInvariantNat warmProvenanceNat
+
+/-- A warm entry admitted under the Nat world remains valid after the good
+declaration is promoted. No cache flush or trust epoch is needed for this
+monotone extension. -/
+theorem warmCache_worldTransport :
+    CacheInvariant whnfSemantics
+      (CacheAuthority.stable worldGood) support warmEnv :=
+  warmCacheInvariantNat.mono (CacheAuthority.stable_mono nat_le_good)
+
+theorem warmEnv_hit : warmEnv.HasCacheEntry warmEntry := by
+  apply KEnv.HasCacheEntry.whnf
+  simp [warmEnv, warmKey]
+
+theorem freshKernelStateWF (prims : Primitives .anon) :
+    KernelStateWF whnfSemantics RawProjRel.none worldGood support
+      (state prims) := by
+  apply KernelStateWF.of_no_cache_entries (stateWF prims)
+  · exact (checkSupport prims).initial
+  · intro entry
+    simpa [state] using loadedEnv_noCacheEntries entry
+
+/-! ### First no-acceleration WHNF execution slice -/
+
+def noAccelState (prims : Primitives .anon) : TcState .anon :=
+  { state prims with noAccel := true }
+
+def whnfLeafExpr : KExpr .anon :=
+  .sort zeroLevel (info zeroAddress)
+
+theorem whnfLeafTranslates :
+    TrKExprS worldGood.venv 0 worldGood.nameOf RawProjRel.none []
+      whnfLeafExpr (.sort .zero) := by
+  unfold whnfLeafExpr zeroLevel
+  exact .sort (by trivial)
+
+theorem whnfLeafTheoryWF :
+    VExpr.WF worldGood.venv 0 [] (.sort .zero) :=
+  ⟨_, VEnv.HasType.sort trivial⟩
+
+/-- The concrete ambient-Nat state inhabits the full K1 invariant with
+acceleration disabled. -/
+theorem noAccelStateInv (prims : Primitives .anon) :
+    WhnfStateInv .noAccel whnfSemantics RawProjRel.none worldGood support
+      0 [] (noAccelState prims) := by
+  refine ⟨?_, ?_, rfl⟩
+  · have h := freshKernelStateWF prims
+    refine ⟨?_, ?_, ?_⟩
+    · exact h.core.of_env_eq rfl
+    · simpa [noAccelState] using h.internSupport
+    · simpa [noAccelState] using h.caches
+  · apply CtxRecon.empty <;> rfl
+
+/-- A real Nat-containing state instantiates the first conditional
+`RecM.whnf` theorem.  This branch returns before any cache, fuel, native, or
+recursive-method operation, but still preserves the complete K1 invariant on
+both EStateM outcomes. -/
+theorem whnfLeaf_noAccel_wf (prims : Primitives .anon) :
+    RecM.WF .noAccel whnfSemantics RawProjRel.none worldGood support 0 []
+      (noAccelState prims) (RecM.whnf whnfLeafExpr)
+      (fun result _ => WhnfPost RawProjRel.none worldGood 0 []
+        (.sort .zero) result) :=
+  RecM.whnf_leaf_wf .sort whnfLeafTranslates whnfLeafTheoryWF
+
+/-- Non-vacuity package for the first no-acceleration algorithmic slice. -/
+theorem whnfLeaf_noAccel_acceptance (prims : Primitives .anon) :
+    WhnfStateInv .noAccel whnfSemantics RawProjRel.none worldGood support
+        0 [] (noAccelState prims) ∧
+      RecM.WF .noAccel whnfSemantics RawProjRel.none worldGood support 0 []
+        (noAccelState prims) (RecM.whnf whnfLeafExpr)
+        (fun result _ => WhnfPost RawProjRel.none worldGood 0 []
+          (.sort .zero) result) :=
+  ⟨noAccelStateInv prims, whnfLeaf_noAccel_wf prims⟩
+
+theorem warmCoreWF (prims : Primitives .anon) :
+    TcStateWF RawProjRel.none (warmState prims) worldGood := by
+  apply (stateWF prims).of_consts_eq
+  · rfl
+  · exact InternTable.WF.empty
+
+theorem warmKernelStateWF (prims : Primitives .anon) :
+    KernelStateWF whnfSemantics RawProjRel.none worldGood support
+      (warmState prims) := by
+  refine ⟨warmCoreWF prims, ?_, warmCache_worldTransport⟩
+  simpa [warmState, warmEnv, state] using (checkSupport prims).initial
+
+/-- The real warm state computes the certified key and its empty semantic
+context is represented by the fixture's closed-key model. -/
+theorem warmKey_matches (prims : Primitives .anon) :
+    whnfContextKeys.Matches RawProjRel.none worldGood (warmState prims) []
+      supportExpr warmKey := by
+  refine ⟨?_, ?_, ?_⟩
+  · apply CtxRecon.empty <;> rfl
+  · simp [whnfContextKeys, warmKey]
+  · refine ⟨warmState prims, ?_⟩
+    simp [TcM.whnfKey, TcM.ctxAddrForLbr, supportExpr_lbr, warmKey]
+    rfl
+
+theorem warmStateInvAccelerated (prims : Primitives .anon) :
+    WhnfStateInv .accelerated whnfSemantics RawProjRel.none worldGood support
+      0 [] (warmState prims) := by
+  exact ⟨warmKernelStateWF prims, (warmKey_matches prims).1, trivial⟩
+
+/-- The generic key-frame theorem is inhabited by the real warm Nat state.
+Because `supportExpr` is closed, its representation premise follows from the
+exact closed-key execution equation and the state is unchanged. -/
+theorem warmKey_matches_wf (prims : Primitives .anon) :
+    TcM.WF
+      (WhnfStateInv .accelerated whnfSemantics RawProjRel.none worldGood
+        support 0 []) (warmState prims)
+      (TcM.whnfKey supportExpr)
+      (fun key s' =>
+        whnfContextKeys.Matches RawProjRel.none worldGood
+          (warmState prims) [] supportExpr key ∧
+        ContextKeyFrame (warmState prims) s') := by
+  have hrep : ∀ key s',
+      TcM.whnfKey supportExpr (warmState prims) = .ok key s' →
+      whnfContextKeys.Represents key.2 [] := by
+    intro key s' hrun
+    have hexact := TcM.whnfKey_closed
+      (s := warmState prims) supportExpr_lbr
+    rw [hexact] at hrun
+    cases hrun
+    simp [whnfContextKeys]
+  simpa [whnfContextKeys] using
+    (TcM.whnfKey_matches_wf (layer := .accelerated)
+      (semantics := whnfSemantics) (trProj := RawProjRel.none)
+      (world := worldGood) (support := support) (keys := whnfContextKeys)
+      (Δ := []) (source := supportExpr) (s := warmState prims) hrep)
+
+/-- A physical warm hit exposes exact Theory reduction meaning after world
+transport, not merely equality of content addresses. -/
+theorem warmHit_whnfMeaning (prims : Primitives .anon) :
+    WhnfMeaning RawProjRel.none worldGood 0 [] supportExpr supportExpr := by
+  exact ((warmKernelStateWF prims).cacheHit warmEnv_hit).whnfMeaningOfMatches
+    .whnf rfl (warmKey_matches prims)
+
+/-- Even though the bad declaration is physically loaded, the stable warm
+cache cannot cite it as a semantic dependency. -/
+theorem warmCache_cannotResolvePending (prims : Primitives .anon) :
+    ¬warmEntry.References support IllTypedPending.targetId :=
+  (warmKernelStateWF prims).pendingCacheIsolation badPending warmEnv_hit
+
+/-- G4's formal acceptance witness contains both the fresh and nonempty warm
+states, transported provenance, and pending-declaration isolation. The
+executable failed-then-valid regression lives in `Tests.Ix.Tc.CheckTests`. -/
+theorem cacheAcceptance (prims : Primitives .anon) :
+    KernelStateWF whnfSemantics RawProjRel.none worldGood support
+        (state prims) ∧
+      KernelStateWF whnfSemantics RawProjRel.none worldGood support
+        (warmState prims) ∧
+      WhnfMeaning RawProjRel.none worldGood 0 []
+        supportExpr supportExpr ∧
+      ¬warmEntry.References support IllTypedPending.targetId :=
+  ⟨freshKernelStateWF prims, warmKernelStateWF prims,
+    warmHit_whnfMeaning prims, warmCache_cannotResolvePending prims⟩
+
+theorem zero_trusted_good : worldGood.trusted zeroId :=
+  TrustInsert.old zero_trusted
+
+theorem succ_trusted_good : worldGood.trusted succId :=
+  TrustInsert.old succ_trusted
+
+/-! ### K1 structural beta witness -/
+
+/-- A closed, typed beta redex over the ambient Nat family.  Smart
+constructors supply its actual content metadata; the proof below does not
+identify source and result by address. -/
+def betaBody : KExpr .anon := KExpr.mkVar 0 ()
+def betaArg : KExpr .anon := KExpr.mkConst zeroId #[] ()
+def betaLam : KExpr .anon := KExpr.mkLam () () supportExpr betaBody
+def betaSource : KExpr .anon := KExpr.mkApp betaLam betaArg
+
+theorem betaTy_tr :
+    TrKExprS worldGood.venv 0 worldGood.nameOf RawProjRel.none []
+      supportExpr (.const natName []) := by
+  rw [supportExpr_eq_mkConst, KExpr.mkConst_shape]
+  exact .const (ci := natConstant) nameOf_nat
+    (by simpa [worldGood, goodEnv, goodName, natName] using natEnv_nat)
+    (by intro l hl; simp at hl) rfl
+
+theorem betaBody_tr :
+    TrKExprS worldGood.venv 0 worldGood.nameOf RawProjRel.none
+      [(none, .vlam (.const natName []))] betaBody (.bvar 0) := by
+  rw [betaBody, KExpr.mkVar_shape]
+  exact .var rfl
+
+theorem betaArg_tr :
+    TrKExprS worldGood.venv 0 worldGood.nameOf RawProjRel.none []
+      betaArg (.const zeroName []) := by
+  rw [betaArg, KExpr.mkConst_shape]
+  exact .const (ci := zeroConstant) nameOf_zero
+    (by simpa [worldGood, goodEnv, goodName, zeroName] using natEnv_zero)
+    (by intro l hl; simp at hl) rfl
+
+theorem betaA_type :
+    worldGood.venv.HasType 0 [] (.const natName [])
+      (.sort (.succ .zero)) := by
+  exact Lean4Lean.VEnv.HasType.const (env := worldGood.venv)
+    (U := 0) (Γ := []) (ci := natConstant) (ls := [])
+    (by simpa [worldGood, goodEnv, goodName, natName] using natEnv_nat)
+    (by intro l hl; simp at hl) rfl
+
+theorem betaBody_type :
+    worldGood.venv.HasType 0 [(.const natName [])] (.bvar 0)
+      (.const natName []) := by
+  exact Lean4Lean.VEnv.HasType.bvar .zero
+
+theorem betaArg_type :
+    worldGood.venv.HasType 0 [] (.const zeroName [])
+      (.const natName []) := by
+  exact Lean4Lean.VEnv.HasType.const (env := worldGood.venv)
+    (U := 0) (Γ := []) (ci := zeroConstant) (ls := [])
+    (by simpa [worldGood, goodEnv, goodName, zeroName] using natEnv_zero)
+    (by intro l hl; simp at hl) rfl
+
+theorem betaTy_wf :
+    VExpr.WF worldGood.venv 0 [] (.const natName []) :=
+  ⟨_, betaA_type⟩
+
+/-- The real flag-parametric core entry point returns the ambient Nat
+constant immediately, in both full and cheap modes, while preserving the
+no-acceleration state invariant. -/
+theorem whnfCoreConst_noAccel_wf (prims : Primitives .anon)
+    (flags : WhnfFlags) :
+    RecM.WF .noAccel whnfSemantics RawProjRel.none worldGood support 0 []
+      (noAccelState prims) (RecM.whnfCoreWithFlags supportExpr flags)
+      (fun result _ => WhnfPost RawProjRel.none worldGood 0 []
+        (.const natName []) result) :=
+  RecM.whnfCoreWithFlags_leaf_wf .const betaTy_tr betaTy_wf
+
+theorem whnfCoreConst_noAccel_acceptance (prims : Primitives .anon)
+    (flags : WhnfFlags) :
+    WhnfStateInv .noAccel whnfSemantics RawProjRel.none worldGood support
+        0 [] (noAccelState prims) ∧
+      RecM.WF .noAccel whnfSemantics RawProjRel.none worldGood support 0 []
+        (noAccelState prims) (RecM.whnfCoreWithFlags supportExpr flags)
+        (fun result _ => WhnfPost RawProjRel.none worldGood 0 []
+          (.const natName []) result) :=
+  ⟨noAccelStateInv prims, whnfCoreConst_noAccel_wf prims flags⟩
+
+/-- Nontrivial K1 semantic witness: the concrete Nat identity application
+is definitionally equal to the exact output of the verified substitution
+specification. -/
+theorem betaIdentityMeaning :
+    WhnfMeaning RawProjRel.none worldGood 0 [] betaSource
+      (KExpr.substSpec betaBody betaArg 0) := by
+  rw [betaSource, betaLam, KExpr.mkApp_shape, KExpr.mkLam_shape]
+  apply WhnfMeaning.beta (RawProjRel.none_ok worldGood.venv 0)
+    betaTy_tr betaBody_tr betaArg_tr betaA_type betaBody_type betaArg_type
+  decide
+
+/-- The concrete beta argument is smart-constructor coherent, which makes
+lifting it by zero syntactically exact. -/
+theorem betaArg_constructed : KExpr.Constructed betaArg := by
+  unfold betaArg
+  exact .const
+
+/-- On the identity body, production's singleton simultaneous substitution
+is exactly the single-substitution result used by the Theory beta theorem. -/
+theorem betaSimulSpec :
+    KExpr.simulSubstSpec betaBody #[betaArg] 0 =
+      KExpr.substSpec betaBody betaArg 0 := by
+  rw [betaBody, KExpr.mkVar_shape, KExpr.simulSubstSpec,
+    KExpr.substSpec]
+  exact KExpr.liftSpec_zero betaArg_constructed 0
+
+theorem betaSimulLeaf :
+    RecM.WhnfCoreLeaf (KExpr.simulSubstSpec betaBody #[betaArg] 0) := by
+  rw [betaSimulSpec]
+  rw [betaBody, KExpr.mkVar_shape, KExpr.substSpec]
+  rw [KExpr.liftSpec_zero betaArg_constructed]
+  exact .const
+
+/-- The semantic beta witness now names the exact pure specification used by
+the production multi-argument walker. -/
+theorem betaSimulMeaning :
+    WhnfMeaning RawProjRel.none worldGood 0 [] betaSource
+      (KExpr.simulSubstSpec betaBody #[betaArg] 0) := by
+  have h := betaIdentityMeaning
+  unfold betaSource betaLam at h ⊢
+  rw [KExpr.mkApp_shape, KExpr.mkLam_shape] at h ⊢
+  exact WhnfMeaning.betaSimul h betaSimulSpec
+
+private theorem stateM_bind {σ α β : Type} (x : StateM σ α)
+    (f : α → StateM σ β) (s : σ) :
+    (x >>= f) s = let (a, s') := x s; f a s' := rfl
+
+private theorem stateM_map {σ α β : Type} (f : α → β)
+    (x : StateM σ α) (s : σ) :
+    (f <$> x) s = let (a, s') := x s; (f a, s') := rfl
+
+private theorem stateM_pure {σ α : Type} (a : α) (s : σ) :
+    (pure a : StateM σ α) s = (a, s) := rfl
+
+/-- Exact evaluator for the production walker on the Nat identity body.  Its
+zero-shift fast path returns the argument and leaves every intern table
+unchanged. -/
+theorem betaWalker_intern (it : InternTable .anon) :
+    simulSubst betaBody #[betaArg] 0 it = (betaArg, it) := by
+  unfold betaBody simulSubst
+  rw [KExpr.mkVar_lbr]
+  rw [KExpr.mkVar_shape]
+  have hlbr :
+      (KExpr.var 0 () (KExpr.mkVar (m := .anon) 0 ()).info).lbr = 1 := by
+    rw [← KExpr.mkVar_shape]
+    rfl
+  unfold runWalk simulSubstCached scratchGet? scratchInsert liftInternW lift
+  simp [stateM_bind, stateM_map, stateM_pure, hlbr]
+
+theorem betaWalker_eval (prims : Primitives .anon) :
+    TcM.runIntern (simulSubst betaBody #[betaArg] 0)
+      (noAccelState prims) = .ok betaArg (noAccelState prims) := by
+  unfold TcM.runIntern
+  rw [betaWalker_intern]
+
+theorem betaSimulResult :
+    KExpr.simulSubstSpec betaBody #[betaArg] 0 = betaArg := by
+  rw [betaSimulSpec, betaBody, KExpr.mkVar_shape, KExpr.substSpec]
+  exact KExpr.liftSpec_zero betaArg_constructed 0
+
+theorem betaResultMeaning :
+    WhnfMeaning RawProjRel.none worldGood 0 [] betaSource betaArg := by
+  rw [← betaSimulResult]
+  exact betaSimulMeaning
+
+/-- Small operational harness for the single recursive-head callback used by
+this fixture.  It is not claimed to satisfy `Methods.WF` or to be the tied
+production knot; the generic theorem above isolates the exact callback
+equation that K2 must later prove for `methodsN`. -/
+def betaHarnessMethods : Methods .anon where
+  whnf := fun e => pure e
+  whnfCore := fun e => pure e
+  whnfMode := fun e _ => pure e
+  whnfCoreFlags := fun e _ => pure e
+  infer := fun e => pure e
+  isDefEq := fun _ _ => pure false
+
+/-- A real Nat-containing checker state executes the production bounded
+WHNF-core driver through its beta branch and returns `Nat.zero`. -/
+theorem betaCoreUncached_eval (prims : Primitives .anon)
+    (flags : WhnfFlags) :
+    (RecM.whnfCoreWithFlagsUncached betaSource flags).run
+      betaHarnessMethods (noAccelState prims) =
+        .ok betaArg (noAccelState prims) := by
+  unfold betaSource betaLam
+  rw [KExpr.mkApp_shape, KExpr.mkLam_shape]
+  apply RecM.whnfCoreWithFlagsUncached_betaOne
+  · rfl
+  · exact betaWalker_eval prims
+  · simpa [betaSimulResult] using betaSimulLeaf
+
+/-- K1c acceptance package: the concrete production execution preserves the
+inhabited no-acceleration invariant, and its exact syntactic result has the
+Theory beta meaning proved above. -/
+theorem betaCoreUncached_acceptance (prims : Primitives .anon)
+    (flags : WhnfFlags) :
+    WhnfStateInv .noAccel whnfSemantics RawProjRel.none worldGood support
+        0 [] (noAccelState prims) ∧
+      (RecM.whnfCoreWithFlagsUncached betaSource flags).run
+        betaHarnessMethods (noAccelState prims) =
+          .ok betaArg (noAccelState prims) ∧
+      WhnfMeaning RawProjRel.none worldGood 0 [] betaSource betaArg :=
+  ⟨noAccelStateInv prims, betaCoreUncached_eval prims flags,
+    betaResultMeaning⟩
+
+/-! ### K1d legacy de-Bruijn zeta witness -/
+
+/-- One legacy let frame whose stored Nat.zero value is inlined by the
+translation context exactly as production `lookupLetVal` returns it. -/
+def bvarZetaCtx : KVLCtx :=
+  [(none, .vlet (.const natName []) (.const zeroName []))]
+
+def bvarZetaState (prims : Primitives .anon) : TcState .anon :=
+  { noAccelState prims with
+    ctx := #[supportExpr]
+    letVals := #[some betaArg]
+    numLetBindings := 1 }
+
+theorem bvarZetaCtxRecon (prims : Primitives .anon) :
+    CtxRecon worldGood.venv 0 worldGood.nameOf RawProjRel.none
+      (bvarZetaState prims) bvarZetaCtx := by
+  refine {
+    size_eq := rfl
+    recon := ?_
+    lwf := .empty
+    incr := by simp [bvarZetaState, noAccelState, state]
+    fresh := by simp [bvarZetaState, noAccelState, state]
+    lets := rfl }
+  have hrec :
+      CtxRecon' worldGood.venv 0 worldGood.nameOf RawProjRel.none
+        [(supportExpr, some betaArg)] [] bvarZetaCtx :=
+    .bvar_let .nil betaTy_tr betaArg_tr betaArg_type
+  simpa [bvarZetaState, noAccelState] using hrec
+
+theorem bvarZetaStateInv (prims : Primitives .anon) :
+    WhnfStateInv .noAccel whnfSemantics RawProjRel.none worldGood support
+      0 bvarZetaCtx (bvarZetaState prims) := by
+  have hbase := noAccelStateInv prims
+  exact ⟨⟨hbase.1.core.of_env_eq rfl,
+      hbase.1.internSupport, hbase.1.caches⟩,
+    bvarZetaCtxRecon prims, rfl⟩
+
+theorem bvarZetaLiftSpec :
+    KExpr.liftSpec betaArg 1 0 = betaArg := by
+  unfold betaArg
+  rw [KExpr.mkConst_shape]
+  rfl
+
+theorem bvarZetaLiftIntern (it : InternTable .anon) :
+    lift betaArg 1 0 it = (betaArg, it) := by
+  unfold lift betaArg
+  rw [KExpr.mkConst_lbr]
+  rfl
+
+theorem bvarZetaLiftEval (prims : Primitives .anon) :
+    TcM.runIntern (lift betaArg 1 0) (bvarZetaState prims) =
+      .ok betaArg (bvarZetaState prims) := by
+  unfold TcM.runIntern
+  rw [bvarZetaLiftIntern]
+
+theorem bvarZetaLookupEval (prims : Primitives .anon) :
+    TcM.lookupLetVal 0 (bvarZetaState prims) =
+      .ok (some betaArg) (bvarZetaState prims) := by
+  apply TcM.lookupLetVal_eval
+  · simp [bvarZetaState]
+  · rfl
+  · exact bvarZetaLiftEval prims
+
+theorem bvarZetaMeaning (prims : Primitives .anon) :
+    WhnfMeaning RawProjRel.none worldGood 0 bvarZetaCtx betaBody betaArg := by
+  rw [← bvarZetaLiftSpec]
+  unfold betaBody
+  rw [KExpr.mkVar_shape]
+  apply WhnfMeaning.zetaVar (bvarZetaCtxRecon prims)
+    (RawProjRel.none_ok worldGood.venv 0)
+  · simp [bvarZetaState]
+  · simp [bvarZetaState]
+    decide
+  · rfl
+  · rfl
+  · decide
+
+/-- The real bounded structural-WHNF driver reads the legacy let frame,
+runs the production lifting walker, and returns Nat.zero. -/
+theorem bvarZetaCoreUncachedEval (prims : Primitives .anon)
+    (flags : WhnfFlags) :
+    (RecM.whnfCoreWithFlagsUncached betaBody flags).run betaHarnessMethods
+      (bvarZetaState prims) = .ok betaArg (bvarZetaState prims) := by
+  unfold betaBody
+  rw [KExpr.mkVar_shape]
+  apply RecM.whnfCoreWithFlagsUncached_varZeta
+  · exact bvarZetaLookupEval prims
+  · exact .const
+
+theorem bvarZetaAcceptance (prims : Primitives .anon)
+    (flags : WhnfFlags) :
+    WhnfStateInv .noAccel whnfSemantics RawProjRel.none worldGood support
+        0 bvarZetaCtx (bvarZetaState prims) ∧
+      (RecM.whnfCoreWithFlagsUncached betaBody flags).run betaHarnessMethods
+        (bvarZetaState prims) = .ok betaArg (bvarZetaState prims) ∧
+      WhnfMeaning RawProjRel.none worldGood 0 bvarZetaCtx betaBody betaArg :=
+  ⟨bvarZetaStateInv prims, bvarZetaCoreUncachedEval prims flags,
+    bvarZetaMeaning prims⟩
+
+/-! ### K1d let-bound fvar zeta witness -/
+
+def fvarZetaId : FVarId := ⟨0⟩
+
+def fvarZetaSource : KExpr .anon := KExpr.mkFVar fvarZetaId ()
+
+def fvarZetaCtx : KVLCtx :=
+  [(some (fvarZetaId, []),
+    .vlet (.const natName []) (.const zeroName []))]
+
+def fvarZetaState (prims : Primitives .anon) : TcState .anon :=
+  let base := noAccelState prims
+  { base with
+    env := { base.env with nextFVarId := 1 }
+    lctx := base.lctx.push fvarZetaId (.ldecl () supportExpr betaArg) }
+
+theorem fvarZetaFind (prims : Primitives .anon) :
+    (fvarZetaState prims).lctx.find? fvarZetaId =
+      some (.ldecl () supportExpr betaArg) := by
+  simp [fvarZetaState, noAccelState, LocalContext.find?, LocalContext.push,
+    fvarZetaId]
+
+theorem fvarZetaCtxRecon (prims : Primitives .anon) :
+    CtxRecon worldGood.venv 0 worldGood.nameOf RawProjRel.none
+      (fvarZetaState prims) fvarZetaCtx := by
+  refine {
+    size_eq := rfl
+    recon := ?_
+    lwf := ?_
+    incr := by
+      simp [fvarZetaState, noAccelState, state, LocalContext.push]
+    fresh := ?_
+    lets := rfl }
+  · have hrec :
+        CtxRecon' worldGood.venv 0 worldGood.nameOf RawProjRel.none
+          [] [(fvarZetaId, .ldecl () supportExpr betaArg)] fvarZetaCtx :=
+      .fvar .nil (.vlet betaTy_tr betaArg_tr betaArg_type) (by simp)
+    simpa [fvarZetaState, noAccelState, LocalContext.push] using hrec
+  · apply LocalContext.WF.push .empty
+    simp [fvarZetaId]
+  · intro p hp
+    simp [fvarZetaState, noAccelState, state, LocalContext.push] at hp
+    subst p
+    simp [fvarZetaState, fvarZetaId]
+
+theorem fvarZetaStateInv (prims : Primitives .anon) :
+    WhnfStateInv .noAccel whnfSemantics RawProjRel.none worldGood support
+      0 fvarZetaCtx (fvarZetaState prims) := by
+  have hbase := noAccelStateInv prims
+  refine ⟨?_, fvarZetaCtxRecon prims, rfl⟩
+  refine ⟨?_, ?_, ?_⟩
+  · exact hbase.1.core.of_consts_eq (by rfl) (by
+      simpa [fvarZetaState] using hbase.1.core.intern)
+  · simpa [fvarZetaState] using hbase.1.internSupport
+  · intro entry hentry
+    apply hbase.1.caches
+    cases hentry <;> (constructor; assumption)
+
+/-- The real bounded structural-WHNF driver resolves a let-valued fvar and
+returns its closed Nat.zero value without changing checker state. -/
+theorem fvarZetaCoreUncachedEval (prims : Primitives .anon)
+    (flags : WhnfFlags) :
+    (RecM.whnfCoreWithFlagsUncached fvarZetaSource flags).run
+      betaHarnessMethods (fvarZetaState prims) =
+        .ok betaArg (fvarZetaState prims) := by
+  unfold fvarZetaSource
+  rw [KExpr.mkFVar_shape]
+  apply RecM.whnfCoreWithFlagsUncached_fvarZeta
+  · exact fvarZetaFind prims
+  · exact .const
+
+theorem fvarZetaMeaning (prims : Primitives .anon) :
+    WhnfMeaning RawProjRel.none worldGood 0 fvarZetaCtx
+      fvarZetaSource betaArg := by
+  unfold fvarZetaSource
+  rw [KExpr.mkFVar_shape]
+  apply WhnfMeaning.zetaFVar (fvarZetaCtxRecon prims)
+    (RawProjRel.none_ok worldGood.venv 0)
+    (fvarZetaFind prims) betaArg_constructed
+  · rfl
+  · decide
+
+theorem fvarZetaAcceptance (prims : Primitives .anon)
+    (flags : WhnfFlags) :
+    WhnfStateInv .noAccel whnfSemantics RawProjRel.none worldGood support
+        0 fvarZetaCtx (fvarZetaState prims) ∧
+      (RecM.whnfCoreWithFlagsUncached fvarZetaSource flags).run
+        betaHarnessMethods (fvarZetaState prims) =
+          .ok betaArg (fvarZetaState prims) ∧
+      WhnfMeaning RawProjRel.none worldGood 0 fvarZetaCtx
+        fvarZetaSource betaArg :=
+  ⟨fvarZetaStateInv prims, fvarZetaCoreUncachedEval prims flags,
+    fvarZetaMeaning prims⟩
+
+/-! ### K1e adversarial projection witness -/
+
+/-- A constructor application that the syntax-directed projection helper can
+index even though `Nat` is not admitted as a structure projection in this
+fixture's Theory relation. -/
+def projectionValue : KExpr .anon :=
+  KExpr.mkApp (KExpr.mkConst succId #[] ()) betaArg
+
+def projectionSource : KExpr .anon :=
+  KExpr.mkPrj natId 0 projectionValue
+
+theorem loadedEnv_succ_k1e :
+    loadedEnv.get? succId = some succConcrete := by
+  simp only [loadedEnv, KEnv.get?, KEnv.insert,
+    Std.HashMap.getElem?_insert]
+  split
+  · next h => exact False.elim (badId_ne_succId (eq_of_beq h))
+  split
+  · next h => exact False.elim (goodId_ne_succId (eq_of_beq h))
+  · rfl
+
+theorem loadedEnv_zero_k1e :
+    loadedEnv.get? zeroId = some zeroConcrete := by
+  simp only [loadedEnv, KEnv.get?, KEnv.insert,
+    Std.HashMap.getElem?_insert]
+  split
+  · next h => exact False.elim (badId_ne_zeroId (eq_of_beq h))
+  split
+  · next h => exact False.elim (goodId_ne_zeroId (eq_of_beq h))
+  split
+  · next h => exact False.elim (zeroId_ne_succId (eq_of_beq h).symm)
+  · rfl
+
+theorem tryGetConst_succ_k1e (prims : Primitives .anon) :
+    TcM.tryGetConst succId (noAccelState prims) =
+      .ok (some succConcrete) (noAccelState prims) := by
+  unfold TcM.tryGetConst
+  change EStateM.bind (get : TcM .anon (TcState .anon)) _
+    (noAccelState prims) = _
+  unfold EStateM.bind
+  rw [show (get : TcM .anon (TcState .anon)) (noAccelState prims) =
+    .ok (noAccelState prims) (noAccelState prims) from rfl]
+  simp only
+  have henv : (noAccelState prims).env.get? succId =
+      some succConcrete := by
+    simpa [noAccelState, state] using loadedEnv_succ_k1e
+  rw [henv]
+  rfl
+
+theorem projectionValueWhnf (prims : Primitives .anon)
+    (flags : WhnfFlags) :
+    (if flags.cheapProj then
+        (RecM.whnfCoreFlagsRec projectionValue flags).run
+          betaHarnessMethods (noAccelState prims)
+      else (RecM.whnfRec projectionValue).run
+          betaHarnessMethods (noAccelState prims)) =
+      .ok projectionValue (noAccelState prims) := by
+  cases flags.cheapProj <;>
+    simp [RecM.whnfCoreFlagsRec, RecM.whnfRec, betaHarnessMethods] <;> rfl
+
+theorem projectionReduceEval (prims : Primitives .anon) :
+    (RecM.tryProjReduce natId 0 projectionValue).run betaHarnessMethods
+      (noAccelState prims) =
+        .ok (some betaArg) (noAccelState prims) := by
+  unfold RecM.tryProjReduce projectionValue
+  rw [KExpr.mkApp_shape, KExpr.mkConst_shape]
+  simp only [KExpr.collectSpine]
+  rw [ReaderT.run_bind, ReaderT.run_pure, pure_bind]
+  simp only [KExpr.collectSpine.go]
+  rw [ReaderT.run_bind]
+  change EStateM.bind
+    (ReaderT.run
+      (RecM.tryReduceFinValDecidableRec natId 0
+        (.const succId #[] (KExpr.mkConst succId #[] ()).info) #[betaArg])
+        betaHarnessMethods) _
+      (noAccelState prims) = _
+  unfold EStateM.bind
+  rw [RecM.tryReduceFinValDecidableRec_noAccel rfl]
+  simp only
+  rw [ReaderT.run_bind, ReaderT.run_pure, pure_bind]
+  rw [ReaderT.run_bind, ReaderT.run_monadLift]
+  change EStateM.bind (TcM.tryGetConst succId) _ (noAccelState prims) = _
+  unfold EStateM.bind
+  rw [tryGetConst_succ_k1e]
+  rfl
+
+theorem projectionStepEval (prims : Primitives .anon)
+    (flags : WhnfFlags) :
+    (RecM.whnfCoreWithFlagsStep projectionSource flags).run
+      betaHarnessMethods (noAccelState prims) =
+        .ok (.next betaArg) (noAccelState prims) := by
+  unfold projectionSource
+  rw [KExpr.mkPrj_shape]
+  apply RecM.whnfCoreWithFlagsStep_projection
+    (projectionValueWhnf prims flags)
+  exact projectionReduceEval prims
+
+theorem projectionCoreEval (prims : Primitives .anon)
+    (flags : WhnfFlags) :
+    (RecM.whnfCoreWithFlagsUncached projectionSource flags).run
+      betaHarnessMethods (noAccelState prims) =
+        .ok betaArg (noAccelState prims) := by
+  apply RecM.whnfCoreWithFlagsUncached_nextLeaf
+  · exact projectionStepEval prims flags
+  · exact .const
+
+/-- With `RawProjRel.none`, no projection source has a Theory translation.
+The successful execution above therefore cannot be promoted to
+`WhnfMeaning`; the generic K1e theorem's source-translation premise is
+essential. -/
+theorem projectionSource_not_translated :
+    ¬∃ sourceV,
+      TrKExprS worldGood.venv 0 worldGood.nameOf RawProjRel.none []
+        projectionSource sourceV := by
+  rintro ⟨sourceV, hsource⟩
+  unfold projectionSource at hsource
+  rw [KExpr.mkPrj_shape] at hsource
+  cases hsource with
+  | prj _ _ hproj => exact hproj
+
+theorem projectionAdversarialWitness (prims : Primitives .anon)
+    (flags : WhnfFlags) :
+    WhnfStateInv .noAccel whnfSemantics RawProjRel.none worldGood support
+        0 [] (noAccelState prims) ∧
+      (RecM.whnfCoreWithFlagsUncached projectionSource flags).run
+        betaHarnessMethods (noAccelState prims) =
+          .ok betaArg (noAccelState prims) ∧
+      ¬∃ sourceV,
+        TrKExprS worldGood.venv 0 worldGood.nameOf RawProjRel.none []
+          projectionSource sourceV :=
+  ⟨noAccelStateInv prims, projectionCoreEval prims flags,
+    projectionSource_not_translated⟩
+
+/-! ### K1e adversarial iota witness -/
+
+def iotaPrims (prims : Primitives .anon) : Primitives .anon :=
+  { prims with natZero := zeroId }
+
+def iotaState (prims : Primitives .anon) : TcState .anon :=
+  let base := noAccelState (iotaPrims prims)
+  { base with env := base.env.insert iotaId iotaConcrete }
+
+def iotaHead : KExpr .anon := KExpr.mkConst iotaId #[] ()
+def iotaSource : KExpr .anon := KExpr.mkApp iotaHead iotaResult
+
+theorem iotaStateInv (prims : Primitives .anon) :
+    WhnfStateInv .noAccel whnfSemantics RawProjRel.none worldGood support
+      0 [] (iotaState prims) := by
+  have hbase := noAccelStateInv (iotaPrims prims)
+  refine ⟨?_, ?_, rfl⟩
+  · refine ⟨?_, ?_, ?_⟩
+    · have hcat : worldGood.catalog iotaId = some iotaConcrete := by
+        exact catalog_iota
+      simpa [iotaState] using hbase.1.core.load hcat
+    · simpa [iotaState] using hbase.1.internSupport
+    · intro entry hentry
+      apply hbase.1.caches
+      cases hentry <;> (constructor; assumption)
+  · apply CtxRecon.empty <;> rfl
+
+theorem iotaGetRec (prims : Primitives .anon) :
+    TcM.tryGetConst iotaId (iotaState prims) =
+      .ok (some iotaConcrete) (iotaState prims) := by
+  unfold TcM.tryGetConst
+  change EStateM.bind (get : TcM .anon (TcState .anon)) _
+    (iotaState prims) = _
+  unfold EStateM.bind
+  rw [show (get : TcM .anon (TcState .anon)) (iotaState prims) =
+    .ok (iotaState prims) (iotaState prims) from rfl]
+  simp only
+  have henv : (iotaState prims).env.get? iotaId =
+      some iotaConcrete := by
+    simp [iotaState, KEnv.get?, KEnv.insert]
+  rw [henv]
+  rfl
+
+theorem iotaGetZero (prims : Primitives .anon) :
+    TcM.tryGetConst zeroId (iotaState prims) =
+      .ok (some zeroConcrete) (iotaState prims) := by
+  unfold TcM.tryGetConst
+  change EStateM.bind (get : TcM .anon (TcState .anon)) _
+    (iotaState prims) = _
+  unfold EStateM.bind
+  rw [show (get : TcM .anon (TcState .anon)) (iotaState prims) =
+    .ok (iotaState prims) (iotaState prims) from rfl]
+  simp only
+  have hne : iotaId ≠ zeroId := by
+    intro h
+    exact address_ne (a := 14) (b := 11) (by decide)
+      (congrArg KId.addr h)
+  have henv : (iotaState prims).env.get? zeroId = some zeroConcrete := by
+    simp only [iotaState, KEnv.get?, KEnv.insert,
+      Std.HashMap.getElem?_insert]
+    split
+    · next h => exact False.elim (hne (eq_of_beq h))
+    · simpa [noAccelState, state] using loadedEnv_zero_k1e
+  rw [henv]
+  rfl
+
+theorem iotaMajorWhnf (prims : Primitives .anon) (flags : WhnfFlags) :
+    (if flags.cheapRec then
+        (RecM.whnfCoreFlagsRec iotaResult flags).run betaHarnessMethods
+          (iotaState prims)
+      else (RecM.whnfRec iotaResult).run betaHarnessMethods
+          (iotaState prims)) = .ok iotaResult (iotaState prims) := by
+  cases flags.cheapRec <;>
+    simp [RecM.whnfCoreFlagsRec, RecM.whnfRec, betaHarnessMethods] <;> rfl
+
+theorem iotaCleanup (prims : Primitives .anon) :
+    (RecM.cleanupNatOffsetMajor iotaResult).run betaHarnessMethods
+      (iotaState prims) = .ok none (iotaState prims) := by
+  have hextract : extractNatValue iotaResult (iotaPrims prims) = some 0 := by
+    unfold iotaResult extractNatValue extractNatLit
+    simp [iotaPrims]
+  have heval :
+      (RecM.evalNatOffsetLiteral iotaResult 0).run betaHarnessMethods
+        (iotaState prims) = .ok (some 0) (iotaState prims) := by
+    unfold RecM.evalNatOffsetLiteral RecM.evalNatOffsetLiteralFuel
+    rw [ReaderT.run_bind]
+    change EStateM.bind
+      (ReaderT.run RecM.prims betaHarnessMethods) _ (iotaState prims) = _
+    unfold EStateM.bind
+    rw [show ReaderT.run RecM.prims betaHarnessMethods (iotaState prims) =
+      .ok (iotaPrims prims) (iotaState prims) from rfl]
+    simp only
+    rw [hextract]
+    rfl
+  unfold RecM.cleanupNatOffsetMajor
+  rw [ReaderT.run_bind]
+  change EStateM.bind
+    (ReaderT.run (RecM.evalNatOffsetLiteral iotaResult 0)
+      betaHarnessMethods) _ (iotaState prims) = _
+  unfold EStateM.bind
+  rw [heval]
+  rfl
+
+theorem iotaInstantiateRule (prims : Primitives .anon) :
+    TcM.instantiateUnivParams iotaRule.rhs #[] (iotaState prims) =
+      .ok iotaResult (iotaState prims) := by
+  rfl
+
+/-- Exact execution of the real iota helper on the untrusted recursor-shaped
+catalog entry.  All parameter/motive/minor/field/trailing loops are empty,
+but recursor lookup, major cleanup/WHNF, constructor lookup, and universe
+instantiation are the production operations. -/
+theorem iotaTryEval (prims : Primitives .anon) (flags : WhnfFlags) :
+    (RecM.tryIotaWithFlags iotaSource flags).run betaHarnessMethods
+      (iotaState prims) = .ok (some iotaResult) (iotaState prims) := by
+  unfold RecM.tryIotaWithFlags iotaSource iotaHead
+  rw [KExpr.mkApp_shape, KExpr.mkConst_shape]
+  simp only [KExpr.collectSpine, KExpr.collectSpine.go]
+  rw [ReaderT.run_bind, ReaderT.run_monadLift]
+  change EStateM.bind (TcM.tryGetConst iotaId) _ (iotaState prims) = _
+  unfold EStateM.bind
+  rw [iotaGetRec]
+  simp [iotaConcrete, iotaRule]
+  change EStateM.bind
+    (ReaderT.run (RecM.cleanupNatOffsetMajor iotaResult)
+      betaHarnessMethods) _ (iotaState prims) = _
+  unfold EStateM.bind
+  rw [iotaCleanup]
+  simp only [Option.getD]
+  cases hcheap : flags.cheapRec <;>
+      simp only [Bool.false_eq_true, ↓reduceIte]
+  all_goals
+    rw [ReaderT.run_bind]
+    change EStateM.bind _ _ (iotaState prims) = _
+    unfold EStateM.bind
+    have hmajor := iotaMajorWhnf prims flags
+    simp only [hcheap, Bool.false_eq_true, ↓reduceIte] at hmajor
+    rw [hmajor]
+    simp only
+    rw [iotaResult]
+    simp only
+    rw [ReaderT.run_bind]
+    change EStateM.bind
+      (ReaderT.run
+        (RecM.cleanupNatOffsetMajor
+          (.const zeroId #[] (info iotaAddress)))
+        betaHarnessMethods) _ (iotaState prims) = _
+    unfold EStateM.bind
+    have hcleanup := iotaCleanup prims
+    rw [iotaResult] at hcleanup
+    rw [hcleanup]
+    simp only
+    simp only [KExpr.collectSpine.go]
+    rw [ReaderT.run_bind, ReaderT.run_monadLift]
+    change EStateM.bind (TcM.tryGetConst zeroId) _ (iotaState prims) = _
+    unfold EStateM.bind
+    rw [iotaGetZero]
+    simp [zeroConcrete]
+    have hinst := iotaInstantiateRule prims
+    simp only [iotaRule] at hinst
+    rw [iotaResult] at hinst
+    show EStateM.map _ _ (iotaState prims) = _
+    unfold EStateM.map
+    rw [hinst]
+
+theorem iotaStepEval (prims : Primitives .anon) (flags : WhnfFlags) :
+    (RecM.whnfCoreWithFlagsStep iotaSource flags).run betaHarnessMethods
+      (iotaState prims) = .ok (.next iotaResult) (iotaState prims) := by
+  unfold iotaSource iotaHead
+  rw [KExpr.mkApp_shape, KExpr.mkConst_shape]
+  apply RecM.whnfCoreWithFlagsStep_iota
+    (recId := iotaId) (us := #[])
+    (headInfo := (KExpr.mkConst iotaId #[] ()).info)
+    (args := #[iotaResult])
+  · simp [KExpr.collectSpine, KExpr.collectSpine.go]
+  · rfl
+  · change Bool.not ((KExpr.mkConst iotaId #[] ()).info.addr ==
+        (KExpr.mkConst iotaId #[] ()).info.addr) = false
+    rw [beq_self_eq_true]
+    rfl
+  · exact iotaTryEval prims flags
+
+theorem iotaCoreEval (prims : Primitives .anon) (flags : WhnfFlags) :
+    (RecM.whnfCoreWithFlagsUncached iotaSource flags).run
+      betaHarnessMethods (iotaState prims) =
+        .ok iotaResult (iotaState prims) := by
+  apply RecM.whnfCoreWithFlagsUncached_nextLeaf
+  · exact iotaStepEval prims flags
+  · exact .const
+
+theorem nameOf_iota_none : nameOf iotaAddress = none := by
+  rfl
+
+theorem iotaHead_not_translated :
+    ¬∃ headV,
+      TrKExprS worldGood.venv 0 worldGood.nameOf RawProjRel.none []
+        iotaHead headV := by
+  rintro ⟨headV, hhead⟩
+  unfold iotaHead at hhead
+  rw [KExpr.mkConst_shape] at hhead
+  cases hhead with
+  | const hname _ _ _ =>
+      change nameOf iotaAddress = some _ at hname
+      rw [nameOf_iota_none] at hname
+      contradiction
+
+theorem iotaSource_not_translated :
+    ¬∃ sourceV,
+      TrKExprS worldGood.venv 0 worldGood.nameOf RawProjRel.none []
+        iotaSource sourceV := by
+  rintro ⟨sourceV, hsource⟩
+  unfold iotaSource at hsource
+  rw [KExpr.mkApp_shape] at hsource
+  cases hsource with
+  | app _ _ hhead _ => exact iotaHead_not_translated ⟨_, hhead⟩
+
+theorem iotaAdversarialWitness (prims : Primitives .anon)
+    (flags : WhnfFlags) :
+    WhnfStateInv .noAccel whnfSemantics RawProjRel.none worldGood support
+        0 [] (iotaState prims) ∧
+      (RecM.whnfCoreWithFlagsUncached iotaSource flags).run
+        betaHarnessMethods (iotaState prims) =
+          .ok iotaResult (iotaState prims) ∧
+      ¬∃ sourceV,
+        TrKExprS worldGood.venv 0 worldGood.nameOf RawProjRel.none []
+          iotaSource sourceV :=
+  ⟨iotaStateInv prims, iotaCoreEval prims flags,
+    iotaSource_not_translated⟩
+
+/-! ### K1f structural-loop composition witness -/
+
+/-- Literal closure for this finite ambient world.  Nat literals are typed by
+the installed `Nat.zero`/`Nat.succ` constants; String literal support is
+provably absent. -/
+theorem structuralNatLit_type (n : Nat) :
+    worldGood.venv.HasType 0 [] (VExpr.natLit n) (.const natName []) := by
+  induction n with
+  | zero =>
+      simpa [VExpr.natLit, VExpr.natZero, zeroName] using betaArg_type
+  | succ n ih =>
+      have hsucc : worldGood.venv.HasType 0 [] (.const succName [])
+          (.forallE (.const natName []) (.const natName [])) := by
+        exact Lean4Lean.VEnv.HasType.const (env := worldGood.venv)
+          (U := 0) (Γ := []) (ci := succConstant) (ls := [])
+          (by simpa [worldGood, goodEnv, goodName, succName] using natEnv_succ)
+          (by intro l hl; simp at hl) rfl
+      simpa [VExpr.natLit, VExpr.natSucc, succName] using
+        Lean4Lean.VEnv.HasType.app hsucc ih
+
+/-- The finite Nat world supplies the uniform literal/projection facts needed
+to compose arbitrary structural trace meanings. -/
+def structuralWhnfTheory : WhnfTheory RawProjRel.none worldGood 0 where
+  literalWF := by
+    intro literal hliteral
+    cases literal with
+    | natVal n => exact ⟨_, structuralNatLit_type n⟩
+    | strVal value =>
+        simp [Lean4Lean.VEnv.ContainsLits, Lean4Lean.VEnv.contains,
+          worldGood, goodEnv, natEnv, natEnv₂, natEnv₁, goodName,
+          natName, zeroName, succName] at hliteral
+  projections := RawProjRel.none_ok worldGood.venv 0
+
+/-- Translation of the closed beta redex, used as the value stored in the
+let-bound fvar below. -/
+theorem structuralBetaSource_tr :
+    TrKExprS worldGood.venv 0 worldGood.nameOf RawProjRel.none []
+      betaSource
+      (.app (.lam (.const natName []) (.bvar 0)) (.const zeroName [])) := by
+  rw [betaSource, betaLam, KExpr.mkApp_shape, KExpr.mkLam_shape]
+  exact .app (Lean4Lean.VEnv.HasType.lam betaA_type betaBody_type)
+    betaArg_type (.lam ⟨_, betaA_type⟩ betaTy_tr betaBody_tr) betaArg_tr
+
+theorem structuralBetaSource_type :
+    worldGood.venv.HasType 0 []
+      (.app (.lam (.const natName []) (.bvar 0)) (.const zeroName []))
+      (.const natName []) := by
+  simpa using Lean4Lean.VEnv.HasType.app
+    (Lean4Lean.VEnv.HasType.lam betaA_type betaBody_type) betaArg_type
+
+theorem structuralBetaSource_constructed : KExpr.Constructed betaSource := by
+  unfold betaSource betaLam betaBody
+  exact .app (.lam supportExpr_constructed (.var (by decide)))
+    betaArg_constructed
+
+theorem structuralBetaSource_closed : betaSource.lbr = 0 := by
+  rfl
+
+/-- A let-bound fvar whose value is itself the beta redex.  Production must
+therefore take two `.next` transitions before reaching the constant leaf. -/
+def structuralLoopSource : KExpr .anon := KExpr.mkFVar fvarZetaId ()
+
+def structuralLoopCtx : KVLCtx :=
+  [(some (fvarZetaId, []),
+    .vlet (.const natName [])
+      (.app (.lam (.const natName []) (.bvar 0)) (.const zeroName [])))]
+
+def structuralLoopState (prims : Primitives .anon) : TcState .anon :=
+  let base := noAccelState prims
+  { base with
+    env := { base.env with nextFVarId := 1 }
+    lctx := base.lctx.push fvarZetaId
+      (.ldecl () supportExpr betaSource) }
+
+theorem structuralLoopFind (prims : Primitives .anon) :
+    (structuralLoopState prims).lctx.find? fvarZetaId =
+      some (.ldecl () supportExpr betaSource) := by
+  simp [structuralLoopState, noAccelState, LocalContext.find?,
+    LocalContext.push, fvarZetaId]
+
+theorem structuralLoopCtxRecon (prims : Primitives .anon) :
+    CtxRecon worldGood.venv 0 worldGood.nameOf RawProjRel.none
+      (structuralLoopState prims) structuralLoopCtx := by
+  refine {
+    size_eq := rfl
+    recon := ?_
+    lwf := ?_
+    incr := by
+      simp [structuralLoopState, noAccelState, state, LocalContext.push]
+    fresh := ?_
+    lets := rfl }
+  · have hrec :
+        CtxRecon' worldGood.venv 0 worldGood.nameOf RawProjRel.none
+          [] [(fvarZetaId, .ldecl () supportExpr betaSource)]
+            structuralLoopCtx :=
+      .fvar .nil
+        (.vlet betaTy_tr structuralBetaSource_tr structuralBetaSource_type)
+        (by simp)
+    simpa [structuralLoopState, noAccelState, LocalContext.push] using hrec
+  · apply LocalContext.WF.push .empty
+    simp [fvarZetaId]
+  · intro p hp
+    simp [structuralLoopState, noAccelState, state, LocalContext.push] at hp
+    subst p
+    simp [structuralLoopState, fvarZetaId]
+
+theorem structuralLoopStateInv (prims : Primitives .anon) :
+    WhnfStateInv .noAccel whnfSemantics RawProjRel.none worldGood support
+      0 structuralLoopCtx (structuralLoopState prims) := by
+  have hbase := noAccelStateInv prims
+  refine ⟨?_, structuralLoopCtxRecon prims, rfl⟩
+  refine ⟨?_, ?_, ?_⟩
+  · exact hbase.1.core.of_consts_eq (by rfl) (by
+      simpa [structuralLoopState] using hbase.1.core.intern)
+  · simpa [structuralLoopState] using hbase.1.internSupport
+  · intro entry hentry
+    apply hbase.1.caches
+    cases hentry <;> (constructor; assumption)
+
+/-- First local meaning: fvar zeta exposes the closed beta redex. -/
+theorem structuralLoopSourceMeaning (prims : Primitives .anon) :
+    WhnfMeaning RawProjRel.none worldGood 0 structuralLoopCtx
+      structuralLoopSource betaSource := by
+  unfold structuralLoopSource
+  rw [KExpr.mkFVar_shape]
+  apply WhnfMeaning.zetaFVar (structuralLoopCtxRecon prims)
+    (RawProjRel.none_ok worldGood.venv 0)
+    (structuralLoopFind prims) structuralBetaSource_constructed
+    structuralBetaSource_closed
+  decide
+
+theorem structuralLoopTy_tr :
+    TrKExprS worldGood.venv 0 worldGood.nameOf RawProjRel.none
+      structuralLoopCtx supportExpr (.const natName []) := by
+  rw [supportExpr_eq_mkConst, KExpr.mkConst_shape]
+  exact .const (ci := natConstant) nameOf_nat
+    (by simpa [worldGood, goodEnv, goodName, natName] using natEnv_nat)
+    (by intro l hl; simp at hl) rfl
+
+theorem structuralLoopBody_tr :
+    TrKExprS worldGood.venv 0 worldGood.nameOf RawProjRel.none
+      ((none, .vlam (.const natName [])) :: structuralLoopCtx)
+      betaBody (.bvar 0) := by
+  rw [betaBody, KExpr.mkVar_shape]
+  exact .var rfl
+
+theorem structuralLoopArg_tr :
+    TrKExprS worldGood.venv 0 worldGood.nameOf RawProjRel.none
+      structuralLoopCtx betaArg (.const zeroName []) := by
+  rw [betaArg, KExpr.mkConst_shape]
+  exact .const (ci := zeroConstant) nameOf_zero
+    (by simpa [worldGood, goodEnv, goodName, zeroName] using natEnv_zero)
+    (by intro l hl; simp at hl) rfl
+
+theorem structuralLoopA_type :
+    worldGood.venv.HasType 0 structuralLoopCtx.toCtx (.const natName [])
+      (.sort (.succ .zero)) := by
+  simpa [structuralLoopCtx] using betaA_type
+
+theorem structuralLoopBody_type :
+    worldGood.venv.HasType 0
+      ((.const natName []) :: structuralLoopCtx.toCtx) (.bvar 0)
+      (.const natName []) := by
+  simpa [structuralLoopCtx] using betaBody_type
+
+theorem structuralLoopArg_type :
+    worldGood.venv.HasType 0 structuralLoopCtx.toCtx (.const zeroName [])
+      (.const natName []) := by
+  simpa [structuralLoopCtx] using betaArg_type
+
+/-- Second local meaning: beta reduces the exposed identity application to
+`Nat.zero` in the same mixed context. -/
+theorem structuralLoopBetaMeaning :
+    WhnfMeaning RawProjRel.none worldGood 0 structuralLoopCtx
+      betaSource betaArg := by
+  rw [← betaSimulResult]
+  unfold betaSource betaLam
+  rw [KExpr.mkApp_shape, KExpr.mkLam_shape]
+  apply WhnfMeaning.betaSimul
+  · apply WhnfMeaning.beta (RawProjRel.none_ok worldGood.venv 0)
+      structuralLoopTy_tr structuralLoopBody_tr structuralLoopArg_tr
+      structuralLoopA_type structuralLoopBody_type structuralLoopArg_type
+    decide
+  · exact betaSimulSpec
+
+theorem structuralLoopLeafMeaning :
+    WhnfMeaning RawProjRel.none worldGood 0 structuralLoopCtx
+      betaArg betaArg := by
+  apply WhnfMeaning.refl structuralLoopArg_tr
+  exact ⟨_, structuralLoopArg_type⟩
+
+theorem structuralLoopFVarStep (prims : Primitives .anon)
+    (flags : WhnfFlags) :
+    (RecM.whnfCoreWithFlagsStep structuralLoopSource flags).run
+      betaHarnessMethods (structuralLoopState prims) =
+        .ok (.next betaSource) (structuralLoopState prims) := by
+  unfold structuralLoopSource
+  rw [KExpr.mkFVar_shape]
+  exact RecM.whnfCoreWithFlagsStep_fvarZeta (structuralLoopFind prims)
+
+theorem structuralLoopWalkerEval (prims : Primitives .anon) :
+    TcM.runIntern (simulSubst betaBody #[betaArg] 0)
+      (structuralLoopState prims) =
+        .ok betaArg (structuralLoopState prims) := by
+  unfold TcM.runIntern
+  rw [betaWalker_intern]
+
+theorem structuralLoopBetaStep (prims : Primitives .anon)
+    (flags : WhnfFlags) :
+    (RecM.whnfCoreWithFlagsStep betaSource flags).run betaHarnessMethods
+      (structuralLoopState prims) =
+        .ok (.next betaArg) (structuralLoopState prims) := by
+  unfold betaSource betaLam
+  rw [KExpr.mkApp_shape, KExpr.mkLam_shape]
+  simpa [betaSimulResult] using
+    (RecM.whnfCoreWithFlagsStep_betaOne
+      (methods := betaHarnessMethods) (s := structuralLoopState prims)
+      (flags := flags) (hhead := rfl)
+      (hwalk := structuralLoopWalkerEval prims))
+
+theorem structuralLoopLeafStep (prims : Primitives .anon)
+    (flags : WhnfFlags) :
+    (RecM.whnfCoreWithFlagsStep betaArg flags).run betaHarnessMethods
+      (structuralLoopState prims) =
+        .ok (.done betaArg) (structuralLoopState prims) :=
+  RecM.whnfCoreWithFlagsStep_leaf .const flags
+
+/-- Three exact iterations at production fuel: fvar-zeta, beta, then leaf.
+The trace carries the same fixed world/context invariant throughout. -/
+theorem structuralLoopTrace (prims : Primitives .anon)
+    (flags : WhnfFlags) :
+    RecM.WhnfCoreTrace .noAccel whnfSemantics RawProjRel.none worldGood
+      support 0 structuralLoopCtx betaHarnessMethods flags maxWhnfFuel.toNat
+      structuralLoopSource (structuralLoopState prims) betaArg
+      (structuralLoopState prims) := by
+  rw [show maxWhnfFuel.toNat = 10000 by rfl]
+  refine .next (structuralLoopStateInv prims)
+    (structuralLoopFVarStep prims flags) (structuralLoopStateInv prims)
+    (structuralLoopSourceMeaning prims) ?_
+  refine .next (structuralLoopStateInv prims)
+    (structuralLoopBetaStep prims flags) (structuralLoopStateInv prims)
+    structuralLoopBetaMeaning ?_
+  exact .done (structuralLoopStateInv prims)
+    (structuralLoopLeafStep prims flags) (structuralLoopStateInv prims)
+    structuralLoopLeafMeaning
+
+/-- Inhabited K1f acceptance: the real bounded driver executes more than one
+`.next`, preserves the full invariant, and obtains the end-to-end meaning by
+transitive composition rather than by asserting source/result equality. -/
+theorem structuralLoopAcceptance (prims : Primitives .anon)
+    (flags : WhnfFlags) :
+    (RecM.whnfCoreWithFlagsUncached structuralLoopSource flags).run
+        betaHarnessMethods (structuralLoopState prims) =
+          .ok betaArg (structuralLoopState prims) ∧
+      WhnfStateInv .noAccel whnfSemantics RawProjRel.none worldGood support
+        0 structuralLoopCtx (structuralLoopState prims) ∧
+      WhnfMeaning RawProjRel.none worldGood 0 structuralLoopCtx
+        structuralLoopSource betaArg := by
+  have h := (structuralLoopTrace prims flags).uncached_acceptance
+    structuralWhnfTheory
+  exact ⟨h.1, h.2.1, h.2.2.2⟩
+
+/-- Adversarial fuel boundary: the same source at zero fuel throws before
+consulting the step function, and therefore cannot have a semantic trace. -/
+theorem structuralLoopZeroFuel (prims : Primitives .anon)
+    (flags : WhnfFlags) :
+    (RecM.runBounded
+      (fun cur => RecM.whnfCoreWithFlagsStep cur flags) 0
+      structuralLoopSource).run betaHarnessMethods (structuralLoopState prims) =
+        .error .maxRecDepth (structuralLoopState prims) ∧
+      ¬RecM.WhnfCoreTrace .noAccel whnfSemantics RawProjRel.none worldGood
+        support 0 structuralLoopCtx betaHarnessMethods flags 0
+        structuralLoopSource (structuralLoopState prims) betaArg
+        (structuralLoopState prims) :=
+  ⟨rfl, RecM.WhnfCoreTrace.no_zero⟩
+
+/-! ### K1g outer structural-WHNF cache composition witness -/
+
+/-- The outer-cache fixture supports both the beta redex used as its key and
+the reduced constant stored as its value.  Universal cache validity below
+covers either supported source if their addresses happen to collide. -/
+def coreCacheSupport : RunSupport where
+  expr e := e = betaSource ∨ e = betaArg
+  exprFinite := ⟨[betaSource, betaArg], by
+    intro e he
+    rcases he with rfl | rfl <;> simp⟩
+  univ _ := False
+  univFinite := FiniteSupport.empty
+
+def coreCacheKey : Address × Address :=
+  (betaSource.addr, emptyCtxAddr)
+
+private theorem betaArg_references {id : KId .anon}
+    (h : betaArg.References id) : id = zeroId := by
+  change zeroId = id at h
+  exact h.symm
+
+private theorem betaSource_references {id : KId .anon}
+    (h : betaSource.References id) : id = natId ∨ id = zeroId := by
+  unfold betaSource betaLam at h
+  rw [KExpr.mkApp_shape, KExpr.mkLam_shape] at h
+  change (supportExpr.References id ∨ betaBody.References id) ∨
+    betaArg.References id at h
+  rcases h with (h | h) | h
+  · change natId = id at h
+    exact .inl h.symm
+  · rw [betaBody, KExpr.mkVar_shape] at h
+    exact False.elim h
+  · exact .inr (betaArg_references h)
+
+theorem betaArgMeaning :
+    WhnfMeaning RawProjRel.none worldGood 0 [] betaArg betaArg := by
+  exact WhnfMeaning.refl betaArg_tr ⟨_, betaArg_type⟩
+
+private theorem coreCacheReferencesAuthorized (kind : ExprCacheKind) :
+    (CacheEntry.expr kind coreCacheKey betaArg).ReferencesAuthorized
+      (CacheAuthority.stable worldGood) coreCacheSupport := by
+  intro id href
+  left
+  change CacheEntry.SourceReferences coreCacheSupport betaSource.addr id ∨
+    betaArg.References id at href
+  rcases href with href | href
+  · obtain ⟨e, he, haddr, heref⟩ := href
+    change e = betaSource ∨ e = betaArg at he
+    rcases he with rfl | rfl
+    · rcases betaSource_references heref with rfl | rfl
+      · exact nat_trusted_good
+      · exact zero_trusted_good
+    · have hid := betaArg_references heref
+      subst id
+      exact zero_trusted_good
+  · have hid := betaArg_references href
+    subst id
+    exact zero_trusted_good
+
+/-- The validity proof is deliberately collision-robust: both supported
+expressions that could inhabit the address key have the required meaning. -/
+private theorem coreCacheWhnfValid (kind : ExprCacheKind)
+    (hkind : kind = .whnfCore ∨ kind = .whnfCoreCheap) :
+    WhnfCacheValid whnfContextKeys RawProjRel.none
+      CacheSemantics.blockErrorsOnly (CacheAuthority.stable worldGood)
+      coreCacheSupport (.expr kind coreCacheKey betaArg) := by
+  rcases hkind with rfl | rfl <;>
+    intro source hsource haddr Δ hctx
+  all_goals
+    change source = betaSource ∨ source = betaArg at hsource
+    rcases hsource with rfl | rfl
+    · have hΔ : Δ = [] := by
+        simpa [whnfContextKeys, coreCacheKey] using hctx.2
+      subst Δ
+      exact betaResultMeaning
+    · have hΔ : Δ = [] := by
+        simpa [whnfContextKeys, coreCacheKey] using hctx.2
+      subst Δ
+      exact betaArgMeaning
+
+theorem fullCoreProvenance :
+    CacheProvenance whnfSemantics (CacheAuthority.stable worldGood)
+      coreCacheSupport (.expr .whnfCore coreCacheKey betaArg) := by
+  refine ⟨?_, ?_, ?_⟩
+  · exact ⟨⟨betaSource, .inl rfl, rfl⟩, .inr rfl⟩
+  · exact coreCacheReferencesAuthorized .whnfCore
+  · exact coreCacheWhnfValid .whnfCore (.inl rfl)
+
+theorem cheapCoreProvenance :
+    CacheProvenance whnfSemantics (CacheAuthority.stable worldGood)
+      coreCacheSupport (.expr .whnfCoreCheap coreCacheKey betaArg) := by
+  refine ⟨?_, ?_, ?_⟩
+  · exact ⟨⟨betaSource, .inl rfl, rfl⟩, .inr rfl⟩
+  · exact coreCacheReferencesAuthorized .whnfCoreCheap
+  · exact coreCacheWhnfValid .whnfCoreCheap (.inr rfl)
+
+theorem coreCacheFreshStateInv (prims : Primitives .anon) :
+    WhnfStateInv .noAccel whnfSemantics RawProjRel.none worldGood
+      coreCacheSupport 0 [] (noAccelState prims) := by
+  refine ⟨?_, ?_, rfl⟩
+  · apply KernelStateWF.of_no_cache_entries
+    · exact (stateWF prims).of_env_eq rfl
+    · constructor
+      · intro x hx
+        obtain ⟨a, ha⟩ := hx
+        simp [noAccelState, state, loadedEnv, KEnv.insert] at ha
+      · intro x hx
+        obtain ⟨a, ha⟩ := hx
+        simp [noAccelState, state, loadedEnv, KEnv.insert] at ha
+    · intro entry
+      simpa [noAccelState, state] using loadedEnv_noCacheEntries entry
+  · apply CtxRecon.empty <;> rfl
+
+def fullCoreWarmState (prims : Primitives .anon) : TcState .anon :=
+  let s := noAccelState prims
+  {s with env := {s.env with
+    whnfCoreCache := s.env.whnfCoreCache.insert coreCacheKey betaArg}}
+
+def bothCoreWarmState (prims : Primitives .anon) : TcState .anon :=
+  let s := fullCoreWarmState prims
+  {s with env := {s.env with
+    whnfCoreCheapCache := s.env.whnfCoreCheapCache.insert coreCacheKey betaArg}}
+
+theorem fullCoreWarmStateInv (prims : Primitives .anon) :
+    WhnfStateInv .noAccel whnfSemantics RawProjRel.none worldGood
+      coreCacheSupport 0 [] (fullCoreWarmState prims) := by
+  exact RecM.WhnfCoreCacheUpdate.full_whnfStateInv
+    (coreCacheFreshStateInv prims) fullCoreProvenance
+
+theorem bothCoreWarmStateInv (prims : Primitives .anon) :
+    WhnfStateInv .noAccel whnfSemantics RawProjRel.none worldGood
+      coreCacheSupport 0 [] (bothCoreWarmState prims) := by
+  exact RecM.WhnfCoreCacheUpdate.cheap_whnfStateInv
+    (fullCoreWarmStateInv prims) cheapCoreProvenance
+
+theorem coreCacheKey_eval (s : TcState .anon) :
+    TcM.whnfKey betaSource s = .ok coreCacheKey s := by
+  simpa [coreCacheKey] using
+    (TcM.whnfKey_closed (s := s) structuralBetaSource_closed)
+
+theorem coreCacheKey_matches (s : TcState .anon)
+    (hctx : CtxRecon worldGood.venv 0 worldGood.nameOf RawProjRel.none s []) :
+    whnfContextKeys.Matches RawProjRel.none worldGood s [] betaSource
+      coreCacheKey := by
+  refine ⟨hctx, ?_, ⟨s, coreCacheKey_eval s⟩⟩
+  simp [whnfContextKeys, coreCacheKey]
+
+theorem betaTransientFalse (s : TcState .anon) :
+    (RecM.isTransientNatLiteralWork betaSource).run betaHarnessMethods s =
+      .ok false s := by
+  unfold RecM.isTransientNatLiteralWork RecM.isNatLiteralRecursorApp
+  unfold betaSource betaLam
+  rw [KExpr.mkApp_shape, KExpr.mkLam_shape]
+  simp [KExpr.collectSpine, KExpr.collectSpine.go]
+  rfl
+
+theorem betaWalker_eval_state (s : TcState .anon) :
+    TcM.runIntern (simulSubst betaBody #[betaArg] 0) s = .ok betaArg s := by
+  unfold TcM.runIntern
+  rw [betaWalker_intern]
+
+theorem betaStep_state (s : TcState .anon) (flags : WhnfFlags) :
+    (RecM.whnfCoreWithFlagsStep betaSource flags).run betaHarnessMethods s =
+      .ok (.next betaArg) s := by
+  unfold betaSource betaLam
+  rw [KExpr.mkApp_shape, KExpr.mkLam_shape]
+  simpa [betaSimulResult] using
+    (RecM.whnfCoreWithFlagsStep_betaOne
+      (methods := betaHarnessMethods) (s := s) (flags := flags)
+      (hhead := rfl) (hwalk := betaWalker_eval_state s))
+
+theorem coreCacheTrace {s : TcState .anon}
+    (hI : WhnfStateInv .noAccel whnfSemantics RawProjRel.none worldGood
+      coreCacheSupport 0 [] s) (flags : WhnfFlags) :
+    RecM.WhnfCoreTrace .noAccel whnfSemantics RawProjRel.none worldGood
+      coreCacheSupport 0 [] betaHarnessMethods flags maxWhnfFuel.toNat
+      betaSource s betaArg s := by
+  rw [show maxWhnfFuel.toNat = 10000 by rfl]
+  refine .next hI (betaStep_state s flags) hI betaResultMeaning ?_
+  exact .done hI (RecM.whnfCoreWithFlagsStep_leaf .const flags) hI
+    betaArgMeaning
+
+theorem coreCacheFresh_fullMiss (prims : Primitives .anon) :
+    (noAccelState prims).env.whnfCoreCache[coreCacheKey]? = none := by
+  simp [noAccelState, state, loadedEnv, KEnv.insert, coreCacheKey]
+
+theorem fullCoreWarm_hit (prims : Primitives .anon) :
+    (fullCoreWarmState prims).env.whnfCoreCache[coreCacheKey]? =
+      some betaArg := by
+  simp [fullCoreWarmState, coreCacheKey]
+
+theorem fullCoreWarm_cheapMiss (prims : Primitives .anon) :
+    (fullCoreWarmState prims).env.whnfCoreCheapCache[coreCacheKey]? = none := by
+  simp [fullCoreWarmState, noAccelState, state, loadedEnv, KEnv.insert,
+    coreCacheKey]
+
+theorem bothCoreWarm_cheapHit (prims : Primitives .anon) :
+    (bothCoreWarmState prims).env.whnfCoreCheapCache[coreCacheKey]? =
+      some betaArg := by
+  simp [bothCoreWarmState, coreCacheKey]
+
+/-- First full-policy call: the real outer entry point misses, executes its
+certified beta trace, inserts the result, and preserves the invariant. -/
+theorem fullCoreColdAcceptance (prims : Primitives .anon) :
+    (RecM.whnfCoreWithFlags betaSource .FULL).run betaHarnessMethods
+        (noAccelState prims) = .ok betaArg (fullCoreWarmState prims) ∧
+      WhnfStateInv .noAccel whnfSemantics RawProjRel.none worldGood
+        coreCacheSupport 0 [] (noAccelState prims) ∧
+      WhnfStateInv .noAccel whnfSemantics RawProjRel.none worldGood
+        coreCacheSupport 0 [] (fullCoreWarmState prims) ∧
+      WhnfMeaning RawProjRel.none worldGood 0 [] betaSource betaArg := by
+  simpa [whnfSemantics, fullCoreWarmState] using
+    (RecM.whnfCoreWithFlags_fullMiss_acceptance
+      (keys := whnfContextKeys) (fallback := CacheSemantics.blockErrorsOnly)
+      structuralWhnfTheory (.direct RecM.WhnfCoreNonLeaf.app) rfl
+      (coreCacheKey_eval (noAccelState prims))
+      (betaTransientFalse (noAccelState prims))
+      (coreCacheFresh_fullMiss prims)
+      (coreCacheTrace (coreCacheFreshStateInv prims) .FULL)
+      fullCoreProvenance)
+
+/-- Second full-policy call: the inserted entry is consumed as a semantic
+hit and the entire checker state remains unchanged. -/
+theorem fullCoreWarmAcceptance (prims : Primitives .anon) :
+    (RecM.whnfCoreWithFlags betaSource .FULL).run betaHarnessMethods
+        (fullCoreWarmState prims) = .ok betaArg (fullCoreWarmState prims) ∧
+      WhnfStateInv .noAccel whnfSemantics RawProjRel.none worldGood
+        coreCacheSupport 0 [] (fullCoreWarmState prims) ∧
+      WhnfMeaning RawProjRel.none worldGood 0 [] betaSource betaArg := by
+  simpa [whnfSemantics] using
+    (RecM.whnfCoreWithFlags_fullHit_acceptance
+      (keys := whnfContextKeys) (fallback := CacheSemantics.blockErrorsOnly)
+      (.direct RecM.WhnfCoreNonLeaf.app) rfl
+      (coreCacheKey_eval (fullCoreWarmState prims))
+      (betaTransientFalse (fullCoreWarmState prims))
+      (fullCoreWarm_hit prims) (fullCoreWarmStateInv prims) (.inl rfl)
+      (coreCacheKey_matches (fullCoreWarmState prims)
+        (fullCoreWarmStateInv prims).2.1))
+
+/-- A full-policy entry is intentionally invisible to the cheap policy.  The
+cheap call therefore runs its own trace and inserts into only its partition. -/
+theorem cheapCorePolicyMissAcceptance (prims : Primitives .anon) :
+    (RecM.whnfCoreWithFlags betaSource .DEF_EQ_CORE).run betaHarnessMethods
+        (fullCoreWarmState prims) = .ok betaArg (bothCoreWarmState prims) ∧
+      WhnfStateInv .noAccel whnfSemantics RawProjRel.none worldGood
+        coreCacheSupport 0 [] (fullCoreWarmState prims) ∧
+      WhnfStateInv .noAccel whnfSemantics RawProjRel.none worldGood
+        coreCacheSupport 0 [] (bothCoreWarmState prims) ∧
+      WhnfMeaning RawProjRel.none worldGood 0 [] betaSource betaArg := by
+  simpa [whnfSemantics, bothCoreWarmState] using
+    (RecM.whnfCoreWithFlags_cheapMiss_acceptance
+      (keys := whnfContextKeys) (fallback := CacheSemantics.blockErrorsOnly)
+      structuralWhnfTheory (.direct RecM.WhnfCoreNonLeaf.app) rfl
+      (coreCacheKey_eval (fullCoreWarmState prims))
+      (betaTransientFalse (fullCoreWarmState prims))
+      (fullCoreWarm_cheapMiss prims)
+      (coreCacheTrace (fullCoreWarmStateInv prims) .DEF_EQ_CORE)
+      cheapCoreProvenance)
+
+/-- Once the cheap partition is populated, its next call is also a
+state-preserving semantic hit. -/
+theorem cheapCoreWarmAcceptance (prims : Primitives .anon) :
+    (RecM.whnfCoreWithFlags betaSource .DEF_EQ_CORE).run betaHarnessMethods
+        (bothCoreWarmState prims) = .ok betaArg (bothCoreWarmState prims) ∧
+      WhnfStateInv .noAccel whnfSemantics RawProjRel.none worldGood
+        coreCacheSupport 0 [] (bothCoreWarmState prims) ∧
+      WhnfMeaning RawProjRel.none worldGood 0 [] betaSource betaArg := by
+  simpa [whnfSemantics] using
+    (RecM.whnfCoreWithFlags_cheapHit_acceptance
+      (keys := whnfContextKeys) (fallback := CacheSemantics.blockErrorsOnly)
+      (.direct RecM.WhnfCoreNonLeaf.app) rfl
+      (coreCacheKey_eval (bothCoreWarmState prims))
+      (betaTransientFalse (bothCoreWarmState prims))
+      (bothCoreWarm_cheapHit prims) (bothCoreWarmStateInv prims) (.inl rfl)
+      (coreCacheKey_matches (bothCoreWarmState prims)
+        (bothCoreWarmStateInv prims).2.1))
+
+/-- Direct adversarial observation of the flag partition after only the full
+call has warmed its map. -/
+theorem coreCachePolicyIsolation (prims : Primitives .anon) :
+    (fullCoreWarmState prims).env.whnfCoreCache[coreCacheKey]? =
+        some betaArg ∧
+      (fullCoreWarmState prims).env.whnfCoreCheapCache[coreCacheKey]? = none :=
+  ⟨fullCoreWarm_hit prims, fullCoreWarm_cheapMiss prims⟩
+
+/-! ### K1h no-delta/full-WHNF driver witness -/
+
+theorem betaNoDeltaProjNone (prims : Primitives .anon) :
+    (RecM.tryProjAppReduce betaArg .FULL).run betaHarnessMethods
+      (fullCoreWarmState prims) = .ok none (fullCoreWarmState prims) := by
+  unfold RecM.tryProjAppReduce betaArg
+  rw [KExpr.mkConst_shape]
+  rfl
+
+theorem betaNoDeltaNatNone (prims : Primitives .anon) :
+    (RecM.tryReduceNatWithSuccMode betaArg .collapse).run betaHarnessMethods
+      (fullCoreWarmState prims) = .ok none (fullCoreWarmState prims) := by
+  unfold RecM.tryReduceNatWithSuccMode betaArg
+  rw [KExpr.mkConst_shape]
+  simp [KExpr.collectSpine, KExpr.collectSpine.go, RecM.prims]
+  rfl
+
+theorem betaNoDeltaStringNone (prims : Primitives .anon) :
+    (RecM.tryReduceString betaArg).run betaHarnessMethods
+      (fullCoreWarmState prims) = .ok none (fullCoreWarmState prims) := by
+  unfold RecM.tryReduceString betaArg
+  rw [KExpr.mkConst_shape]
+  rfl
+
+theorem fullCoreWarm_getZero (prims : Primitives .anon) :
+    TcM.tryGetConst zeroId (fullCoreWarmState prims) =
+      .ok (some zeroConcrete) (fullCoreWarmState prims) := by
+  unfold TcM.tryGetConst
+  change EStateM.bind (get : TcM .anon (TcState .anon)) _
+    (fullCoreWarmState prims) = _
+  unfold EStateM.bind
+  rw [show (get : TcM .anon (TcState .anon)) (fullCoreWarmState prims) =
+    .ok (fullCoreWarmState prims) (fullCoreWarmState prims) from rfl]
+  simp only
+  have henv : (fullCoreWarmState prims).env.get? zeroId =
+      some zeroConcrete := by
+    simpa [fullCoreWarmState, noAccelState, state] using loadedEnv_zero_k1e
+  rw [henv]
+  rfl
+
+theorem betaNoDeltaProjectionDefNone (prims : Primitives .anon) :
+    (RecM.tryReduceProjectionDefinition betaArg).run betaHarnessMethods
+      (fullCoreWarmState prims) = .ok none (fullCoreWarmState prims) := by
+  unfold RecM.tryReduceProjectionDefinition betaArg
+  rw [KExpr.mkConst_shape]
+  simp only [KExpr.collectSpine, KExpr.collectSpine.go]
+  rw [ReaderT.run_bind]
+  change EStateM.bind (TcM.tryGetConst zeroId) _ (fullCoreWarmState prims) = _
+  unfold EStateM.bind
+  rw [fullCoreWarm_getZero prims]
+  rfl
+
+theorem betaNoDeltaQuotNone (prims : Primitives .anon) :
+    (RecM.tryQuotReduce betaArg).run betaHarnessMethods
+      (fullCoreWarmState prims) = .ok none (fullCoreWarmState prims) := by
+  unfold RecM.tryQuotReduce betaArg
+  rw [KExpr.mkConst_shape]
+  simp [KExpr.collectSpine, KExpr.collectSpine.go, RecM.prims]
+  rfl
+
+/-- The no-delta driver consumes the already certified structural cache hit,
+then checks every remaining reducer in production order before terminating. -/
+theorem betaNoDeltaStep (prims : Primitives .anon) :
+    (RecM.whnfNoDeltaImplStep .FULL .collapse betaSource).run
+      betaHarnessMethods (fullCoreWarmState prims) =
+      .ok (.done betaArg) (fullCoreWarmState prims) := by
+  unfold RecM.whnfNoDeltaImplStep
+  rw [ReaderT.run_bind]
+  change EStateM.bind
+    ((RecM.whnfCoreWithFlags betaSource .FULL).run betaHarnessMethods) _
+      (fullCoreWarmState prims) = _
+  unfold EStateM.bind
+  rw [(fullCoreWarmAcceptance prims).1]
+  simp only
+  rw [ReaderT.run_bind]
+  change EStateM.bind
+    ((RecM.tryProjAppReduce betaArg .FULL).run betaHarnessMethods) _
+      (fullCoreWarmState prims) = _
+  unfold EStateM.bind
+  rw [betaNoDeltaProjNone prims]
+  simp only [pure_bind]
+  rw [ReaderT.run_bind]
+  change EStateM.bind
+    ((RecM.tryReduceBitvec betaArg).run betaHarnessMethods) _
+      (fullCoreWarmState prims) = _
+  unfold EStateM.bind
+  rw [RecM.tryReduceBitvec_noAccel rfl]
+  simp only
+  rw [ReaderT.run_bind]
+  change EStateM.bind
+    ((RecM.tryReduceNatWithSuccMode betaArg .collapse).run betaHarnessMethods) _
+      (fullCoreWarmState prims) = _
+  unfold EStateM.bind
+  rw [betaNoDeltaNatNone prims]
+  simp only
+  rw [ReaderT.run_bind]
+  change EStateM.bind
+    ((RecM.tryReduceNative betaArg).run betaHarnessMethods) _
+      (fullCoreWarmState prims) = _
+  unfold EStateM.bind
+  rw [RecM.tryReduceNative_noAccel rfl]
+  simp only
+  rw [ReaderT.run_bind]
+  change EStateM.bind
+    ((RecM.tryReduceString betaArg).run betaHarnessMethods) _
+      (fullCoreWarmState prims) = _
+  unfold EStateM.bind
+  rw [betaNoDeltaStringNone prims]
+  simp [WhnfFlags.FULL, WhnfFlags.isFull]
+  change EStateM.bind
+    ((RecM.tryReduceProjectionDefinition betaArg).run betaHarnessMethods) _
+      (fullCoreWarmState prims) = _
+  unfold EStateM.bind
+  rw [betaNoDeltaProjectionDefNone prims]
+  simp only
+  rw [ReaderT.run_bind]
+  change EStateM.bind
+    ((RecM.tryQuotReduce betaArg).run betaHarnessMethods) _
+      (fullCoreWarmState prims) = _
+  unfold EStateM.bind
+  rw [betaNoDeltaQuotNone prims]
+  rfl
+
+private theorem driverCacheWhnfValid (kind : ExprCacheKind)
+    (hkind : kind = .whnf ∨ kind = .whnfNoDelta ∨
+      kind = .whnfNoDeltaCheap) :
+    WhnfCacheValid whnfContextKeys RawProjRel.none
+      CacheSemantics.blockErrorsOnly (CacheAuthority.stable worldGood)
+      coreCacheSupport (.expr kind coreCacheKey betaArg) := by
+  rcases hkind with rfl | rfl | rfl <;>
+    intro source hsource haddr Δ hctx
+  all_goals
+    change source = betaSource ∨ source = betaArg at hsource
+    rcases hsource with rfl | rfl
+    · have hΔ : Δ = [] := by
+        simpa [whnfContextKeys, coreCacheKey] using hctx.2
+      subst Δ
+      exact betaResultMeaning
+    · have hΔ : Δ = [] := by
+        simpa [whnfContextKeys, coreCacheKey] using hctx.2
+      subst Δ
+      exact betaArgMeaning
+
+theorem fullNoDeltaProvenance :
+    CacheProvenance whnfSemantics (CacheAuthority.stable worldGood)
+      coreCacheSupport (.expr .whnfNoDelta coreCacheKey betaArg) := by
+  refine ⟨?_, ?_, ?_⟩
+  · exact ⟨⟨betaSource, .inl rfl, rfl⟩, .inr rfl⟩
+  · exact coreCacheReferencesAuthorized .whnfNoDelta
+  · exact driverCacheWhnfValid .whnfNoDelta (.inr (.inl rfl))
+
+theorem fullWhnfProvenance :
+    CacheProvenance whnfSemantics (CacheAuthority.stable worldGood)
+      coreCacheSupport (.expr .whnf coreCacheKey betaArg) := by
+  refine ⟨?_, ?_, ?_⟩
+  · exact ⟨⟨betaSource, .inl rfl, rfl⟩, .inr rfl⟩
+  · exact coreCacheReferencesAuthorized .whnf
+  · exact driverCacheWhnfValid .whnf (.inl rfl)
+
+def fullNoDeltaWarmState (prims : Primitives .anon) : TcState .anon :=
+  let s := fullCoreWarmState prims
+  {s with env := {s.env with
+    whnfNoDeltaCache := s.env.whnfNoDeltaCache.insert coreCacheKey betaArg}}
+
+theorem fullNoDeltaWarmStateInv (prims : Primitives .anon) :
+    WhnfStateInv .noAccel whnfSemantics RawProjRel.none worldGood
+      coreCacheSupport 0 [] (fullNoDeltaWarmState prims) := by
+  exact RecM.WhnfDriverCacheUpdate.noDelta_whnfStateInv
+    (fullCoreWarmStateInv prims) fullNoDeltaProvenance
+
+theorem noDeltaTrace (prims : Primitives .anon) :
+    RecM.WhnfNoDeltaTrace .noAccel whnfSemantics RawProjRel.none worldGood
+      coreCacheSupport 0 [] betaHarnessMethods .FULL .collapse
+      maxWhnfFuel.toNat betaSource (fullCoreWarmState prims) betaArg
+      (fullCoreWarmState prims) := by
+  rw [show maxWhnfFuel.toNat = 10000 by rfl]
+  exact .done (fullCoreWarmStateInv prims) (betaNoDeltaStep prims)
+    (fullCoreWarmStateInv prims) betaResultMeaning
+
+theorem fullCoreWarm_noDeltaMiss (prims : Primitives .anon) :
+    (fullCoreWarmState prims).env.whnfNoDeltaCache[coreCacheKey]? = none := by
+  simp [fullCoreWarmState, noAccelState, state, loadedEnv, KEnv.insert,
+    coreCacheKey]
+
+theorem fullNoDeltaWarm_hit (prims : Primitives .anon) :
+    (fullNoDeltaWarmState prims).env.whnfNoDeltaCache[coreCacheKey]? =
+      some betaArg := by
+  simp [fullNoDeltaWarmState, coreCacheKey]
+
+theorem fullNoDeltaWarm_cheapMiss (prims : Primitives .anon) :
+    (fullNoDeltaWarmState prims).env.whnfNoDeltaCheapCache[coreCacheKey]? =
+      none := by
+  simp [fullNoDeltaWarmState, fullCoreWarmState, noAccelState, state,
+    loadedEnv, KEnv.insert, coreCacheKey]
+
+theorem fullNoDeltaColdAcceptance (prims : Primitives .anon) :
+    (RecM.whnfNoDelta betaSource).run betaHarnessMethods
+        (fullCoreWarmState prims) =
+          .ok betaArg (fullNoDeltaWarmState prims) ∧
+      WhnfStateInv .noAccel whnfSemantics RawProjRel.none worldGood
+        coreCacheSupport 0 [] (fullCoreWarmState prims) ∧
+      WhnfStateInv .noAccel whnfSemantics RawProjRel.none worldGood
+        coreCacheSupport 0 [] (fullNoDeltaWarmState prims) ∧
+      WhnfMeaning RawProjRel.none worldGood 0 [] betaSource betaArg := by
+  simpa [RecM.whnfNoDelta, whnfSemantics, fullNoDeltaWarmState] using
+    (RecM.whnfNoDeltaImpl_fullMiss_acceptance
+      (keys := whnfContextKeys) (fallback := CacheSemantics.blockErrorsOnly)
+      structuralWhnfTheory (.direct RecM.WhnfDriverNonLeaf.app) rfl
+      (coreCacheKey_eval (fullCoreWarmState prims))
+      (betaTransientFalse (fullCoreWarmState prims))
+      (fullCoreWarm_noDeltaMiss prims) (noDeltaTrace prims) rfl
+      fullNoDeltaProvenance)
+
+theorem fullNoDeltaWarmAcceptance (prims : Primitives .anon) :
+    (RecM.whnfNoDelta betaSource).run betaHarnessMethods
+        (fullNoDeltaWarmState prims) =
+          .ok betaArg (fullNoDeltaWarmState prims) ∧
+      WhnfStateInv .noAccel whnfSemantics RawProjRel.none worldGood
+        coreCacheSupport 0 [] (fullNoDeltaWarmState prims) ∧
+      WhnfMeaning RawProjRel.none worldGood 0 [] betaSource betaArg := by
+  simpa [RecM.whnfNoDelta, whnfSemantics] using
+    (RecM.whnfNoDeltaImpl_fullHit_acceptance
+      (keys := whnfContextKeys) (fallback := CacheSemantics.blockErrorsOnly)
+      (.direct RecM.WhnfDriverNonLeaf.app) rfl
+      (coreCacheKey_eval (fullNoDeltaWarmState prims))
+      (betaTransientFalse (fullNoDeltaWarmState prims))
+      (fullNoDeltaWarm_hit prims) (fullNoDeltaWarmStateInv prims) (.inl rfl)
+      (coreCacheKey_matches (fullNoDeltaWarmState prims)
+        (fullNoDeltaWarmStateInv prims).2.1))
+
+theorem noDeltaCachePolicyIsolation (prims : Primitives .anon) :
+    (fullNoDeltaWarmState prims).env.whnfNoDeltaCache[coreCacheKey]? =
+        some betaArg ∧
+      (fullNoDeltaWarmState prims).env.whnfNoDeltaCheapCache[coreCacheKey]? =
+        none :=
+  ⟨fullNoDeltaWarm_hit prims, fullNoDeltaWarm_cheapMiss prims⟩
+
+/-! #### Full-WHNF loop, outer cache, and fuel witness -/
+
+/-- The exact state after a genuine outer full-WHNF cache miss has paid its
+single recursive-fuel charge. -/
+def fullWhnfChargedState (prims : Primitives .anon) : TcState .anon :=
+  let s := fullNoDeltaWarmState prims
+  {s with recFuel := s.recFuel - 1}
+
+theorem fullWhnfChargedStateInv (prims : Primitives .anon) :
+    WhnfStateInv .noAccel whnfSemantics RawProjRel.none worldGood
+      coreCacheSupport 0 [] (fullWhnfChargedState prims) := by
+  exact WhnfStateInv.of_semantic_fields_eq
+    (fullNoDeltaWarmStateInv prims) rfl rfl rfl rfl rfl rfl
+
+theorem fullWhnfPrefixCold (prims : Primitives .anon) :
+    (RecM.whnfWithNatSuccModePrefix betaSource).run betaHarnessMethods
+      (fullNoDeltaWarmState prims) =
+      .ok () (fullNoDeltaWarmState prims) := by
+  exact RecM.whnfWithNatSuccModePrefix_disabled rfl rfl
+
+theorem fullWhnfMissCharge (prims : Primitives .anon) :
+    (RecM.whnfWithNatSuccModeMissCharge : RecM .anon Unit).run
+      betaHarnessMethods (fullNoDeltaWarmState prims) =
+      .ok () (fullWhnfChargedState prims) := by
+  exact RecM.whnfWithNatSuccModeMissCharge_disabled rfl rfl
+
+/-- Fuel bookkeeping does not disturb the already populated no-delta cache. -/
+theorem fullWhnfCharged_noDeltaHit (prims : Primitives .anon) :
+    (RecM.whnfNoDeltaImpl betaSource .FULL .collapse).run
+      betaHarnessMethods (fullWhnfChargedState prims) =
+      .ok betaArg (fullWhnfChargedState prims) := by
+  rw [(RecM.WhnfDriverEntry.direct
+    (methods := betaHarnessMethods) (source := betaSource)
+    (s := fullWhnfChargedState prims)
+    RecM.WhnfDriverNonLeaf.app).noDelta_eval .FULL .collapse]
+  apply RecM.whnfNoDeltaImplNonLeaf_fullHit rfl
+    (coreCacheKey_eval (fullWhnfChargedState prims))
+    (betaTransientFalse (fullWhnfChargedState prims))
+  simp [fullWhnfChargedState, fullNoDeltaWarmState, coreCacheKey]
+
+theorem betaFullChargedNatNone (prims : Primitives .anon) :
+    (RecM.tryReduceNatWithSuccMode betaArg .collapse).run betaHarnessMethods
+      (fullWhnfChargedState prims) =
+      .ok none (fullWhnfChargedState prims) := by
+  unfold RecM.tryReduceNatWithSuccMode betaArg
+  rw [KExpr.mkConst_shape]
+  simp [KExpr.collectSpine, KExpr.collectSpine.go, RecM.prims]
+  rfl
+
+theorem betaFullChargedStringNone (prims : Primitives .anon) :
+    (RecM.tryReduceString betaArg).run betaHarnessMethods
+      (fullWhnfChargedState prims) =
+      .ok none (fullWhnfChargedState prims) := by
+  unfold RecM.tryReduceString betaArg
+  rw [KExpr.mkConst_shape]
+  rfl
+
+theorem betaFullChargedGetZero (prims : Primitives .anon) :
+    TcM.tryGetConst zeroId (fullWhnfChargedState prims) =
+      .ok (some zeroConcrete) (fullWhnfChargedState prims) := by
+  unfold TcM.tryGetConst
+  change EStateM.bind (get : TcM .anon (TcState .anon)) _
+    (fullWhnfChargedState prims) = _
+  unfold EStateM.bind
+  rw [show (get : TcM .anon (TcState .anon))
+    (fullWhnfChargedState prims) =
+      .ok (fullWhnfChargedState prims) (fullWhnfChargedState prims) from rfl]
+  simp only
+  have henv : (fullWhnfChargedState prims).env.get? zeroId =
+      some zeroConcrete := by
+    simpa [fullWhnfChargedState, fullNoDeltaWarmState, fullCoreWarmState,
+      noAccelState, state] using loadedEnv_zero_k1e
+  rw [henv]
+  rfl
+
+theorem betaFullChargedTryDeltaNone (prims : Primitives .anon) :
+    (RecM.tryDeltaUnfold betaArg).run betaHarnessMethods
+      (fullWhnfChargedState prims) =
+      .ok none (fullWhnfChargedState prims) := by
+  unfold RecM.tryDeltaUnfold betaArg
+  rw [KExpr.mkConst_shape]
+  simp only [KExpr.collectSpine, KExpr.collectSpine.go]
+  rw [ReaderT.run_bind]
+  change EStateM.bind (TcM.tryGetConst zeroId) _
+    (fullWhnfChargedState prims) = _
+  unfold EStateM.bind
+  rw [betaFullChargedGetZero prims]
+  rfl
+
+theorem betaFullChargedDeltaNone (prims : Primitives .anon) :
+    (RecM.deltaUnfoldOne betaArg).run betaHarnessMethods
+      (fullWhnfChargedState prims) =
+      .ok none (fullWhnfChargedState prims) := by
+  unfold RecM.deltaUnfoldOne
+  rw [ReaderT.run_bind]
+  change EStateM.bind
+    ((RecM.tryDeltaUnfold betaArg).run betaHarnessMethods) _
+      (fullWhnfChargedState prims) = _
+  unfold EStateM.bind
+  rw [betaFullChargedTryDeltaNone prims]
+  unfold betaArg
+  rw [KExpr.mkConst_shape]
+  change EStateM.bind (TcM.tryGetConst zeroId) _
+    (fullWhnfChargedState prims) = _
+  unfold EStateM.bind
+  rw [betaFullChargedGetZero prims]
+  rfl
+
+/-- One full-WHNF iteration first consumes the certified no-delta hit, proves
+the fresh cycle set cannot stop it, and then checks native, bitvector, Nat,
+Decidable, String, and delta reducers in their production order. -/
+theorem betaFullWhnfStep (prims : Primitives .anon) :
+    (RecM.whnfWithNatSuccModeStep .collapse (betaSource, {})).run
+      betaHarnessMethods (fullWhnfChargedState prims) =
+      .ok (.done betaArg) (fullWhnfChargedState prims) := by
+  unfold RecM.whnfWithNatSuccModeStep
+  rw [ReaderT.run_bind]
+  change EStateM.bind
+    ((RecM.whnfNoDeltaImpl betaSource .FULL .collapse).run
+      betaHarnessMethods) _ (fullWhnfChargedState prims) = _
+  unfold EStateM.bind
+  rw [fullWhnfCharged_noDeltaHit prims]
+  simp only
+  have hcycle : ({} : Std.HashSet Address).contains betaArg.addr = false := by
+    change ({} : Std.HashMap Address Unit).contains betaArg.addr = false
+    exact Std.HashMap.contains_empty
+  simp only [hcycle, Bool.false_eq_true, if_false, pure_bind]
+  rw [ReaderT.run_bind]
+  change EStateM.bind
+    ((RecM.tryReduceNative betaArg).run betaHarnessMethods) _
+      (fullWhnfChargedState prims) = _
+  unfold EStateM.bind
+  rw [RecM.tryReduceNative_noAccel rfl]
+  simp only
+  rw [ReaderT.run_bind]
+  change EStateM.bind
+    ((RecM.tryReduceBitvec betaArg).run betaHarnessMethods) _
+      (fullWhnfChargedState prims) = _
+  unfold EStateM.bind
+  rw [RecM.tryReduceBitvec_noAccel rfl]
+  simp only
+  rw [ReaderT.run_bind]
+  change EStateM.bind
+    ((RecM.tryReduceNatWithSuccMode betaArg .collapse).run
+      betaHarnessMethods) _ (fullWhnfChargedState prims) = _
+  unfold EStateM.bind
+  rw [betaFullChargedNatNone prims]
+  simp only
+  rw [ReaderT.run_bind]
+  change EStateM.bind
+    ((RecM.tryReduceDecidable betaArg).run betaHarnessMethods) _
+      (fullWhnfChargedState prims) = _
+  unfold EStateM.bind
+  rw [RecM.tryReduceDecidable_noAccel rfl]
+  simp only
+  rw [ReaderT.run_bind]
+  change EStateM.bind
+    ((RecM.tryReduceString betaArg).run betaHarnessMethods) _
+      (fullWhnfChargedState prims) = _
+  unfold EStateM.bind
+  rw [betaFullChargedStringNone prims]
+  simp only
+  rw [ReaderT.run_bind]
+  change EStateM.bind
+    ((RecM.deltaUnfoldOne betaArg).run betaHarnessMethods) _
+      (fullWhnfChargedState prims) = _
+  unfold EStateM.bind
+  rw [betaFullChargedDeltaNone prims]
+  rfl
+
+theorem fullWhnfTrace (prims : Primitives .anon) :
+    RecM.WhnfFullTrace .noAccel whnfSemantics RawProjRel.none worldGood
+      coreCacheSupport 0 [] betaHarnessMethods .collapse
+      maxWhnfFuel.toNat (betaSource, {}) (fullWhnfChargedState prims)
+      betaArg (fullWhnfChargedState prims) := by
+  rw [show maxWhnfFuel.toNat = 10000 by rfl]
+  exact .done (fullWhnfChargedStateInv prims) (betaFullWhnfStep prims)
+    (fullWhnfChargedStateInv prims) betaResultMeaning
+
+/-- The exact state after the full driver commits its semantic cache entry. -/
+def fullWhnfWarmState (prims : Primitives .anon) : TcState .anon :=
+  let s := fullWhnfChargedState prims
+  {s with env := {s.env with
+    whnfCache := s.env.whnfCache.insert coreCacheKey betaArg}}
+
+theorem fullWhnfWarmStateInv (prims : Primitives .anon) :
+    WhnfStateInv .noAccel whnfSemantics RawProjRel.none worldGood
+      coreCacheSupport 0 [] (fullWhnfWarmState prims) := by
+  exact RecM.WhnfDriverCacheUpdate.full_whnfStateInv
+    (fullWhnfChargedStateInv prims) fullWhnfProvenance
+
+theorem fullWhnfCold_miss (prims : Primitives .anon) :
+    (fullNoDeltaWarmState prims).env.whnfCache[coreCacheKey]? = none := by
+  simp [fullNoDeltaWarmState, fullCoreWarmState, noAccelState, state,
+    loadedEnv, KEnv.insert, coreCacheKey]
+
+theorem fullWhnfWarm_hit (prims : Primitives .anon) :
+    (fullWhnfWarmState prims).env.whnfCache[coreCacheKey]? =
+      some betaArg := by
+  simp [fullWhnfWarmState, coreCacheKey]
+
+theorem fullWhnfPrefixWarm (prims : Primitives .anon) :
+    (RecM.whnfWithNatSuccModePrefix betaSource).run betaHarnessMethods
+      (fullWhnfWarmState prims) = .ok () (fullWhnfWarmState prims) := by
+  exact RecM.whnfWithNatSuccModePrefix_disabled rfl rfl
+
+/-- A cold public full-WHNF call pays one miss charge, executes its bounded
+semantic trace, inserts the result, and preserves the complete invariant. -/
+theorem fullWhnfColdAcceptance (prims : Primitives .anon) :
+    (RecM.whnf betaSource).run betaHarnessMethods
+        (fullNoDeltaWarmState prims) =
+          .ok betaArg (fullWhnfWarmState prims) ∧
+      WhnfStateInv .noAccel whnfSemantics RawProjRel.none worldGood
+        coreCacheSupport 0 [] (fullWhnfChargedState prims) ∧
+      WhnfStateInv .noAccel whnfSemantics RawProjRel.none worldGood
+        coreCacheSupport 0 [] (fullWhnfWarmState prims) ∧
+      WhnfMeaning RawProjRel.none worldGood 0 [] betaSource betaArg := by
+  simpa [RecM.whnf, whnfSemantics, fullWhnfWarmState] using
+    (RecM.whnfWithNatSuccMode_miss_acceptance
+      (keys := whnfContextKeys) (fallback := CacheSemantics.blockErrorsOnly)
+      structuralWhnfTheory (.direct RecM.WhnfDriverNonLeaf.app)
+      (fullWhnfPrefixCold prims)
+      (coreCacheKey_eval (fullNoDeltaWarmState prims))
+      (betaTransientFalse (fullNoDeltaWarmState prims))
+      (fullWhnfCold_miss prims) (fullWhnfMissCharge prims)
+      (fullWhnfTrace prims) rfl fullWhnfProvenance)
+
+/-- The next public call consumes the inserted entry as a semantic hit and
+does not pay another fuel charge or mutate any checker state. -/
+theorem fullWhnfWarmAcceptance (prims : Primitives .anon) :
+    (RecM.whnf betaSource).run betaHarnessMethods
+        (fullWhnfWarmState prims) =
+          .ok betaArg (fullWhnfWarmState prims) ∧
+      WhnfStateInv .noAccel whnfSemantics RawProjRel.none worldGood
+        coreCacheSupport 0 [] (fullWhnfWarmState prims) ∧
+      WhnfMeaning RawProjRel.none worldGood 0 [] betaSource betaArg := by
+  simpa [RecM.whnf, whnfSemantics] using
+    (RecM.whnfWithNatSuccMode_hit_acceptance
+      (keys := whnfContextKeys) (fallback := CacheSemantics.blockErrorsOnly)
+      (.direct RecM.WhnfDriverNonLeaf.app) (fullWhnfPrefixWarm prims)
+      (coreCacheKey_eval (fullWhnfWarmState prims))
+      (betaTransientFalse (fullWhnfWarmState prims))
+      (fullWhnfWarm_hit prims) (fullWhnfWarmStateInv prims) (.inl rfl)
+      (coreCacheKey_matches (fullWhnfWarmState prims)
+        (fullWhnfWarmStateInv prims).2.1))
+
+/-- The cold outer miss consumes exactly one unit; cache insertion and the
+subsequent warm hit consume none. -/
+theorem fullWhnfFuelDiscipline (prims : Primitives .anon) :
+    (fullNoDeltaWarmState prims).recFuel = maxRecFuel ∧
+      (fullWhnfChargedState prims).recFuel = maxRecFuel - 1 ∧
+      (fullWhnfWarmState prims).recFuel = maxRecFuel - 1 := by
+  simp [fullWhnfWarmState, fullWhnfChargedState, fullNoDeltaWarmState,
+    fullCoreWarmState, noAccelState, state]
+
+/-- The final state retains all three independently certified cache layers:
+structural core, no-delta, and full WHNF. -/
+theorem fullWhnfCacheLayering (prims : Primitives .anon) :
+    (fullWhnfWarmState prims).env.whnfCache[coreCacheKey]? = some betaArg ∧
+      (fullWhnfWarmState prims).env.whnfNoDeltaCache[coreCacheKey]? =
+        some betaArg ∧
+      (fullWhnfWarmState prims).env.whnfCoreCache[coreCacheKey]? =
+        some betaArg := by
+  constructor
+  · exact fullWhnfWarm_hit prims
+  constructor <;> simp [fullWhnfWarmState, fullWhnfChargedState,
+    fullNoDeltaWarmState, fullCoreWarmState, coreCacheKey]
+
+/-- G2a acceptance witness: one concrete state simultaneously contains a
+trusted, well-formed ambient Nat family; a successfully promoted standalone
+declaration that uses Nat; and an independently loaded pending declaration
+for which declaration WF is impossible. -/
+theorem acceptance (prims : Primitives .anon) :
+    TcInv RawProjRel.none worldGood (state prims) ∧
+    worldGood.trusted natId ∧
+    worldGood.trusted zeroId ∧
+    worldGood.trusted succId ∧
+    TrustedDecl RawProjRel.none worldGood goodId goodDecl ∧
+    PendingDecl RawProjRel.none worldGood IllTypedPending.targetId
+      IllTypedPending.theoryDecl ∧
+    ¬∃ env', VDecl.WF worldGood.venv IllTypedPending.theoryDecl env' :=
+  ⟨(stateWF prims).tcInv, nat_trusted_good, zero_trusted_good,
+    succ_trusted_good, goodTrustedDecl, badPending, badDecl_not_wf⟩
+
+end AmbientNat
+
+end Ix.Tc
diff --git a/Ix/Tc/Verify/Run.lean b/Ix/Tc/Verify/Run.lean
new file mode 100644
index 00000000..067d7964
--- /dev/null
+++ b/Ix/Tc/Verify/Run.lean
@@ -0,0 +1,438 @@
+import Ix.Tc.Verify.State
+import Ix.Tc.Verify.Execution
+import Ix.Tc.Verify.Frame
+
+/-!
+# G3b: execution-indexed run assumptions
+
+An explicit request list is not, by itself, evidence that it describes a
+checker run: choosing `[]` would make coverage and bounds vacuous.  This file
+closes that interface hole with `ExecutionRequests`, an inductive certificate
+indexed by the actual `TcM` computation and initial state. Its atomic constructors are exactly
+the currently audited interning operations; its composition constructors
+mirror `bind` and `tryCatch`.  There is deliberately no constructor that marks
+an arbitrary computation as silent.
+
+`ExecutionRequests` and `RunAssumptions` live in Verify/Execution.lean so the
+temporary statement skeleton can import them without importing concrete
+translation relations. The adapter lemmas here project that bundle into the
+existing walker masters and retain both finite intern ranges in post-states.
+-/
+
+namespace Ix.Tc
+
+/-- State invariant used by run-level adapters and top-level statements. G4
+adds stable-world provenance for every warm cache entry. -/
+def SupportedState (semantics : CacheSemantics) (trProj : RawProjRel)
+    (world : VerifyWorld)
+    (support : RunSupport) (s : TcState .anon) : Prop :=
+  KernelStateWF semantics trProj world support s
+
+/-- Rebuild full run support after an expression-only operation, using its
+universe-table frame. -/
+theorem RunSupport.CoversIntern.of_expr_univs {support : RunSupport}
+    {before after : InternTable .anon}
+    (hbefore : support.CoversIntern before)
+    (hexpr : ∀ e, after.ExprSupport e → support e)
+    (hunivs : after.univs = before.univs) :
+    support.CoversIntern after := by
+  refine ⟨hexpr, ?_⟩
+  intro u hu
+  exact hbefore.univ u (by
+    simpa only [InternTable.UnivSupport, hunivs] using hu)
+
+namespace RunAssumptions
+
+/-! ### Direct intern adapters -/
+
+/-- Direct expression interning is exact and keeps both intern ranges inside
+the run support. -/
+theorem internExpr_spec {α : Type} {initial : TcState .anon}
+    {program : TcM .anon α} {requests : List WalkerRequest}
+    {support : RunSupport}
+    (h : RunAssumptions initial program requests support)
+    {e : KExpr .anon} (hmem : WalkerRequest.internExpr e ∈ requests)
+    {it : InternTable .anon} (hwf : it.WF)
+    (hsup : support.CoversIntern it) :
+    (it.internExpr e).1 = e ∧
+      (it.internExpr e).2.WF ∧
+      support.CoversIntern (it.internExpr e).2 := by
+  have hSe : support e := h.coverage.internExpr hmem
+  have hkcf : KExpr.KeyCollisionFree
+      (fun v => it.ExprSupport v ∨ v = e) :=
+    KExpr.keyCollisionFree_anon.mpr <|
+      h.collisionFree.expr.mono fun x hx =>
+        hx.elim (hsup.expr x) fun hxe => hxe ▸ hSe
+  have hcanon : (it.internExpr e).1 = e := by
+    have heq := InternTable.internExpr_eraseMeta hwf hkcf
+    rwa [KExpr.eraseMeta_anon, KExpr.eraseMeta_anon] at heq
+  refine ⟨hcanon, hwf.internExpr e, ?_⟩
+  constructor
+  · intro x hx
+    rcases InternTable.ExprSupport.of_internExpr hx with hx | rfl
+    · exact hsup.expr x hx
+    · exact hSe
+  · intro u hu
+    exact hsup.univ u (by
+      simpa only [InternTable.UnivSupport,
+        InternTable.internExpr_univs] using hu)
+
+/-- Direct universe interning is exact and keeps both intern ranges inside
+the run support. -/
+theorem internUniv_spec {α : Type} {initial : TcState .anon}
+    {program : TcM .anon α} {requests : List WalkerRequest}
+    {support : RunSupport}
+    (h : RunAssumptions initial program requests support)
+    {u : KUniv .anon} (hmem : WalkerRequest.internUniv u ∈ requests)
+    {it : InternTable .anon} (hwf : it.WF)
+    (hsup : support.CoversIntern it) :
+    (it.internUniv u).1 = u ∧
+      (it.internUniv u).2.WF ∧
+      support.CoversIntern (it.internUniv u).2 := by
+  have hSu : support.univ u := h.coverage.internUniv hmem
+  have hcf : KUniv.CollisionFree
+      (fun v => it.UnivSupport v ∨ v = u) :=
+    h.collisionFree.univ.mono fun v hv =>
+      hv.elim (hsup.univ v) fun hvu => hvu ▸ hSu
+  have hcanon : (it.internUniv u).1 = u := by
+    have heq := InternTable.internUniv_eraseMeta hwf hcf
+    rwa [KUniv.eraseMeta_anon, KUniv.eraseMeta_anon] at heq
+  refine ⟨hcanon, hwf.internUniv u, ?_⟩
+  constructor
+  · intro x hx
+    exact hsup.expr x (by
+      simpa only [InternTable.ExprSupport,
+        InternTable.internUniv_exprs] using hx)
+  · intro v hv
+    rcases InternTable.UnivSupport.of_internUniv hv with hv | rfl
+    · exact hsup.univ v hv
+    · exact hSu
+
+/-! ### Existing walker-master adapters -/
+
+theorem lift_spec {α : Type} {initial : TcState .anon}
+    {program : TcM .anon α} {requests : List WalkerRequest}
+    {support : RunSupport}
+    (h : RunAssumptions initial program requests support)
+    {e : KExpr .anon} {shift cutoff : UInt64}
+    (hmem : WalkerRequest.lift e shift cutoff ∈ requests)
+    {it : InternTable .anon} (hwf : it.WF)
+    (hsup : support.CoversIntern it) :
+    (lift e shift cutoff it).1 = KExpr.liftSpec e shift cutoff ∧
+      (lift e shift cutoff it).2.WF ∧
+      support.CoversIntern (lift e shift cutoff it).2 := by
+  obtain ⟨hcon, hcut, _⟩ := h.requestBounds hmem
+  have post := Ix.Tc.lift_spec h.collisionFree.expr hcon hcut
+    (h.coverage.lift hmem) hwf hsup.expr
+  exact ⟨post.1, post.2.1,
+    hsup.of_expr_univs post.2.2 (lift_preservesUnivs e shift cutoff it)⟩
+
+theorem subst_spec {α : Type} {initial : TcState .anon}
+    {program : TcM .anon α} {requests : List WalkerRequest}
+    {support : RunSupport}
+    (h : RunAssumptions initial program requests support)
+    {body arg : KExpr .anon} {depth : UInt64}
+    (hmem : WalkerRequest.subst body arg depth ∈ requests)
+    {it : InternTable .anon} (hwf : it.WF)
+    (hsup : support.CoversIntern it) :
+    (subst body arg depth it).1 = KExpr.substSpec body arg depth ∧
+      (subst body arg depth it).2.WF ∧
+      support.CoversIntern (subst body arg depth it).2 := by
+  obtain ⟨hbody, harg, hcut, hargsz, _⟩ := h.requestBounds hmem
+  have post := Ix.Tc.subst_spec h.collisionFree.expr hbody harg hcut hargsz
+    (h.coverage.subst hmem) hwf hsup.expr
+  exact ⟨post.1, post.2.1,
+    hsup.of_expr_univs post.2.2 (subst_preservesUnivs body arg depth it)⟩
+
+theorem simulSubst_spec {α : Type} {initial : TcState .anon}
+    {program : TcM .anon α} {requests : List WalkerRequest}
+    {support : RunSupport}
+    (h : RunAssumptions initial program requests support)
+    {body : KExpr .anon} {substs : Array (KExpr .anon)} {depth : UInt64}
+    (hmem : WalkerRequest.simulSubst body substs depth ∈ requests)
+    {it : InternTable .anon} (hwf : it.WF)
+    (hsup : support.CoversIntern it) :
+    (simulSubst body substs depth it).1 =
+        KExpr.simulSubstSpec body substs depth ∧
+      (simulSubst body substs depth it).2.WF ∧
+      support.CoversIntern (simulSubst body substs depth it).2 := by
+  obtain ⟨hbody, hsubsts, hsizes, hwalk, _⟩ := h.requestBounds hmem
+  have post := Ix.Tc.simulSubst_spec h.collisionFree.expr hbody hsubsts
+    hsizes hwalk (h.coverage.simulSubst hmem) hwf hsup.expr
+  exact ⟨post.1, post.2.1,
+    hsup.of_expr_univs post.2.2
+      (simulSubst_preservesUnivs body substs depth it)⟩
+
+theorem instRev_spec {α : Type} {initial : TcState .anon}
+    {program : TcM .anon α} {requests : List WalkerRequest}
+    {support : RunSupport}
+    (h : RunAssumptions initial program requests support)
+    {body : KExpr .anon} {fvars : Array (KExpr .anon)}
+    (hmem : WalkerRequest.instRev body fvars ∈ requests)
+    {it : InternTable .anon} (hwf : it.WF)
+    (hsup : support.CoversIntern it) :
+    (instantiateRev body fvars it).1 =
+        KExpr.instantiateRevSpec body fvars 0 ∧
+      (instantiateRev body fvars it).2.WF ∧
+      support.CoversIntern (instantiateRev body fvars it).2 := by
+  obtain ⟨hbody, _, hwalk⟩ := h.requestBounds hmem
+  have post := Ix.Tc.instantiateRev_spec h.collisionFree.expr hbody hwalk
+    (h.coverage.instRev hmem) hwf hsup.expr
+  exact ⟨post.1, post.2.1,
+    hsup.of_expr_univs post.2.2
+      (instantiateRev_preservesUnivs body fvars it)⟩
+
+/-- API-level abstraction adapter, including its two no-op fast paths. -/
+theorem abstractFVars_spec {α : Type} {initial : TcState .anon}
+    {program : TcM .anon α} {requests : List WalkerRequest}
+    {support : RunSupport}
+    (h : RunAssumptions initial program requests support)
+    {body : KExpr .anon} {fvars : Array FVarId}
+    (hmem : WalkerRequest.abstractFVars body fvars ∈ requests)
+    {it : InternTable .anon} (hwf : it.WF)
+    (hsup : support.CoversIntern it) :
+    (abstractFVars body fvars it).1 =
+        KExpr.abstractFVarsResult body fvars ∧
+      (abstractFVars body fvars it).2.WF ∧
+      support.CoversIntern (abstractFVars body fvars it).2 := by
+  obtain ⟨hbody, _, hwalk, _⟩ := h.requestBounds hmem
+  have post :
+      (abstractFVars body fvars it).1 =
+          KExpr.abstractFVarsResult body fvars ∧
+        (abstractFVars body fvars it).2.WF ∧
+        (∀ x, (abstractFVars body fvars it).2.ExprSupport x →
+          support x) := by
+    by_cases hfast : (fvars.isEmpty || !body.hasFVars) = true
+    · have hrun : abstractFVars body fvars it = (body, it) := by
+        rw [abstractFVars_eq, if_pos hfast]
+        rfl
+      rw [hrun]
+      exact ⟨by simp [KExpr.abstractFVarsResult, hfast], hwf, hsup.expr⟩
+    · have cached := Ix.Tc.abstractFVarsCached_spec
+          h.collisionFree.expr hbody
+          (depth := 0) (it := it) (sc := {}) (by simpa using hwalk)
+          (h.coverage.abstractFVars hmem) hwf hsup.expr
+          (WalkScratchInv.empty support _)
+      have hrun : abstractFVars body fvars it =
+          ((abstractFVarsCached body (abstractFVarPositions fvars)
+            fvars.size.toUInt64 0 (it, {})).1,
+           (abstractFVarsCached body (abstractFVarPositions fvars)
+            fvars.size.toUInt64 0 (it, {})).2.1) := by
+        rw [abstractFVars_eq, if_neg hfast]
+        rfl
+      rw [hrun]
+      exact ⟨by
+        rw [KExpr.abstractFVarsResult, if_neg hfast]
+        exact cached.result, cached.wf, cached.sup⟩
+  exact ⟨post.1, post.2.1,
+    hsup.of_expr_univs post.2.2
+      (abstractFVars_preservesUnivs body fvars it)⟩
+
+/-- Adapter for the cached abstraction master.  The remaining API wrapper
+lemma exposes the slow-path master separately for recursive proof clients. -/
+theorem abstractFVarsCached_spec {α : Type}
+    {initial : TcState .anon} {program : TcM .anon α}
+    {requests : List WalkerRequest} {support : RunSupport}
+    (h : RunAssumptions initial program requests support)
+    {body : KExpr .anon} {fvars : Array FVarId}
+    (hmem : WalkerRequest.abstractFVars body fvars ∈ requests)
+    {depth : UInt64} {it : InternTable .anon} {sc : Scratch .anon}
+    (hdepth : depth = 0)
+    (hwf : it.WF) (hsup : ∀ x, it.ExprSupport x → support x)
+    (hsc : WalkScratchInv support
+      (KExpr.abstractFVarsSpec · (abstractFVarPositions fvars)
+        fvars.size.toUInt64 ·) sc) :
+    WalkPost support
+      (KExpr.abstractFVarsSpec · (abstractFVarPositions fvars)
+        fvars.size.toUInt64 ·)
+      depth body
+      (abstractFVarsCached body (abstractFVarPositions fvars)
+        fvars.size.toUInt64 depth (it, sc)) := by
+  subst depth
+  obtain ⟨hbody, _, hwalk, _⟩ := h.requestBounds hmem
+  exact Ix.Tc.abstractFVarsCached_spec h.collisionFree.expr hbody
+    (by simpa using hwalk) (h.coverage.abstractFVars hmem) hwf hsup hsc
+
+theorem instantiateUnivParams_wf {α : Type}
+    {initial : TcState .anon} {program : TcM .anon α}
+    {requests : List WalkerRequest} {support : RunSupport}
+    (h : RunAssumptions initial program requests support)
+    {e : KExpr .anon} {us : Array (KUniv .anon)}
+    (hmem : WalkerRequest.instUniv e us ∈ requests)
+    {s : TcState .anon} :
+    TcM.WF (fun s => s.env.intern.WF ∧
+        ∀ x, s.env.intern.ExprSupport x → support x) s
+      (TcM.instantiateUnivParams e us)
+      (fun r s' => KExpr.instantiateUnivParamsSpec e us = .ok r ∧
+        s' = { s with env := { s.env with intern := s'.env.intern } } ∧
+        s'.env.intern.univs = s.env.intern.univs)
+      (fun _ s' =>
+        s' = { s with env := { s.env with intern := s'.env.intern } } ∧
+        s'.env.intern.univs = s.env.intern.univs) :=
+  TcM.instantiateUnivParams_wf h.collisionFree.expr
+    (h.coverage.instUniv hmem)
+
+/-! ### Hoare adapters for checker-proof composition -/
+
+/-- Generic bridge from an `InternM` master to the checker Hoare kernel.
+`runIntern` changes only `env.intern`, so loaded/catalog agreement frames
+automatically while the supplied master re-establishes key coherence and both
+finite intern ranges. -/
+theorem runIntern_supported_wf {semantics : CacheSemantics}
+    {trProj : RawProjRel}
+    {world : VerifyWorld} {support : RunSupport}
+    {x : InternM .anon α} {expected : α} {s : TcState .anon}
+    (hspec : ∀ it : InternTable .anon, it.WF →
+      support.CoversIntern it →
+      (x it).1 = expected ∧ (x it).2.WF ∧
+        support.CoversIntern (x it).2) :
+    TcM.WF (SupportedState semantics trProj world support) s
+      (TcM.runIntern x)
+      (fun result s' => result = expected ∧
+        s' = { s with env := { s.env with intern := s'.env.intern } }) := by
+  intro hI
+  obtain ⟨hstate, hsupport, hcaches⟩ := hI
+  rcases hrun : x s.env.intern with ⟨result, intern⟩
+  have hpost := hspec s.env.intern hstate.intern hsupport
+  rw [hrun] at hpost
+  simp only [TcM.runIntern, hrun]
+  refine ⟨⟨hstate.of_consts_eq rfl hpost.2.1, hpost.2.2,
+      hcaches.of_intern_update⟩,
+    hpost.1, trivial⟩
+
+theorem lift_wf {α : Type} {initial : TcState .anon}
+    {program : TcM .anon α} {requests : List WalkerRequest}
+    {support : RunSupport}
+    (h : RunAssumptions initial program requests support)
+    {semantics : CacheSemantics} {trProj : RawProjRel} {world : VerifyWorld}
+    {e : KExpr .anon} {shift cutoff : UInt64}
+    (hmem : WalkerRequest.lift e shift cutoff ∈ requests)
+    {s : TcState .anon} :
+    TcM.WF (SupportedState semantics trProj world support) s
+      (TcM.runIntern (lift e shift cutoff))
+      (fun result s' => result = KExpr.liftSpec e shift cutoff ∧
+        s' = { s with env := { s.env with intern := s'.env.intern } }) :=
+  runIntern_supported_wf fun _ hwf hsup =>
+    h.lift_spec hmem hwf hsup
+
+theorem subst_wf {α : Type} {initial : TcState .anon}
+    {program : TcM .anon α} {requests : List WalkerRequest}
+    {support : RunSupport}
+    (h : RunAssumptions initial program requests support)
+    {semantics : CacheSemantics} {trProj : RawProjRel} {world : VerifyWorld}
+    {body arg : KExpr .anon} {depth : UInt64}
+    (hmem : WalkerRequest.subst body arg depth ∈ requests)
+    {s : TcState .anon} :
+    TcM.WF (SupportedState semantics trProj world support) s
+      (TcM.runIntern (subst body arg depth))
+      (fun result s' => result = KExpr.substSpec body arg depth ∧
+        s' = { s with env := { s.env with intern := s'.env.intern } }) :=
+  runIntern_supported_wf fun _ hwf hsup =>
+    h.subst_spec hmem hwf hsup
+
+theorem simulSubst_wf {α : Type} {initial : TcState .anon}
+    {program : TcM .anon α} {requests : List WalkerRequest}
+    {support : RunSupport}
+    (h : RunAssumptions initial program requests support)
+    {semantics : CacheSemantics} {trProj : RawProjRel} {world : VerifyWorld}
+    {body : KExpr .anon} {substs : Array (KExpr .anon)} {depth : UInt64}
+    (hmem : WalkerRequest.simulSubst body substs depth ∈ requests)
+    {s : TcState .anon} :
+    TcM.WF (SupportedState semantics trProj world support) s
+      (TcM.runIntern (simulSubst body substs depth))
+      (fun result s' =>
+        result = KExpr.simulSubstSpec body substs depth ∧
+        s' = { s with env := { s.env with intern := s'.env.intern } }) :=
+  runIntern_supported_wf fun _ hwf hsup =>
+    h.simulSubst_spec hmem hwf hsup
+
+theorem instRev_wf {α : Type} {initial : TcState .anon}
+    {program : TcM .anon α} {requests : List WalkerRequest}
+    {support : RunSupport}
+    (h : RunAssumptions initial program requests support)
+    {semantics : CacheSemantics} {trProj : RawProjRel} {world : VerifyWorld}
+    {body : KExpr .anon} {fvars : Array (KExpr .anon)}
+    (hmem : WalkerRequest.instRev body fvars ∈ requests)
+    {s : TcState .anon} :
+    TcM.WF (SupportedState semantics trProj world support) s
+      (TcM.runIntern (instantiateRev body fvars))
+      (fun result s' =>
+        result = KExpr.instantiateRevSpec body fvars 0 ∧
+        s' = { s with env := { s.env with intern := s'.env.intern } }) :=
+  runIntern_supported_wf fun _ hwf hsup =>
+    h.instRev_spec hmem hwf hsup
+
+theorem abstractFVars_wf {α : Type} {initial : TcState .anon}
+    {program : TcM .anon α} {requests : List WalkerRequest}
+    {support : RunSupport}
+    (h : RunAssumptions initial program requests support)
+    {semantics : CacheSemantics} {trProj : RawProjRel} {world : VerifyWorld}
+    {body : KExpr .anon} {fvars : Array FVarId}
+    (hmem : WalkerRequest.abstractFVars body fvars ∈ requests)
+    {s : TcState .anon} :
+    TcM.WF (SupportedState semantics trProj world support) s
+      (TcM.runIntern (abstractFVars body fvars))
+      (fun result s' =>
+        result = KExpr.abstractFVarsResult body fvars ∧
+        s' = { s with env := { s.env with intern := s'.env.intern } }) :=
+  runIntern_supported_wf fun _ hwf hsup =>
+    h.abstractFVars_spec hmem hwf hsup
+
+/-- Universe instantiation can throw after extending the expression intern
+table, so this adapter explicitly re-establishes the invariant and frame on
+both outcomes. -/
+theorem instUniv_wf {α : Type} {initial : TcState .anon}
+    {program : TcM .anon α} {requests : List WalkerRequest}
+    {support : RunSupport}
+    (h : RunAssumptions initial program requests support)
+    {semantics : CacheSemantics} {trProj : RawProjRel} {world : VerifyWorld}
+    {e : KExpr .anon} {us : Array (KUniv .anon)}
+    (hmem : WalkerRequest.instUniv e us ∈ requests)
+    {s : TcState .anon} :
+    TcM.WF (SupportedState semantics trProj world support) s
+      (TcM.instantiateUnivParams e us)
+      (fun result s' =>
+        KExpr.instantiateUnivParamsSpec e us = .ok result ∧
+        s' = { s with env := { s.env with intern := s'.env.intern } })
+      (fun _ s' =>
+        s' = { s with env := { s.env with intern := s'.env.intern } }) := by
+  intro hI
+  obtain ⟨hstate, hsupport, hcaches⟩ := hI
+  have hrunWF := h.instantiateUnivParams_wf hmem
+    (s := s) ⟨hstate.intern, hsupport.expr⟩
+  match hrun : TcM.instantiateUnivParams e us s with
+  | .ok result s' =>
+    rw [hrun] at hrunWF
+    have hintern := hrunWF.1.1
+    have hsupport' := hrunWF.1.2
+    have hspec := hrunWF.2.1
+    have hframe := hrunWF.2.2.1
+    have hunivs := hrunWF.2.2.2
+    have hcovered := hsupport.of_expr_univs hsupport' hunivs
+    have hconsts : s'.env.consts = s.env.consts :=
+      congrArg (fun state => state.env.consts) hframe
+    have hcaches' : CacheInvariant semantics
+        (CacheAuthority.stable world) support s'.env := by
+      rw [hframe]
+      exact hcaches.of_intern_update
+    exact ⟨⟨hstate.of_consts_eq hconsts hintern, hcovered, hcaches'⟩,
+      hspec, hframe⟩
+  | .error err s' =>
+    rw [hrun] at hrunWF
+    have hintern := hrunWF.1.1
+    have hsupport' := hrunWF.1.2
+    have hframe := hrunWF.2.1
+    have hunivs := hrunWF.2.2
+    have hcovered := hsupport.of_expr_univs hsupport' hunivs
+    have hconsts : s'.env.consts = s.env.consts :=
+      congrArg (fun state => state.env.consts) hframe
+    have hcaches' : CacheInvariant semantics
+        (CacheAuthority.stable world) support s'.env := by
+      rw [hframe]
+      exact hcaches.of_intern_update
+    exact ⟨⟨hstate.of_consts_eq hconsts hintern, hcovered, hcaches'⟩,
+      hframe⟩
+
+end RunAssumptions
+
+end Ix.Tc
diff --git a/Ix/Tc/Verify/State.lean b/Ix/Tc/Verify/State.lean
index 2a90fa1e..e3b7ffbf 100644
--- a/Ix/Tc/Verify/State.lean
+++ b/Ix/Tc/Verify/State.lean
@@ -1,242 +1,370 @@
 import Ix.Tc.Verify.Env
 import Ix.Tc.Verify.Monad
 import Ix.Tc.Verify.InstUniv
+import Ix.Tc.Verify.Cache
 
 /-!
-# The ghost state and the run invariant
-
-The environment-representation divergence from upstream, made concrete:
-lean4lean's environment
-is *reader context* (fixed per `M.WF` call), ours is **mutable state**
-(lazy ingress inserts constants mid-check). So the `TrEnv`-analog lives
-inside a Hoare invariant: a ghost `VState` (the Theory-side environment
-plus the ghost name assignment) related to the concrete `TcState` by
-`TcStateWF`, under the monotone extension order `VState.LE` — a run
-only ever *grows* the ghost state.
-
-`TcInv vs₀ s` — "some ghost state ≥ the baseline `vs₀` describes `s`" —
-is the concrete invariant `I` that the Hoare combinators (Verify/
-Monad.lean, `I`-generic by design) get instantiated with from here on.
-Like the env translation it is parametric over the reference-safety
-level `safety` (the ghost venv holds the in-safety fragment; the v1
-headline instantiates `.safe`).
-
-`TcStateWF` deliberately constrains only the SEMANTIC core of the
-20-field `TcState`: the constant map (via `TrKEnv`) and the intern
-table (via `InternTable.WF`). Everything else — fuel, flags, scratch,
-statistics — is framed away by `of_env_eq`. Cache-coherence fields
-(whnf/infer/defEq entries valid) join the structure with their
-consumers, the whnf/infer soundness layers.
+# The verification world and the run invariant
+
+`TcStateWF` is the concrete/ghost boundary used by the Hoare proofs.  It
+deliberately separates three independent facts:
+
+* `TrustedCatalogRel` justifies exactly the declarations already admitted to
+  the Theory environment;
+* `LoadedAgrees` says every lazily loaded concrete declaration is the entry
+  committed by the immutable catalog, without typing that entry;
+* `InternTable.WF` gives structural coherence for hash-consing.
+
+Consequently, a concrete `KEnv` may contain a pending or ill-typed catalog
+entry while `TcStateWF` still holds.  Loading a catalog entry leaves the
+world unchanged.  Growing the trusted world is a separate ghost operation
+whose API requires the new `VDecl.WF` evidence.
+
+`TcInv world₀ s` existentially hides the current world while retaining a
+monotone extension proof from the caller's baseline.  Fixed-world Hoare
+triples are proved first below; their error branches retain exactly the same
+world, so ordinary state mutation cannot silently promote a declaration.
+
+Ambient-inductive admission is carried by the trusted log beginning in G2a.
+G4 layers finite-support cache provenance onto this deliberately small core
+through `KernelStateWF` below. Dual-context agreement and the concrete
+reduction/inference/native semantic contracts remain K1/K2 obligations.
 -/
 
 namespace Ix.Tc
 
-open Lean4Lean (VExpr VEnv)
-
-/-- The ghost state: the Theory-side environment plus the ghost name
-    assignment for content addresses. Everything else the checker
-    mutates is either framed away or (caches) validated against these. -/
-structure VState where
-  venv : VEnv
-  nameOf : Address → Option Lean.Name
-
-/-- Monotone extension: the Theory env grows (`VEnv.LE`) and the name
-    assignment never forgets. -/
-structure VState.LE (vs vs' : VState) : Prop where
-  venv : vs.venv ≤ vs'.venv
-  nameOf : ∀ a n, vs.nameOf a = some n → vs'.nameOf a = some n
-
-instance : LE VState := ⟨VState.LE⟩
-
-theorem VState.le_refl (vs : VState) : vs ≤ vs :=
-  ⟨⟨id, id⟩, fun _ _ h => h⟩
-
-theorem VState.LE.trans {vs₁ vs₂ vs₃ : VState} (h1 : vs₁ ≤ vs₂)
-    (h2 : vs₂ ≤ vs₃) : vs₁ ≤ vs₃ :=
-  ⟨h1.venv.trans h2.venv, fun a n h => h2.nameOf a n (h1.nameOf a n h)⟩
-
-variable (safety : Ix.DefinitionSafety)
-    (trProj : List VExpr → Lean.Name → Nat → VExpr → VExpr → Prop) in
-/-- The concrete state is described by the ghost state: the constant
-    map translates (`TrKEnv`) and the intern table is well-formed.
-    Extension point for the whnf/infer cache-coherence conditions. -/
-structure TcStateWF (s : TcState .anon) (vs : VState) : Prop where
-  env : TrKEnv safety vs.nameOf trProj s.env vs.venv
+open Lean4Lean (VDecl VExpr)
+
+/-- A concrete checker state is coherent with one verification world.
+
+The trusted catalog log is semantic; loaded agreement is representation-only.
+In particular, neither `loaded` nor `intern` implies that an untrusted catalog
+entry is well-typed. -/
+structure TcStateWF (trProj : RawProjRel) (s : TcState .anon)
+    (world : VerifyWorld) : Prop where
+  trustedCatalog : TrustedCatalogRel trProj world
+  loaded : LoadedAgrees world.catalog s.env
   intern : s.env.intern.WF
 
-/-- The wide frame: any state operation preserving the constant map and
-    the intern table preserves `TcStateWF` — fuel ticks, flag flips,
-    depth bumps, statistics, scratch. -/
-theorem TcStateWF.of_consts_eq {safety trProj} {s s' : TcState .anon}
-    {vs : VState} (h : TcStateWF safety trProj s vs)
+/-- The wide frame used by intern-table walkers: preserving the loaded
+constant map and re-establishing intern coherence preserves `TcStateWF`.
+Fuel, flags, scratch state, and statistics remain unconstrained. -/
+theorem TcStateWF.of_consts_eq {trProj : RawProjRel}
+    {s s' : TcState .anon} {world : VerifyWorld}
+    (h : TcStateWF trProj s world)
     (hc : s'.env.consts = s.env.consts)
     (hi : s'.env.intern.WF) :
-    TcStateWF safety trProj s' vs := by
-  refine ⟨?_, hi⟩
-  obtain ⟨Q, henv⟩ := h.env
-  exact ⟨Q, hc ▸ henv⟩
-
-/-- `of_consts_eq` when the whole env is untouched. -/
-theorem TcStateWF.of_env_eq {safety trProj} {s s' : TcState .anon}
-    {vs : VState} (h : TcStateWF safety trProj s vs)
-    (he : s'.env = s.env) :
-    TcStateWF safety trProj s' vs :=
+    TcStateWF trProj s' world := by
+  refine ⟨h.trustedCatalog, ?_, hi⟩
+  intro id c hget
+  apply h.loaded
+  simpa [KEnv.get?, hc] using hget
+
+/-- `of_consts_eq` when the entire concrete environment is untouched. -/
+theorem TcStateWF.of_env_eq {trProj : RawProjRel}
+    {s s' : TcState .anon} {world : VerifyWorld}
+    (h : TcStateWF trProj s world) (he : s'.env = s.env) :
+    TcStateWF trProj s' world :=
   h.of_consts_eq (by rw [he]) (he ▸ h.intern)
 
-variable (safety : Ix.DefinitionSafety)
-    (trProj : List VExpr → Lean.Name → Nat → VExpr → VExpr → Prop) in
-/-- The run invariant: some ghost state above the baseline describes the
-    current concrete state. This is the `I` the Hoare kernel gets
-    instantiated with from here on — monotonicity in the baseline lets
-    callers thread one
-    invariant through sub-calls that grow the environment. -/
-def TcInv (vs₀ : VState) (s : TcState .anon) : Prop :=
-  ∃ vs, vs₀ ≤ vs ∧ TcStateWF safety trProj s vs
-
-theorem TcStateWF.tcInv {safety trProj} {s : TcState .anon}
-    {vs : VState} (h : TcStateWF safety trProj s vs) :
-    TcInv safety trProj vs s :=
-  ⟨vs, VState.le_refl vs, h⟩
-
-/-- Weaken the baseline. -/
-theorem TcInv.mono {safety trProj} {vs₀ vs₀' : VState}
-    {s : TcState .anon} (hle : vs₀' ≤ vs₀)
-    (h : TcInv safety trProj vs₀ s) : TcInv safety trProj vs₀' s :=
-  let ⟨vs, hvs, hwf⟩ := h
-  ⟨vs, hle.trans hvs, hwf⟩
-
-/-- Every `TcInv` state has a well-formed Theory environment. -/
-theorem TcInv.venv_wf {safety trProj} {vs₀ : VState}
-    {s : TcState .anon} (h : TcInv safety trProj vs₀ s) :
-    ∃ vs, vs₀ ≤ vs ∧ vs.venv.WF :=
-  let ⟨vs, hvs, hwf⟩ := h
-  ⟨vs, hvs, hwf.env.wf⟩
-
-/-- In-safety lookups under the invariant translate, at some ghost
-    state above the baseline (`TrKEnv.find?` lifted to `TcInv`). This
-    is the lemma that discharges the `TrKExprS.const` premises at
-    `checkConst` read sites; its `hs` hypothesis is the
-    `checkNoUnsafeRefs` bridge (at the infer/checkConst soundness layers). -/
-theorem TcInv.find? {safety trProj} {vs₀ : VState} {s : TcState .anon}
-    (h : TcInv safety trProj vs₀ s) {j : KId .anon} {c : KConst .anon}
-    (hg : s.env.get? j = some c) (hs : safety ≤ c.safety) :
-    ∃ vs, vs₀ ≤ vs ∧ ∃ n ci', vs.nameOf j.addr = some n ∧
-      vs.venv.constants n = some ci' ∧
-      TrKConstant safety vs.venv vs.nameOf trProj c ci' :=
-  let ⟨vs, hvs, hwf⟩ := h
-  ⟨vs, hvs, hwf.env.find? hg hs⟩
-
-/-! ### Growth: ingress steps as ghost-state transitions
-
-The other half of the monotone design: inserting a translated constant
-re-establishes `TcStateWF` at a strictly larger ghost state (the
-`TrKEnv'` log steps, viewed as `TcState` transitions — the shape the
-ingress-path verification will discharge per constant). The ghost
-`nameOf` is total from the start; only `venv` grows — and not at all
-for `skip` steps. -/
-
-/-- Ingress of an axiom: the `axio` log step as a state transition. -/
-theorem TcStateWF.insert_axio {safety trProj} {s : TcState .anon}
-    {vs : VState} {id : KId .anon} {nm : Mode.anon.F Name}
-    {lps : Mode.anon.F (Array Name)} {isUnsafe : Bool} {lvls : UInt64}
-    {ty : KExpr .anon} {ci' : Lean4Lean.VConstVal} {venv' : VEnv}
-    (h : TcStateWF safety trProj s vs)
-    (h1 : TrKConstVal safety vs.venv vs.nameOf trProj id.addr
-      (.axio nm lps isUnsafe lvls ty) ci')
-    (h2 : s.env.consts[id]? = none)
-    (h3 : ci'.WF vs.venv)
-    (h4 : vs.venv.addConst ci'.name ci'.toVConstant = some venv') :
-    TcStateWF safety trProj
-      { s with env := s.env.insert id (.axio nm lps isUnsafe lvls ty) }
-      ⟨venv', vs.nameOf⟩ ∧ vs ≤ ⟨venv', vs.nameOf⟩ := by
-  obtain ⟨Q, henv⟩ := h.env
-  exact ⟨⟨⟨Q, .axio h1 h2 h3 h4 henv⟩, h.intern⟩,
-    ⟨VEnv.addConst_le h4, fun _ _ hn => hn⟩⟩
-
-/-- Ingress of an in-safety definition: the `defn` log step as a state
-    transition. -/
-theorem TcStateWF.insert_defn {safety trProj} {s : TcState .anon}
-    {vs : VState} {id : KId .anon} {nm : Mode.anon.F Name}
-    {lps : Mode.anon.F (Array Name)} {kind : Ix.DefKind}
-    {dsafety : Ix.DefinitionSafety} {hints : Lean.ReducibilityHints}
-    {lvls : UInt64} {ty val : KExpr .anon}
-    {leanAll : Mode.anon.F (Array (KId .anon))} {block : KId .anon}
-    {ci' : Lean4Lean.VDefVal} {venv' : VEnv}
-    (h : TcStateWF safety trProj s vs)
-    (h1 : TrKDefVal safety vs.venv vs.nameOf trProj id.addr
-      (.defn nm lps kind dsafety hints lvls ty val leanAll block) val
-      ci')
-    (h2 : s.env.consts[id]? = none)
-    (h3 : ci'.WF vs.venv)
-    (h4 : vs.venv.addConst ci'.name ci'.toVConstant = some venv') :
-    TcStateWF safety trProj
-      { s with env :=
-          (s.env.insert id
-            (.defn nm lps kind dsafety hints lvls ty val leanAll
-              block)) }
-      ⟨venv'.addDefEq ci'.toDefEq, vs.nameOf⟩ ∧
-    vs ≤ ⟨venv'.addDefEq ci'.toDefEq, vs.nameOf⟩ := by
-  obtain ⟨Q, henv⟩ := h.env
-  exact ⟨⟨⟨Q, .defn h1 h2 h3 h4 henv⟩, h.intern⟩,
-    ⟨(VEnv.addConst_le h4).trans VEnv.addDefEq_le, fun _ _ hn => hn⟩⟩
-
-/-- Ingress of an out-of-safety constant: the `skip` log step as a
-    state transition — the ghost state does not move at all. -/
-theorem TcStateWF.insert_skip {safety trProj} {s : TcState .anon}
-    {vs : VState} {id : KId .anon} {c : KConst .anon}
-    (h : TcStateWF safety trProj s vs)
-    (h1 : ¬safety ≤ c.safety)
-    (h2 : s.env.consts[id]? = none) :
-    TcStateWF safety trProj { s with env := s.env.insert id c } vs := by
-  obtain ⟨Q, henv⟩ := h.env
-  exact ⟨⟨Q, .skip h1 h2 henv⟩, h.intern⟩
-
-/-! ### Validation: the Hoare helpers under the real invariant -/
-
-/-- `tick` preserves the run invariant (fuel is framed away). -/
-theorem TcM.tick.tcInv {safety trProj} {vs₀ : VState}
+/-- Lazy ingress is representation-only.  Loading the catalog's exact entry
+does not change the trusted set or the Theory environment. -/
+theorem TcStateWF.load {trProj : RawProjRel} {s : TcState .anon}
+    {world : VerifyWorld} {id : KId .anon} {c : KConst .anon}
+    (h : TcStateWF trProj s world) (hcat : world.catalog id = some c) :
+    TcStateWF trProj
+      { s with env := s.env.insert id c }
+      world := by
+  exact ⟨h.trustedCatalog, LoadedAgrees.insert h.loaded hcat, h.intern⟩
+
+/-- Semantic admission is ghost-only and requires the declaration-WF fact
+supplied by successful checking.  The concrete state remains unchanged. -/
+theorem TcStateWF.promote {trProj : RawProjRel} {s : TcState .anon}
+    {world : VerifyWorld} {id : KId .anon} {d : VDecl}
+    {venv' : Lean4Lean.VEnv}
+    (h : TcStateWF trProj s world)
+    (hpending : PendingDecl trProj world id d)
+    (hwf : VDecl.WF world.venv d venv') :
+    ∃ world',
+      Promotes world (fun target => target = id) world' ∧
+      TcStateWF trProj s world' ∧
+      TrustedDecl trProj world' id d := by
+  obtain ⟨world', hpromotes, htrustedCatalog, htrustedDecl⟩ :=
+    TrustedCatalogRel.promote h.trustedCatalog hpending hwf
+  refine ⟨world', hpromotes, ?_, htrustedDecl⟩
+  exact ⟨htrustedCatalog,
+    (LoadedAgrees.world_iff hpromotes.1).mp h.loaded,
+    h.intern⟩
+
+/-- The run invariant: some world extending the caller's baseline describes
+the current concrete state. -/
+def TcInv (trProj : RawProjRel) (world₀ : VerifyWorld)
+    (s : TcState .anon) : Prop :=
+  ∃ world, world₀ ≤ world ∧ TcStateWF trProj s world
+
+/-! ## G4 semantic-cache layer -/
+
+/-- The complete stable checker invariant at a finite run boundary.
+
+`TcStateWF` remains the small catalog/trusted/intern core used by individual
+walker proofs. This layer adds the exact run support and semantic provenance
+for every warm cache entry. The authority is stable: no pending declaration
+or active block is available to justify a cache dependency. Internal block
+proofs use `CacheAuthority` directly while the block is active, then establish
+this stable form only after promotion or error rollback. -/
+structure KernelStateWF (semantics : CacheSemantics) (trProj : RawProjRel)
+    (world : VerifyWorld) (support : RunSupport)
+    (s : TcState .anon) : Prop where
+  core : TcStateWF trProj s world
+  internSupport : support.CoversIntern s.env.intern
+  caches : CacheInvariant semantics (CacheAuthority.stable world) support s.env
+
+/-- Existential current-world form of the complete G4 state invariant. -/
+def KernelTcInv (semantics : CacheSemantics) (trProj : RawProjRel)
+    (world₀ : VerifyWorld) (support : RunSupport)
+    (s : TcState .anon) : Prop :=
+  ∃ world, world₀ ≤ world ∧ KernelStateWF semantics trProj world support s
+
+namespace KernelStateWF
+
+/-- Build the complete state invariant when the physical environment has no
+semantic cache entries. Constants, blocks, and intern tables may be nonempty. -/
+theorem of_no_cache_entries {semantics : CacheSemantics}
+    {trProj : RawProjRel} {world : VerifyWorld} {support : RunSupport}
+    {s : TcState .anon} (hcore : TcStateWF trProj s world)
+    (hintern : support.CoversIntern s.env.intern)
+    (hempty : ∀ entry, ¬s.env.HasCacheEntry entry) :
+    KernelStateWF semantics trProj world support s :=
+  ⟨hcore, hintern, CacheInvariant.of_no_entries hempty⟩
+
+/-- A physical hit in a stable state exposes its complete provenance. -/
+theorem cacheHit {semantics : CacheSemantics} {trProj : RawProjRel}
+    {world : VerifyWorld} {support : RunSupport} {s : TcState .anon}
+    (h : KernelStateWF semantics trProj world support s)
+    {entry : CacheEntry} (hhit : s.env.HasCacheEntry entry) :
+    CacheProvenance semantics (CacheAuthority.stable world) support entry :=
+  h.caches.hit hhit
+
+/-- No warm cache hit at a stable boundary—reduction or structural—can name
+the pending declaration as a dependency. -/
+theorem pendingCacheIsolation {semantics : CacheSemantics}
+    {trProj : RawProjRel} {world : VerifyWorld} {support : RunSupport}
+    {s : TcState .anon} (h : KernelStateWF semantics trProj world support s)
+    {target : KId .anon} {d : VDecl}
+    (hpending : PendingDecl trProj world target d)
+    {entry : CacheEntry} (hhit : s.env.HasCacheEntry entry) :
+    ¬entry.References support target := by
+  apply (h.cacheHit hhit).pending_isolation_stable
+  · exact fun _ hactive => hactive
+  · exact hpending
+
+/-- Reassemble the complete stable invariant after the public check-error
+boundary. The failed run may retain lazy loads and intern growth, so those
+ordinary core/support facts come from `after`; every semantic cache fact comes
+from the already-valid `before` state, except unconditional cached errors. -/
+theorem restoreCheckCachesOnError {semantics : CacheSemantics}
+    {trProj : RawProjRel} {world : VerifyWorld} {support : RunSupport}
+    {before after : TcState .anon}
+    (hbefore : KernelStateWF semantics trProj world support before)
+    (hafterCore : TcStateWF trProj after world)
+    (hafterIntern : support.CoversIntern after.env.intern) :
+    KernelStateWF semantics trProj world support
+      (before.restoreCheckCachesOnError after) := by
+  refine ⟨?_, ?_, ?_⟩
+  · apply hafterCore.of_consts_eq
+    · simp [TcState.restoreCheckCachesOnError]
+    · simpa [TcState.restoreCheckCachesOnError] using hafterCore.intern
+  · simpa [TcState.restoreCheckCachesOnError] using hafterIntern
+  · exact hbefore.caches.restoreCheckCachesOnError
+
+end KernelStateWF
+
+namespace KernelTcInv
+
+/-- A fixed-world complete invariant embeds into its existential baseline
+form. -/
+theorem of_state {semantics : CacheSemantics} {trProj : RawProjRel}
+    {world : VerifyWorld} {support : RunSupport} {s : TcState .anon}
+    (h : KernelStateWF semantics trProj world support s) :
+    KernelTcInv semantics trProj world support s :=
+  ⟨world, VerifyWorld.LE.rfl, h⟩
+
+end KernelTcInv
+
+theorem TcStateWF.tcInv {trProj : RawProjRel} {s : TcState .anon}
+    {world : VerifyWorld} (h : TcStateWF trProj s world) :
+    TcInv trProj world s :=
+  ⟨world, VerifyWorld.LE.rfl, h⟩
+
+/-- Weaken the baseline world. -/
+theorem TcInv.mono {trProj : RawProjRel}
+    {world₀ world₀' : VerifyWorld} {s : TcState .anon}
+    (hle : world₀' ≤ world₀) (h : TcInv trProj world₀ s) :
+    TcInv trProj world₀' s :=
+  let ⟨world, hworld, hwf⟩ := h
+  ⟨world, hle.trans hworld, hwf⟩
+
+/-- Every invariant witness carries an explicitly justified, well-formed
+Theory environment. -/
+theorem TcInv.venv_wf {trProj : RawProjRel} {world₀ : VerifyWorld}
+    {s : TcState .anon} (h : TcInv trProj world₀ s) :
+    ∃ world, world₀ ≤ world ∧ world.venv.WF :=
+  let ⟨world, hworld, hwf⟩ := h
+  ⟨world, hworld, hwf.trustedCatalog.wf⟩
+
+/-- A concrete lookup is only a catalog lookup.  Semantic lookup additionally
+requires that the id is trusted in this exact world. -/
+theorem TcStateWF.find? {trProj : RawProjRel} {s : TcState .anon}
+    {world : VerifyWorld} (h : TcStateWF trProj s world)
+    {id : KId .anon} {c : KConst .anon}
+    (hget : s.env.get? id = some c) (htrusted : world.trusted id) :
+    world.catalog id = some c ∧
+      TrustedCatalogEntry trProj world.catalog world.nameOf world.venv id :=
+  ⟨h.loaded hget, h.trustedCatalog.find htrusted⟩
+
+/-- Consumer-facing trusted resolution.  A concrete cache hit plus trust
+yields exact unified provenance without a whole-`KEnv` translation premise. -/
+theorem TcStateWF.resolve {trProj : RawProjRel} {s : TcState .anon}
+    {world : VerifyWorld} (h : TcStateWF trProj s world)
+    {id : KId .anon} {c : KConst .anon}
+    (hget : s.env.get? id = some c) (htrusted : world.trusted id) :
+    ∃ name ci, TrustedConstRel trProj world id c name ci :=
+  h.trustedCatalog.resolve htrusted (h.loaded hget)
+
+/-- Trusted lookup lifted through the existential current-world witness.
+Trust in the baseline is enough because world extension never forgets it. -/
+theorem TcInv.find? {trProj : RawProjRel} {world₀ : VerifyWorld}
+    {s : TcState .anon} (h : TcInv trProj world₀ s)
+    {id : KId .anon} {c : KConst .anon}
+    (hget : s.env.get? id = some c) (htrusted : world₀.trusted id) :
+    ∃ world, world₀ ≤ world ∧
+      world.catalog id = some c ∧
+      TrustedCatalogEntry trProj world.catalog world.nameOf world.venv id := by
+  obtain ⟨world, hworld, hwf⟩ := h
+  obtain ⟨hcat, hlookup⟩ := hwf.find? hget (hworld.trusted htrusted)
+  exact ⟨world, hworld, hcat, hlookup⟩
+
+/-- Unified trusted resolution lifted through the existential current world. -/
+theorem TcInv.resolve {trProj : RawProjRel} {world₀ : VerifyWorld}
+    {s : TcState .anon} (h : TcInv trProj world₀ s)
+    {id : KId .anon} {c : KConst .anon}
+    (hget : s.env.get? id = some c) (htrusted : world₀.trusted id) :
+    ∃ world, world₀ ≤ world ∧
+      ∃ name ci, TrustedConstRel trProj world id c name ci := by
+  obtain ⟨world, hworld, hwf⟩ := h
+  exact ⟨world, hworld, hwf.resolve hget (hworld.trusted htrusted)⟩
+
+/-! ## Adversarial state fixture -/
+
+namespace IllTypedPending
+
+/-- The pending declaration is concretely loaded, but remains outside the
+trusted semantic world. -/
+def loadedEnv : KEnv .anon :=
+  ({} : KEnv .anon).insert targetId concrete
+
+def state (prims : Primitives .anon) : TcState .anon :=
+  { env := loadedEnv, prims, ctxId := fixtureAddress }
+
+theorem stateWF (prims : Primitives .anon) :
+    TcStateWF RawProjRel.none (state prims) world := by
+  refine ⟨trustedCatalogRel, ?_, ?_⟩
+  · change LoadedAgrees world.catalog loadedEnv
+    exact loaded_pending_but_not_wf.1
+  · exact InternTable.WF.empty
+
+/-- G1's central adversarial witness: the complete state invariant and
+pending precondition are inhabited even though declaration WF is impossible.
+This rules out a hidden whole-`KEnv` typing premise in `TcInv`. -/
+theorem tcInv_pending_but_not_wf (prims : Primitives .anon) :
+    TcInv RawProjRel.none world (state prims) ∧
+      PendingDecl RawProjRel.none world targetId theoryDecl ∧
+      ¬∃ env', VDecl.WF world.venv theoryDecl env' :=
+  ⟨(stateWF prims).tcInv, pending, theoryDecl_not_wf⟩
+
+end IllTypedPending
+
+/-! ## Validation on stateful helpers -/
+
+/-- `tick` preserves an exact world on both success and error.  This is the
+fixed-world form of the no-promotion-on-error guarantee. -/
+theorem TcM.tick.tcStateWF {trProj : RawProjRel} {world : VerifyWorld}
     {s : TcState .anon} :
-    TcM.WF (TcInv safety trProj vs₀) s (TcM.tick (m := .anon))
+    TcM.WF (fun s => TcStateWF trProj s world) s
+      (TcM.tick (m := .anon))
+      (fun _ s' => s'.recFuel = s.recFuel - 1)
+      (fun e s' => e = .maxRecFuel ∧ s' = s) :=
+  TcM.tick.wf fun _ h => h.of_env_eq rfl
+
+/-- Existential-world wrapper for callers threading a baseline world. -/
+theorem TcM.tick.tcInv {trProj : RawProjRel} {world₀ : VerifyWorld}
+    {s : TcState .anon} :
+    TcM.WF (TcInv trProj world₀) s (TcM.tick (m := .anon))
       (fun _ s' => s'.recFuel = s.recFuel - 1)
       (fun e s' => e = .maxRecFuel ∧ s' = s) :=
   TcM.tick.wf fun _ h =>
-    let ⟨vs, hvs, hwf⟩ := h
-    ⟨vs, hvs, hwf.of_env_eq rfl⟩
-
-/-- The first walker × run-invariant composition:
-    `instantiateUnivParams` preserves the run invariant — its frame
-    moves only `env.intern`, whose well-formedness the walker triple
-    (Verify/InstUniv.lean) carries through both outcomes. The caller
-    supplies the pre-state intern-support condition (`S` covers the
-    table) exactly as in that theorem; `TcInv` supplies the intern
-    `WF` half itself. -/
-theorem TcM.instantiateUnivParams.tcInv {safety trProj} {vs₀ : VState}
+    let ⟨world, hworld, hwf⟩ := h
+    ⟨world, hworld, hwf.of_env_eq rfl⟩
+
+/-- `instantiateUnivParams` preserves one exact world on both outcomes; only
+the structurally coherent intern table changes. -/
+theorem TcM.instantiateUnivParams.tcStateWF
+    {trProj : RawProjRel} {world : VerifyWorld}
     {S : KExpr .anon → Prop} {us : Array (KUniv .anon)}
     {e : KExpr .anon} {s : TcState .anon}
     (hcf : KExpr.CollisionFree S)
     (hreach : ∀ x, KExpr.InstUnivReach us e x → S x)
     (hsup : ∀ x, s.env.intern.ExprSupport x → S x) :
-    TcM.WF (TcInv safety trProj vs₀) s (TcM.instantiateUnivParams e us)
+    TcM.WF (fun s => TcStateWF trProj s world) s
+      (TcM.instantiateUnivParams e us)
       (fun r s' => KExpr.instantiateUnivParamsSpec e us = .ok r ∧
         s' = { s with env := { s.env with intern := s'.env.intern } })
       (fun _ s' =>
         s' = { s with env := { s.env with intern := s'.env.intern } }) := by
-  intro hI
-  obtain ⟨vs, hvs, hwf⟩ := hI
-  have h2 := TcM.instantiateUnivParams_wf hcf hreach
+  intro hwf
+  have hrunWF := TcM.instantiateUnivParams_wf hcf hreach
     (s := s) ⟨hwf.intern, hsup⟩
   match hrun : TcM.instantiateUnivParams e us s with
   | .ok r s' =>
-    rw [hrun] at h2
-    obtain ⟨⟨hwf', _⟩, hspec, hframe⟩ := h2
+    rw [hrun] at hrunWF
+    have hintern := hrunWF.1.1
+    have hspec := hrunWF.2.1
+    have hframe := hrunWF.2.2.1
     have hc : s'.env.consts = s.env.consts :=
       congrArg (fun t => t.env.consts) hframe
-    exact ⟨⟨vs, hvs, hwf.of_consts_eq hc hwf'⟩, hspec, hframe⟩
+    exact ⟨hwf.of_consts_eq hc hintern, hspec, hframe⟩
   | .error err s' =>
-    rw [hrun] at h2
-    obtain ⟨⟨hwf', _⟩, hframe⟩ := h2
+    rw [hrun] at hrunWF
+    have hintern := hrunWF.1.1
+    have hframe := hrunWF.2.1
     have hc : s'.env.consts = s.env.consts :=
       congrArg (fun t => t.env.consts) hframe
-    exact ⟨⟨vs, hvs, hwf.of_consts_eq hc hwf'⟩, hframe⟩
+    exact ⟨hwf.of_consts_eq hc hintern, hframe⟩
+
+/-- Existential-world wrapper for the run invariant. -/
+theorem TcM.instantiateUnivParams.tcInv
+    {trProj : RawProjRel} {world₀ : VerifyWorld}
+    {S : KExpr .anon → Prop} {us : Array (KUniv .anon)}
+    {e : KExpr .anon} {s : TcState .anon}
+    (hcf : KExpr.CollisionFree S)
+    (hreach : ∀ x, KExpr.InstUnivReach us e x → S x)
+    (hsup : ∀ x, s.env.intern.ExprSupport x → S x) :
+    TcM.WF (TcInv trProj world₀) s
+      (TcM.instantiateUnivParams e us)
+      (fun r s' => KExpr.instantiateUnivParamsSpec e us = .ok r ∧
+        s' = { s with env := { s.env with intern := s'.env.intern } })
+      (fun _ s' =>
+        s' = { s with env := { s.env with intern := s'.env.intern } }) := by
+  intro hI
+  obtain ⟨world, hworld, hwf⟩ := hI
+  have hrunWF := TcM.instantiateUnivParams.tcStateWF
+    (trProj := trProj) (world := world) hcf hreach hsup hwf
+  match hrun : TcM.instantiateUnivParams e us s with
+  | .ok r s' =>
+    rw [hrun] at hrunWF
+    exact ⟨⟨world, hworld, hrunWF.1⟩, hrunWF.2⟩
+  | .error err s' =>
+    rw [hrun] at hrunWF
+    exact ⟨⟨world, hworld, hrunWF.1⟩, hrunWF.2⟩
 
 end Ix.Tc
diff --git a/Ix/Tc/Verify/Statements.lean b/Ix/Tc/Verify/Statements.lean
index ad8da6f8..37f9cd45 100644
--- a/Ix/Tc/Verify/Statements.lean
+++ b/Ix/Tc/Verify/Statements.lean
@@ -1,5 +1,6 @@
 import Ix.Tc.Check
-import Ix.Tc.Verify.Monad
+import Ix.Tc.Verify.Execution
+import Ix.Tc.Verify.State
 import Lean4Lean.Theory.VEnv
 
 /-!
@@ -8,10 +9,13 @@ import Lean4Lean.Theory.VEnv
 Sorried statements of the program's target theorems, written against
 the Hoare kernel (Verify/Monad.lean). The translation relations are
 `opaque` stubs — *stubs with types*: every statement below is a legal
-proposition today whose
-text never changes as the concrete relations (`TrKExprS`/`TrKExpr` in
-Verify/Trans.lean, `CollisionFree` in Verify/Expr.lean, `TcInv`/`TrKEnv`
-in Verify/State.lean and Verify/Env.lean) replace the stubs.
+proposition today whose shape changes only at named architecture milestones
+as the concrete relations (`TrKExprS`/`TrKExpr` in Verify/Trans.lean, finite
+`RunSupport`/`ResourceBounds` in Verify/Support.lean, execution-indexed
+`RunAssumptions` in Verify/Execution.lean, and
+`KernelTcInv`/`TrustedConstRel` in Verify/State.lean and Verify/Env.lean)
+replace the stubs. G4 has now replaced the state-invariant stub itself;
+only the judgment-level relations below remain provisional.
 Judgment plumbing (universe counts, contexts) deliberately routes through
 the stub relations so the shapes don't churn while that plumbing is
 designed; the theory anchor is `Lean4Lean`'s `VExpr`/`VConstant`.
@@ -25,73 +29,97 @@ namespace Ix.Tc
 
 open Lean4Lean (VExpr VConstant)
 
-variable {m : Mode}
-
-/-- The run-wide kernel state invariant (the ghost `VState` view —
-    cache soundness, env translation, intern support; concrete form:
-    `TcInv`, Verify/State.lean). -/
-opaque KernelInv : {m : Mode} → TcState m → Prop
-
-/-- No Blake3 collisions among this run's interned terms (`Set.InjOn`
-    over the intern-table range, up to anon erasure; concrete form:
-    `CollisionFreeOn`, Verify/Expr.lean). -/
-opaque CollisionFree : {m : Mode} → TcState m → Prop
+/-- The headline invariant is now the concrete G4 invariant: some current
+trusted world extends the caller's baseline and justifies the loaded catalog,
+intern range, and every warm cache entry under one finite run support. -/
+def KernelRunInv (semantics : CacheSemantics) (trProj : RawProjRel)
+    (world₀ : VerifyWorld) (support : RunSupport)
+    (s : TcState .anon) : Prop :=
+  KernelTcInv semantics trProj world₀ support s
 
 /-- Expression translation: `KExpr` denotes this theory-level `VExpr` in
     the current state's context (the `TrExprS` analog over `KVLCtx`,
     with owned `prj`/literal cases; concrete form: `TrKExprS`,
     Verify/Trans.lean). -/
-opaque TrKExpr : {m : Mode} → TcState m → KExpr m → VExpr → Prop
+opaque StatementTrKExpr :
+  {m : Mode} → TcState m → KExpr m → VExpr → Prop
 
 /-- Constant translation: the constant at `id` denotes this theory-level
-    `VConstant` (the `TrConstant` analog over `KEnv`; Verify/Env.lean). -/
-opaque TrKConst : {m : Mode} → TcState m → KId m → VConstant → Prop
+    `VConstant` (concrete G2b interface: exact loaded/trusted resolution via
+    `TrustedConstRel`, Verify/Env.lean). -/
+opaque StatementTrKConst :
+  {m : Mode} → TcState m → KId m → VConstant → Prop
 
 /-- The state's environment translates to a well-formed `VEnv` extension
     in which `d` is a valid constant (the `NativeOracle` defeqs
     enter as the env's `.extra` judgments). -/
-opaque TrustedConst : {m : Mode} → TcState m → VConstant → Prop
+opaque StatementTrustedConst :
+  {m : Mode} → TcState m → VConstant → Prop
 
 /-- Theory-level definitional equality of the translations, in the
     current state's environment and context (translation-layer plumbing). -/
-opaque KDefEqU : {m : Mode} → TcState m → VExpr → VExpr → Prop
+opaque StatementKDefEqU :
+  {m : Mode} → TcState m → VExpr → VExpr → Prop
 
 /-- Theory-level typing of the translations (translation-layer plumbing). -/
-opaque KHasType : {m : Mode} → TcState m → VExpr → VExpr → Prop
+opaque StatementKHasType :
+  {m : Mode} → TcState m → VExpr → VExpr → Prop
 
 /-- **`whnf` soundness shape**: reduction preserves the translation
     up to theory-level defeq. -/
-theorem TcM.whnf.wf {s : TcState m} {e : KExpr m} {ve : VExpr}
-    (hcf : CollisionFree s) (he : TrKExpr s e ve) :
-    TcM.WF KernelInv s (TcM.whnf e)
-      (fun e' s' => ∃ ve', TrKExpr s' e' ve' ∧ KDefEqU s' ve ve') := by
+theorem TcM.whnf.wf {s : TcState .anon} {e : KExpr .anon} {ve : VExpr}
+    {semantics : CacheSemantics} {trProj : RawProjRel}
+    {world₀ : VerifyWorld}
+    {support : RunSupport} {requests : List WalkerRequest}
+    (hrun : RunAssumptions s (TcM.whnf e) requests support)
+    (he : StatementTrKExpr s e ve) :
+    TcM.WF (KernelRunInv semantics trProj world₀ support) s (TcM.whnf e)
+      (fun e' s' => ∃ ve', StatementTrKExpr s' e' ve' ∧
+        StatementKDefEqU s' ve ve') := by
   sorry
 
 /-- **`infer` soundness shape**: the inferred type translates and
     types the subject. -/
-theorem TcM.infer.wf {s : TcState m} {e : KExpr m} {ve : VExpr}
-    (hcf : CollisionFree s) (he : TrKExpr s e ve) :
-    TcM.WF KernelInv s (TcM.infer e)
-      (fun ty s' => ∃ vty, TrKExpr s' ty vty ∧ KHasType s' ve vty) := by
+theorem TcM.infer.wf {s : TcState .anon} {e : KExpr .anon} {ve : VExpr}
+    {semantics : CacheSemantics} {trProj : RawProjRel}
+    {world₀ : VerifyWorld}
+    {support : RunSupport} {requests : List WalkerRequest}
+    (hrun : RunAssumptions s (TcM.infer e) requests support)
+    (he : StatementTrKExpr s e ve) :
+    TcM.WF (KernelRunInv semantics trProj world₀ support) s (TcM.infer e)
+      (fun ty s' => ∃ vty, StatementTrKExpr s' ty vty ∧
+        StatementKHasType s' ve vty) := by
   sorry
 
 /-- **`isDefEq` soundness shape**: a `true` verdict implies
     theory-level definitional equality. (`false` implies nothing —
     incompleteness is not unsoundness.) -/
-theorem TcM.isDefEq.wf {s : TcState m} {a b : KExpr m} {va vb : VExpr}
-    (hcf : CollisionFree s) (ha : TrKExpr s a va) (hb : TrKExpr s b vb) :
-    TcM.WF KernelInv s (TcM.isDefEq a b)
-      (fun r s' => r = true → KDefEqU s' va vb) := by
+theorem TcM.isDefEq.wf {s : TcState .anon}
+    {a b : KExpr .anon} {va vb : VExpr}
+    {semantics : CacheSemantics} {trProj : RawProjRel}
+    {world₀ : VerifyWorld}
+    {support : RunSupport} {requests : List WalkerRequest}
+    (hrun : RunAssumptions s (TcM.isDefEq a b) requests support)
+    (ha : StatementTrKExpr s a va) (hb : StatementTrKExpr s b vb) :
+    TcM.WF (KernelRunInv semantics trProj world₀ support) s
+      (TcM.isDefEq a b)
+      (fun r s' => r = true → StatementKDefEqU s' va vb) := by
   sorry
 
 /-- **`checkConst` soundness shape** (the headline): acceptance means
     the constant translates to a trusted theory-level constant —
-    conditional on `CollisionFree` (and, inside `TrustedConst`, the
-    `NativeOracle` defeqs and upstream Theory debt). -/
-theorem TcM.checkConst.wf {s : TcState m} {id : KId m}
-    (hcf : CollisionFree s) :
-    TcM.WF KernelInv s (TcM.checkConst id)
-      (fun _ s' => ∃ d, TrKConst s' id d ∧ TrustedConst s' d) := by
+    conditional on the concrete execution-indexed finite run assumptions
+    (and, inside `StatementTrustedConst`, the `NativeOracle` defeqs and
+    upstream Theory debt). -/
+theorem TcM.checkConst.wf {s : TcState .anon} {id : KId .anon}
+    {semantics : CacheSemantics} {trProj : RawProjRel}
+    {world₀ : VerifyWorld}
+    {support : RunSupport} {requests : List WalkerRequest}
+    (hrun : RunAssumptions s (TcM.checkConst id) requests support) :
+    TcM.WF (KernelRunInv semantics trProj world₀ support) s
+      (TcM.checkConst id)
+      (fun _ s' => ∃ d, StatementTrKConst s' id d ∧
+        StatementTrustedConst s' d) := by
   sorry
 
 end Ix.Tc
diff --git a/Ix/Tc/Verify/Support.lean b/Ix/Tc/Verify/Support.lean
new file mode 100644
index 00000000..333f1a72
--- /dev/null
+++ b/Ix/Tc/Verify/Support.lean
@@ -0,0 +1,758 @@
+import Ix.Tc.Verify.InstUniv
+import Std.Data.HashMap.Lemmas
+
+/-!
+# G3: finite run-scoped collision and arithmetic support
+
+The expression walkers were already proved against an abstract predicate
+`S`, with separate hypotheses that their reach relation and the initial
+intern-table range lie inside `S`.  This module makes the missing composition
+layer explicit:
+
+* `FiniteSupport` gives a small, constructive notion of a finite predicate;
+* every currently formalized expression-walker reach is proved finite;
+* `WalkerRequest` records the operations whose address observations belong to
+  one run, including direct expression and universe interning;
+* `RunSupport` packages a finite expression predicate, while
+  `CheckConstSupport` proves that it covers the initial intern table and every
+  recorded request; and
+* `ResourceBounds` records both the walk-execution bounds and the stronger
+  bounds needed to keep generated lift/substitution results `Constructed`.
+
+`Verify/Run.lean` connects these finite requests to actual `TcM` computations
+with a proof-level execution certificate.  Later soundness slices extend that
+certificate through whnf, inference, definitional equality, and cache-key
+operations.  Nothing here treats constructor closure as support: that would
+be infinite and would make finite collision freedom impossible.
+-/
+
+namespace Ix.Tc
+
+/-! ## Constructive finite predicates -/
+
+/-- A predicate is finite when one concrete list contains every witness.
+Duplicates are harmless, and no decidable equality or classical choice is
+needed. -/
+def FiniteSupport {α : Type u} (S : α → Prop) : Prop :=
+  ∃ xs : List α, ∀ ⦃x⦄, S x → x ∈ xs
+
+namespace FiniteSupport
+
+theorem empty : FiniteSupport (fun _ : α => False) :=
+  ⟨[], fun {_} h => False.elim h⟩
+
+theorem singleton (a : α) : FiniteSupport (fun x => x = a) :=
+  ⟨[a], fun {x} h => by subst x; simp⟩
+
+/-- Finiteness is downward closed. -/
+theorem mono {S T : α → Prop} (hT : FiniteSupport T)
+    (hsub : ∀ x, S x → T x) : FiniteSupport S := by
+  obtain ⟨xs, hxs⟩ := hT
+  exact ⟨xs, fun {x} h => hxs (hsub x h)⟩
+
+theorem union {S T : α → Prop} (hS : FiniteSupport S)
+    (hT : FiniteSupport T) : FiniteSupport (fun x => S x ∨ T x) := by
+  obtain ⟨xs, hxs⟩ := hS
+  obtain ⟨ys, hys⟩ := hT
+  refine ⟨xs ++ ys, fun {_} h => ?_⟩
+  exact List.mem_append.mpr <| h.elim (fun hs => .inl (hxs hs))
+    (fun ht => .inr (hys ht))
+
+end FiniteSupport
+
+/-! ## Existing walker reaches are genuinely finite -/
+
+private def liftReachList (shift : UInt64) :
+    KExpr .anon → UInt64 → List (KExpr .anon)
+  | e, cutoff =>
+    e :: KExpr.liftSpec e shift cutoff ::
+      match e with
+      | .app f a _ => liftReachList shift f cutoff ++
+          liftReachList shift a cutoff
+      | .lam _ _ ty body _ | .all _ _ ty body _ =>
+        liftReachList shift ty cutoff ++
+          liftReachList shift body (cutoff + 1)
+      | .letE _ ty val body _ _ =>
+        liftReachList shift ty cutoff ++
+          liftReachList shift val cutoff ++
+          liftReachList shift body (cutoff + 1)
+      | .prj _ _ val _ => liftReachList shift val cutoff
+      | _ => []
+
+private theorem mem_liftReachList {shift cutoff : UInt64}
+    {e x : KExpr .anon} :
+    x ∈ liftReachList shift e cutoff ↔ KExpr.LiftReach shift e cutoff x := by
+  induction e generalizing cutoff
+  <;> simp_all [KExpr.LiftReach, liftReachList, or_assoc, or_left_comm,
+    or_comm]
+
+namespace KExpr.LiftReach
+
+/-- The exact, spec-determined footprint of one lift walk has finite support. -/
+theorem finite (shift : UInt64) (e : KExpr .anon) (cutoff : UInt64) :
+    FiniteSupport (KExpr.LiftReach shift e cutoff) :=
+  ⟨liftReachList shift e cutoff, fun {_} h => mem_liftReachList.mpr h⟩
+
+end KExpr.LiftReach
+
+private def substReachList (arg : KExpr .anon) :
+    KExpr .anon → UInt64 → List (KExpr .anon)
+  | body, depth =>
+    body :: KExpr.substSpec body arg depth ::
+      match body with
+      | .var _ _ _ => liftReachList depth arg 0
+      | .app f a _ => substReachList arg f depth ++
+          substReachList arg a depth
+      | .lam _ _ ty inner _ | .all _ _ ty inner _ =>
+        substReachList arg ty depth ++
+          substReachList arg inner (depth + 1)
+      | .letE _ ty val inner _ _ =>
+        substReachList arg ty depth ++
+          substReachList arg val depth ++
+          substReachList arg inner (depth + 1)
+      | .prj _ _ val _ => substReachList arg val depth
+      | _ => []
+
+private theorem mem_substReachList {arg body x : KExpr .anon}
+    {depth : UInt64} :
+    x ∈ substReachList arg body depth ↔
+      KExpr.SubstReach arg body depth x := by
+  induction body generalizing depth
+  <;> simp_all [KExpr.SubstReach, substReachList, mem_liftReachList,
+    or_assoc, or_left_comm, or_comm]
+
+namespace KExpr.SubstReach
+
+/-- The composed substitution footprint, including its nested lift calls, is
+finite. -/
+theorem finite (arg body : KExpr .anon) (depth : UInt64) :
+    FiniteSupport (KExpr.SubstReach arg body depth) :=
+  ⟨substReachList arg body depth, fun {_} h => mem_substReachList.mpr h⟩
+
+end KExpr.SubstReach
+
+private def simulSubstReachList (substs : Array (KExpr .anon)) :
+    KExpr .anon → UInt64 → List (KExpr .anon)
+  | body, depth =>
+    body :: KExpr.simulSubstSpec body substs depth ::
+      match body with
+      | .var i _ _ => liftReachList depth substs[(i - depth).toNat]! 0
+      | .app f a _ => simulSubstReachList substs f depth ++
+          simulSubstReachList substs a depth
+      | .lam _ _ ty inner _ | .all _ _ ty inner _ =>
+        simulSubstReachList substs ty depth ++
+          simulSubstReachList substs inner (depth + 1)
+      | .letE _ ty val inner _ _ =>
+        simulSubstReachList substs ty depth ++
+          simulSubstReachList substs val depth ++
+          simulSubstReachList substs inner (depth + 1)
+      | .prj _ _ val _ => simulSubstReachList substs val depth
+      | _ => []
+
+private theorem mem_simulSubstReachList
+    {substs : Array (KExpr .anon)} {body x : KExpr .anon}
+    {depth : UInt64} :
+    x ∈ simulSubstReachList substs body depth ↔
+      KExpr.SimulSubstReach substs body depth x := by
+  induction body generalizing depth
+  <;> simp_all [KExpr.SimulSubstReach, simulSubstReachList,
+    mem_liftReachList, or_assoc, or_left_comm, or_comm]
+
+namespace KExpr.SimulSubstReach
+
+/-- Simultaneous substitution, including every nested lift footprint, has a
+finite spec-determined support. -/
+theorem finite (substs : Array (KExpr .anon)) (body : KExpr .anon)
+    (depth : UInt64) :
+    FiniteSupport (KExpr.SimulSubstReach substs body depth) :=
+  ⟨simulSubstReachList substs body depth,
+    fun {_} h => mem_simulSubstReachList.mpr h⟩
+
+end KExpr.SimulSubstReach
+
+private def instRevReachList (fvars : Array (KExpr .anon)) :
+    KExpr .anon → UInt64 → List (KExpr .anon)
+  | body, depth =>
+    body :: KExpr.instantiateRevSpec body fvars depth ::
+      match body with
+      | .app f a _ => instRevReachList fvars f depth ++
+          instRevReachList fvars a depth
+      | .lam _ _ ty inner _ | .all _ _ ty inner _ =>
+        instRevReachList fvars ty depth ++
+          instRevReachList fvars inner (depth + 1)
+      | .letE _ ty val inner _ _ =>
+        instRevReachList fvars ty depth ++
+          instRevReachList fvars val depth ++
+          instRevReachList fvars inner (depth + 1)
+      | .prj _ _ val _ => instRevReachList fvars val depth
+      | _ => []
+
+private theorem mem_instRevReachList
+    {fvars : Array (KExpr .anon)} {body x : KExpr .anon}
+    {depth : UInt64} :
+    x ∈ instRevReachList fvars body depth ↔
+      KExpr.InstRevReach fvars body depth x := by
+  induction body generalizing depth
+  <;> simp_all [KExpr.InstRevReach, instRevReachList,
+    or_assoc, or_left_comm, or_comm]
+
+namespace KExpr.InstRevReach
+
+/-- Reverse binder instantiation has a finite spec-determined support. -/
+theorem finite (fvars : Array (KExpr .anon)) (body : KExpr .anon)
+    (depth : UInt64) :
+    FiniteSupport (KExpr.InstRevReach fvars body depth) :=
+  ⟨instRevReachList fvars body depth,
+    fun {_} h => mem_instRevReachList.mpr h⟩
+
+end KExpr.InstRevReach
+
+private def abstractReachList (pos : Std.HashMap FVarId UInt64)
+    (n : UInt64) : KExpr .anon → UInt64 → List (KExpr .anon)
+  | body, depth =>
+    body :: KExpr.abstractFVarsSpec body pos n depth ::
+      match body with
+      | .app f a _ => abstractReachList pos n f depth ++
+          abstractReachList pos n a depth
+      | .lam _ _ ty inner _ | .all _ _ ty inner _ =>
+        abstractReachList pos n ty depth ++
+          abstractReachList pos n inner (depth + 1)
+      | .letE _ ty val inner _ _ =>
+        abstractReachList pos n ty depth ++
+          abstractReachList pos n val depth ++
+          abstractReachList pos n inner (depth + 1)
+      | .prj _ _ val _ => abstractReachList pos n val depth
+      | _ => []
+
+private theorem mem_abstractReachList
+    {pos : Std.HashMap FVarId UInt64} {n depth : UInt64}
+    {body x : KExpr .anon} :
+    x ∈ abstractReachList pos n body depth ↔
+      KExpr.AbstractReach pos n body depth x := by
+  induction body generalizing depth
+  <;> simp_all [KExpr.AbstractReach, abstractReachList,
+    or_assoc, or_left_comm, or_comm]
+
+namespace KExpr.AbstractReach
+
+/-- Fvar abstraction against a fixed finite position map has a finite
+spec-determined expression support. -/
+theorem finite (pos : Std.HashMap FVarId UInt64) (n : UInt64)
+    (body : KExpr .anon) (depth : UInt64) :
+    FiniteSupport (KExpr.AbstractReach pos n body depth) :=
+  ⟨abstractReachList pos n body depth,
+    fun {_} h => mem_abstractReachList.mpr h⟩
+
+end KExpr.AbstractReach
+
+private def exceptOkList {ε α : Type} : Except ε α → List α
+  | .error _ => []
+  | .ok x => [x]
+
+private theorem mem_exceptOkList {ε α : Type} {r : Except ε α} {x : α} :
+    x ∈ exceptOkList r ↔ r = .ok x := by
+  cases r <;> simp [exceptOkList, eq_comm]
+
+private def instUnivReachList (us : Array (KUniv .anon))
+    (e : KExpr .anon) : List (KExpr .anon) :=
+  e :: exceptOkList (KExpr.instUnivSpec e us) ++
+    match e with
+    | .app f a _ => instUnivReachList us f ++ instUnivReachList us a
+    | .lam _ _ ty body _ | .all _ _ ty body _ =>
+      instUnivReachList us ty ++ instUnivReachList us body
+    | .letE _ ty val body _ _ =>
+      instUnivReachList us ty ++ instUnivReachList us val ++
+        instUnivReachList us body
+    | .prj _ _ val _ => instUnivReachList us val
+    | _ => []
+termination_by structural e
+
+private theorem mem_instUnivReachList {us : Array (KUniv .anon)}
+    {e x : KExpr .anon} :
+    x ∈ instUnivReachList us e ↔ KExpr.InstUnivReach us e x := by
+  induction e
+  <;> simp_all [KExpr.InstUnivReach, instUnivReachList, mem_exceptOkList,
+    or_assoc, or_left_comm, or_comm]
+
+namespace KExpr.InstUnivReach
+
+/-- Universe instantiation has a finite expression footprint even when its
+pure spec throws: the optional successful image contributes at most one node
+per visited source node. -/
+theorem finite (us : Array (KUniv .anon)) (e : KExpr .anon) :
+    FiniteSupport (KExpr.InstUnivReach us e) :=
+  ⟨instUnivReachList us e, fun {_} h => mem_instUnivReachList.mpr h⟩
+
+end KExpr.InstUnivReach
+
+/-! ## Finite operation lists -/
+
+/-- The position map built by `abstractFVars`: the last fvar is innermost and
+therefore receives position zero.  Naming the pure fold lets the execution
+certificate and cached-walker theorem share the exact map. -/
+def abstractFVarPositions (fvars : Array FVarId) :
+    Std.HashMap FVarId UInt64 := Id.run do
+  let n := fvars.size.toUInt64
+  let mut pos : Std.HashMap FVarId UInt64 := {}
+  let mut i : UInt64 := 0
+  for fv in fvars do
+    pos := pos.insert fv (n - 1 - i)
+    i := i + 1
+  return pos
+
+/-- The named position-map helper is definitionally the fold used by the
+production API.  This equation is the bridge from an `abstractFVars` request
+to the already-proved cached walker. -/
+theorem abstractFVars_eq (body : KExpr .anon) (fvars : Array FVarId) :
+    abstractFVars body fvars =
+      if fvars.isEmpty || !body.hasFVars then pure body
+      else runWalk (abstractFVarsCached body
+        (abstractFVarPositions fvars) fvars.size.toUInt64 0) := by
+  rw [abstractFVars]
+  rfl
+
+namespace KExpr
+
+/-- Pure result of the production `abstractFVars` API, including both of its
+no-op fast paths. The cached walker spec is used only on the slow path. -/
+def abstractFVarsResult (body : KExpr .anon) (fvars : Array FVarId) :
+    KExpr .anon :=
+  if fvars.isEmpty || !body.hasFVars then body
+  else abstractFVarsSpec body (abstractFVarPositions fvars)
+    fvars.size.toUInt64 0
+
+end KExpr
+
+/-- One interning operation whose address reads, memo keys, and candidates
+must be covered by the run support. -/
+inductive WalkerRequest where
+  | internExpr (e : KExpr .anon)
+  | internUniv (u : KUniv .anon)
+  | lift (e : KExpr .anon) (shift cutoff : UInt64)
+  | subst (body arg : KExpr .anon) (depth : UInt64)
+  | simulSubst (body : KExpr .anon) (substs : Array (KExpr .anon))
+      (depth : UInt64)
+  | instRev (body : KExpr .anon) (fvars : Array (KExpr .anon))
+  | abstractFVars (body : KExpr .anon) (fvars : Array FVarId)
+  | instUniv (e : KExpr .anon) (us : Array (KUniv .anon))
+
+namespace WalkerRequest
+
+def Reach : WalkerRequest → KExpr .anon → Prop
+  | .internExpr e => fun x => x = e
+  | .internUniv _ => fun _ => False
+  | .lift e shift cutoff => KExpr.LiftReach shift e cutoff
+  | .subst body arg depth => KExpr.SubstReach arg body depth
+  | .simulSubst body substs depth =>
+    KExpr.SimulSubstReach substs body depth
+  | .instRev body fvars => KExpr.InstRevReach fvars body 0
+  | .abstractFVars body fvars =>
+    KExpr.AbstractReach (abstractFVarPositions fvars)
+      fvars.size.toUInt64 body 0
+  | .instUniv e us => KExpr.InstUnivReach us e
+
+/-- Universe candidates are tracked separately from expressions: the two
+address domains have different erasures and therefore different collision
+hypotheses. -/
+def UnivReach : WalkerRequest → KUniv .anon → Prop
+  | .internUniv u => fun x => x = u
+  | _ => fun _ => False
+
+theorem reach_finite (request : WalkerRequest) :
+    FiniteSupport request.Reach := by
+  cases request with
+  | internExpr e => exact FiniteSupport.singleton e
+  | internUniv _ => exact FiniteSupport.empty
+  | lift e shift cutoff => exact KExpr.LiftReach.finite shift e cutoff
+  | subst body arg depth => exact KExpr.SubstReach.finite arg body depth
+  | simulSubst body substs depth =>
+    exact KExpr.SimulSubstReach.finite substs body depth
+  | instRev body fvars => exact KExpr.InstRevReach.finite fvars body 0
+  | abstractFVars body fvars =>
+    exact KExpr.AbstractReach.finite (abstractFVarPositions fvars)
+      fvars.size.toUInt64 body 0
+  | instUniv e us => exact KExpr.InstUnivReach.finite us e
+
+theorem univReach_finite (request : WalkerRequest) :
+    FiniteSupport request.UnivReach := by
+  cases request with
+  | internUniv u => exact FiniteSupport.singleton u
+  | internExpr | lift | subst | simulSubst | instRev | abstractFVars |
+      instUniv =>
+    exact FiniteSupport.empty
+
+/-- Covering one request means covering every expression it can address,
+memoize, or offer to the intern table. -/
+structure CoveredBy (request : WalkerRequest) (S : KExpr .anon → Prop)
+    (U : KUniv .anon → Prop) : Prop where
+  expr : ∀ x, request.Reach x → S x
+  univ : ∀ u, request.UnivReach u → U u
+
+/-- Arithmetic obligations for existing walkers.  The final conjunct in the
+lift and substitution cases is intentionally stronger than the walk's own
+descent bound: it proves that the generated spec image remains `Constructed`,
+so later walkers receive a valid source term.  Universe instantiation does no
+`UInt64` binder/index arithmetic and therefore contributes no bound here. -/
+def Bounds : WalkerRequest → Prop
+  | .internExpr e => KExpr.Constructed e
+  | .internUniv _ => True
+  | .lift e shift cutoff =>
+    KExpr.Constructed e ∧
+    cutoff.toNat + e.size < UInt64.size ∧
+    e.lbr.toNat + e.size + shift.toNat < UInt64.size
+  | .subst body arg depth =>
+    KExpr.Constructed body ∧
+    KExpr.Constructed arg ∧
+    depth.toNat + body.size < UInt64.size ∧
+    arg.size < UInt64.size ∧
+    arg.lbr.toNat + arg.size + depth.toNat + body.size < UInt64.size
+  | .simulSubst body substs depth =>
+    KExpr.Constructed body ∧
+    (∀ k, k < substs.size → KExpr.Constructed substs[k]!) ∧
+    (∀ k, k < substs.size → substs[k]!.size < UInt64.size) ∧
+    depth.toNat + body.size + substs.size < UInt64.size ∧
+    (∀ k, k < substs.size →
+      substs[k]!.lbr.toNat + substs[k]!.size + depth.toNat + body.size <
+        UInt64.size)
+  | .instRev body fvars =>
+    KExpr.Constructed body ∧
+    (∀ k, k < fvars.size → KExpr.Constructed fvars[k]!) ∧
+    body.size + fvars.size < UInt64.size
+  | .abstractFVars body fvars =>
+    KExpr.Constructed body ∧
+    (∀ (id : FVarId) (p : UInt64),
+      (abstractFVarPositions fvars)[id]? = some p →
+        p.toNat < fvars.size.toUInt64.toNat) ∧
+    body.size < UInt64.size ∧
+    body.lbr.toNat + body.size + fvars.size.toUInt64.toNat < UInt64.size
+  | .instUniv _ _ => True
+
+namespace Bounds
+
+theorem lift_result {e : KExpr .anon} {shift cutoff : UInt64}
+    (h : WalkerRequest.Bounds (.lift e shift cutoff)) :
+    KExpr.Constructed (KExpr.liftSpec e shift cutoff) :=
+  h.1.liftSpec h.2.2
+
+theorem subst_result {body arg : KExpr .anon} {depth : UInt64}
+    (h : WalkerRequest.Bounds (.subst body arg depth)) :
+    KExpr.Constructed (KExpr.substSpec body arg depth) :=
+  h.1.substSpec h.2.1 h.2.2.2.2
+
+theorem simulSubst_result {body : KExpr .anon}
+    {substs : Array (KExpr .anon)} {depth : UInt64}
+    (h : WalkerRequest.Bounds (.simulSubst body substs depth)) :
+    KExpr.Constructed (KExpr.simulSubstSpec body substs depth) := by
+  rcases h with ⟨hbody, hsubsts, _, hwalk, hresult⟩
+  exact hbody.simulSubstSpec hsubsts hwalk hresult
+
+theorem instRev_result {body : KExpr .anon}
+    {fvars : Array (KExpr .anon)}
+    (h : WalkerRequest.Bounds (.instRev body fvars)) :
+    KExpr.Constructed (KExpr.instantiateRevSpec body fvars 0) := by
+  rcases h with ⟨hbody, hfvars, hwalk⟩
+  exact hbody.instantiateRevSpec hfvars (by simpa using hwalk)
+
+theorem abstractFVarsCached_result {body : KExpr .anon}
+    {fvars : Array FVarId}
+    (h : WalkerRequest.Bounds (.abstractFVars body fvars)) :
+    KExpr.Constructed (KExpr.abstractFVarsSpec body
+      (abstractFVarPositions fvars) fvars.size.toUInt64 0) := by
+  rcases h with ⟨hbody, hpos, _, hresult⟩
+  exact hbody.abstractFVarsSpec hpos hresult
+
+theorem abstractFVars_result {body : KExpr .anon} {fvars : Array FVarId}
+    (h : WalkerRequest.Bounds (.abstractFVars body fvars)) :
+    KExpr.Constructed (KExpr.abstractFVarsResult body fvars) := by
+  unfold KExpr.abstractFVarsResult
+  split
+  · exact h.1
+  · exact abstractFVarsCached_result h
+
+end Bounds
+
+private theorem listReach_finite (requests : List WalkerRequest) :
+    FiniteSupport (fun x => ∃ request ∈ requests, request.Reach x) := by
+  induction requests with
+  | nil =>
+    exact FiniteSupport.empty.mono fun _ h => by
+      obtain ⟨_, hmem, _⟩ := h
+      simp at hmem
+  | cons request requests ih =>
+    exact (request.reach_finite.union ih).mono fun x h => by
+      obtain ⟨r, hr, hx⟩ := h
+      rcases List.mem_cons.mp hr with rfl | hr
+      · exact .inl hx
+      · exact .inr ⟨r, hr, hx⟩
+
+private theorem listUnivReach_finite (requests : List WalkerRequest) :
+    FiniteSupport (fun u => ∃ request ∈ requests, request.UnivReach u) := by
+  induction requests with
+  | nil =>
+    exact FiniteSupport.empty.mono fun _ h => by
+      obtain ⟨_, hmem, _⟩ := h
+      simp at hmem
+  | cons request requests ih =>
+    exact (request.univReach_finite.union ih).mono fun u h => by
+      obtain ⟨r, hr, hu⟩ := h
+      rcases List.mem_cons.mp hr with rfl | hr
+      · exact .inl hu
+      · exact .inr ⟨r, hr, hu⟩
+
+end WalkerRequest
+
+/-! ## A finite run support and its coverage obligations -/
+
+/-- The finite expression and universe domains on which one checker run
+assumes Blake3 address faithfulness.  Cache-key domains can be added beside
+these without weakening either collision hypothesis. -/
+structure RunSupport where
+  expr : KExpr .anon → Prop
+  exprFinite : FiniteSupport expr
+  univ : KUniv .anon → Prop
+  univFinite : FiniteSupport univ
+
+instance : CoeFun RunSupport (fun _ => KExpr .anon → Prop) :=
+  ⟨RunSupport.expr⟩
+
+namespace RunSupport
+
+instance : LE RunSupport where
+  le before after :=
+    (∀ x, before x → after x) ∧
+    (∀ u, before.univ u → after.univ u)
+
+theorem le_refl (support : RunSupport) : support ≤ support :=
+  ⟨fun _ h => h, fun _ h => h⟩
+
+theorem le_trans {a b c : RunSupport} (hab : a ≤ b) (hbc : b ≤ c) :
+    a ≤ c :=
+  ⟨fun x hx => hbc.1 x (hab.1 x hx),
+    fun u hu => hbc.2 u (hab.2 u hu)⟩
+
+def empty : RunSupport :=
+  ⟨fun _ => False, FiniteSupport.empty,
+    fun _ => False, FiniteSupport.empty⟩
+
+def singleton (e : KExpr .anon) : RunSupport :=
+  ⟨fun x => x = e, FiniteSupport.singleton e,
+    fun _ => False, FiniteSupport.empty⟩
+
+/-- A singleton in each address domain, useful for non-vacuous fixtures. -/
+def pair (e : KExpr .anon) (u : KUniv .anon) : RunSupport :=
+  ⟨fun x => x = e, FiniteSupport.singleton e,
+    fun v => v = u, FiniteSupport.singleton u⟩
+
+/-- The actual collision hypotheses over both finite run domains. -/
+structure CollisionFree (support : RunSupport) : Prop where
+  expr : KExpr.CollisionFree support
+  univ : KUniv.CollisionFree support.univ
+
+/-- Collision freedom weakens from a larger run domain to a smaller one. -/
+theorem collisionFree_of_le {small large : RunSupport} (hle : small ≤ large)
+    (hcf : large.CollisionFree) : small.CollisionFree :=
+  ⟨hcf.expr.mono hle.1, hcf.univ.mono hle.2⟩
+
+theorem singleton_collisionFree (e : KExpr .anon) :
+    (singleton e).CollisionFree := by
+  constructor
+  · intro x hx y hy _
+    change x = e at hx
+    change y = e at hy
+    subst x
+    subst y
+    rfl
+  · intro _ h
+    exact False.elim h
+
+theorem pair_collisionFree (e : KExpr .anon) (u : KUniv .anon) :
+    (pair e u).CollisionFree := by
+  constructor
+  · intro x hx y hy _
+    change x = e at hx
+    change y = e at hy
+    subst x
+    subst y
+    rfl
+  · intro x hx y hy _
+    change x = u at hx
+    change y = u at hy
+    subst x
+    subst y
+    rfl
+
+/-- Both initial intern-table ranges are included in the final run scope. -/
+structure CoversIntern (support : RunSupport)
+    (initial : InternTable .anon) : Prop where
+  expr : ∀ x, initial.ExprSupport x → support x
+  univ : ∀ u, initial.UnivSupport u → support.univ u
+
+theorem CoversIntern.mono {small large : RunSupport}
+    {initial : InternTable .anon} (h : small.CoversIntern initial)
+    (hle : small ≤ large) : large.CoversIntern initial :=
+  ⟨fun x hx => hle.1 x (h.expr x hx),
+    fun u hu => hle.2 u (h.univ u hu)⟩
+
+end RunSupport
+
+/-- A hash map has a concrete finite value list, so its expression-support
+predicate is constructively finite. -/
+theorem InternTable.exprSupport_finite (initial : InternTable .anon) :
+    FiniteSupport initial.ExprSupport := by
+  refine ⟨initial.exprs.toList.map Prod.snd, fun {x} hx => ?_⟩
+  obtain ⟨a, ha⟩ := hx
+  apply List.mem_map.mpr
+  exact ⟨(a, x), Std.HashMap.mem_toList_iff_getElem?_eq_some.mpr ha, rfl⟩
+
+/-- The universe range of a hash map is constructively finite as well. -/
+theorem InternTable.univSupport_finite (initial : InternTable .anon) :
+    FiniteSupport initial.UnivSupport := by
+  refine ⟨initial.univs.toList.map Prod.snd, fun {u} hu => ?_⟩
+  obtain ⟨a, ha⟩ := hu
+  apply List.mem_map.mpr
+  exact ⟨(a, u), Std.HashMap.mem_toList_iff_getElem?_eq_some.mpr ha, rfl⟩
+
+/-- Exact finite support generated by the initial intern range and a finite
+list of existing walker invocations. -/
+def RunSupport.scope (initial : InternTable .anon)
+    (requests : List WalkerRequest) : RunSupport where
+  expr x := initial.ExprSupport x ∨
+    ∃ request ∈ requests, request.Reach x
+  exprFinite := (InternTable.exprSupport_finite initial).union
+    (WalkerRequest.listReach_finite requests)
+  univ u := initial.UnivSupport u ∨
+    ∃ request ∈ requests, request.UnivReach u
+  univFinite := (InternTable.univSupport_finite initial).union
+    (WalkerRequest.listUnivReach_finite requests)
+
+/-- Checker-support composition over one explicit request list.
+`ExecutionRequests` in Verify/Run.lean ties that same list to the actual
+checker computation. -/
+structure CheckConstSupport (initial : InternTable .anon)
+    (requests : List WalkerRequest) (support : RunSupport) : Prop where
+  initial : support.CoversIntern initial
+  requests : ∀ request, request ∈ requests →
+    request.CoveredBy support support.univ
+
+namespace CheckConstSupport
+
+theorem initial_support {initial : InternTable .anon}
+    {requests : List WalkerRequest} {support : RunSupport}
+    (h : CheckConstSupport initial requests support) :
+    ∀ x, initial.ExprSupport x → support x :=
+  h.initial.expr
+
+theorem initial_univ_support {initial : InternTable .anon}
+    {requests : List WalkerRequest} {support : RunSupport}
+    (h : CheckConstSupport initial requests support) :
+    ∀ u, initial.UnivSupport u → support.univ u :=
+  h.initial.univ
+
+theorem internExpr {initial : InternTable .anon}
+    {requests : List WalkerRequest} {support : RunSupport}
+    (h : CheckConstSupport initial requests support) {e : KExpr .anon}
+    (hmem : WalkerRequest.internExpr e ∈ requests) : support e :=
+  h.requests _ hmem |>.expr e rfl
+
+theorem internUniv {initial : InternTable .anon}
+    {requests : List WalkerRequest} {support : RunSupport}
+    (h : CheckConstSupport initial requests support) {u : KUniv .anon}
+    (hmem : WalkerRequest.internUniv u ∈ requests) : support.univ u :=
+  h.requests _ hmem |>.univ u rfl
+
+/-- Project the exact reach premise expected by `lift_spec`. -/
+theorem lift {initial : InternTable .anon} {requests : List WalkerRequest}
+    {support : RunSupport} (h : CheckConstSupport initial requests support)
+    {e : KExpr .anon} {shift cutoff : UInt64}
+    (hmem : WalkerRequest.lift e shift cutoff ∈ requests) :
+    ∀ x, KExpr.LiftReach shift e cutoff x → support x :=
+  (h.requests _ hmem).expr
+
+/-- Project the exact reach premise expected by `subst_spec`. -/
+theorem subst {initial : InternTable .anon} {requests : List WalkerRequest}
+    {support : RunSupport} (h : CheckConstSupport initial requests support)
+    {body arg : KExpr .anon} {depth : UInt64}
+    (hmem : WalkerRequest.subst body arg depth ∈ requests) :
+    ∀ x, KExpr.SubstReach arg body depth x → support x :=
+  (h.requests _ hmem).expr
+
+theorem simulSubst {initial : InternTable .anon}
+    {requests : List WalkerRequest} {support : RunSupport}
+    (h : CheckConstSupport initial requests support)
+    {body : KExpr .anon} {substs : Array (KExpr .anon)} {depth : UInt64}
+    (hmem : WalkerRequest.simulSubst body substs depth ∈ requests) :
+    ∀ x, KExpr.SimulSubstReach substs body depth x → support x :=
+  (h.requests _ hmem).expr
+
+theorem instRev {initial : InternTable .anon}
+    {requests : List WalkerRequest} {support : RunSupport}
+    (h : CheckConstSupport initial requests support)
+    {body : KExpr .anon} {fvars : Array (KExpr .anon)}
+    (hmem : WalkerRequest.instRev body fvars ∈ requests) :
+    ∀ x, KExpr.InstRevReach fvars body 0 x → support x :=
+  (h.requests _ hmem).expr
+
+theorem abstractFVars {initial : InternTable .anon}
+    {requests : List WalkerRequest} {support : RunSupport}
+    (h : CheckConstSupport initial requests support)
+    {body : KExpr .anon} {fvars : Array FVarId}
+    (hmem : WalkerRequest.abstractFVars body fvars ∈ requests) :
+    ∀ x, KExpr.AbstractReach (abstractFVarPositions fvars)
+      fvars.size.toUInt64 body 0 x → support x :=
+  (h.requests _ hmem).expr
+
+/-- Project the exact reach premise expected by
+`TcM.instantiateUnivParams_wf`. -/
+theorem instUniv {initial : InternTable .anon}
+    {requests : List WalkerRequest} {support : RunSupport}
+    (h : CheckConstSupport initial requests support)
+    {e : KExpr .anon} {us : Array (KUniv .anon)}
+    (hmem : WalkerRequest.instUniv e us ∈ requests) :
+    ∀ x, KExpr.InstUnivReach us e x → support x :=
+  (h.requests _ hmem).expr
+
+theorem mono {initial : InternTable .anon} {requests : List WalkerRequest}
+    {small large : RunSupport}
+    (h : CheckConstSupport initial requests small) (hle : small ≤ large) :
+    CheckConstSupport initial requests large := by
+  refine ⟨h.initial.mono hle, fun request hmem => ?_⟩
+  constructor
+  · exact fun x hx => hle.1 x ((h.requests request hmem).expr x hx)
+  · exact fun u hu => hle.2 u ((h.requests request hmem).univ u hu)
+
+/-- The exact initial-range-plus-request footprint always satisfies the
+coverage interface and is finite by construction. -/
+theorem scope (initial : InternTable .anon) (requests : List WalkerRequest) :
+    CheckConstSupport initial requests (RunSupport.scope initial requests) := by
+  constructor
+  · exact ⟨fun _ hx => .inl hx, fun _ hu => .inl hu⟩
+  · intro request hmem
+    exact ⟨fun _ hx => .inr ⟨request, hmem, hx⟩,
+      fun _ hu => .inr ⟨request, hmem, hu⟩⟩
+
+end CheckConstSupport
+
+/-! ## Run-wide arithmetic bounds -/
+
+/-- Every recorded operation carries its source and generated-term arithmetic
+obligations.  This is separate from collision support: collision freedom can
+weaken to a smaller domain, whereas bounds are indexed by the actual request
+list. -/
+structure ResourceBounds (requests : List WalkerRequest) : Prop where
+  request : ∀ operation, operation ∈ requests → operation.Bounds
+
+namespace ResourceBounds
+
+theorem empty : ResourceBounds [] :=
+  ⟨fun _ h => by simp at h⟩
+
+/-- Dropping operations weakens the resource obligation. -/
+theorem mono {before after : List WalkerRequest}
+    (h : ResourceBounds after)
+    (hsub : ∀ operation, operation ∈ before → operation ∈ after) :
+    ResourceBounds before :=
+  ⟨fun operation hmem => h.request operation (hsub operation hmem)⟩
+
+end ResourceBounds
+
+end Ix.Tc
diff --git a/Ix/Tc/Verify/Totalization.lean b/Ix/Tc/Verify/Totalization.lean
new file mode 100644
index 00000000..bc41607b
--- /dev/null
+++ b/Ix/Tc/Verify/Totalization.lean
@@ -0,0 +1,865 @@
+import Ix.Tc.Verify.Monad
+import Ix.Tc.CanonicalCheck
+import Ix.Tc.Check
+
+/-!
+# K0: equations for the total recursive-methods knot
+
+These equations expose the production definitions needed by the later
+`Methods.WF` induction. They also pin the runtime boundary precisely:
+`methodsOut` throws `.maxRecFuel` without changing state, while a successor
+table runs the selected kernel method under the predecessor table.
+-/
+
+namespace Ix.Tc
+
+variable {m : Mode}
+
+/-! ## Tier A/B: canonical-block comparison and refinement -/
+
+@[simp] theorem compareKUniv_succ_equation (x y : KUniv m)
+    (xi yi : Address) :
+    compareKUniv (.succ x xi) (.succ y yi) = compareKUniv x y := rfl
+
+@[simp] theorem compareKUniv_max_equation (xl xr yl yr : KUniv m)
+    (xi yi : Address) :
+    compareKUniv (.max xl xr xi) (.max yl yr yi) =
+      (compareKUniv xl yl).andThen (compareKUniv xr yr) := rfl
+
+@[simp] theorem mergeSorted_equation (ctx : KMutCtx)
+    (resolveCtor : ResolveCtor m)
+    (left right : Array (KId m × KConst m)) :
+    mergeSorted ctx resolveCtor left right =
+      mergeSorted.go ctx resolveCtor left right 0 0
+        (Array.mkEmpty (left.size + right.size))
+        (left.size + right.size) := rfl
+
+@[simp] theorem mergeSorted_go_zero (ctx : KMutCtx)
+    (resolveCtor : ResolveCtor m)
+    (left right : Array (KId m × KConst m)) (li ri : Nat)
+    (result : Array (KId m × KConst m)) :
+    mergeSorted.go ctx resolveCtor left right li ri result 0 =
+      .ok (result ++ left.extract li left.size ++
+        right.extract ri right.size) := rfl
+
+@[simp] theorem sortByCompare_equation (ctx : KMutCtx)
+    (resolveCtor : ResolveCtor m)
+    (items : Array (KId m × KConst m)) :
+    sortByCompare ctx resolveCtor items =
+      sortByCompareFuel ctx resolveCtor items.size items := rfl
+
+@[simp] theorem sortByCompareFuel_zero (ctx : KMutCtx)
+    (resolveCtor : ResolveCtor m)
+    (items : Array (KId m × KConst m)) :
+    sortByCompareFuel ctx resolveCtor 0 items = .ok items := rfl
+
+@[simp] theorem sortKConstsRefineFuel_zero (resolveCtor : ResolveCtor m)
+    (classes : Array (Array (KId m × KConst m))) :
+    sortKConstsRefineFuel resolveCtor 0 classes = .ok classes := rfl
+
+/-! ## Tier B: bounded diagnostic rendering -/
+
+@[simp] theorem KExpr.render_equation (e : KExpr m) (depth : Nat) :
+    e.render depth = KExpr.renderFuel (21 - depth) e depth := rfl
+
+@[simp] theorem KExpr.renderFuel_zero (e : KExpr m) (depth : Nat) :
+    KExpr.renderFuel 0 e depth = "..." := rfl
+
+/-! ## Tier A: expression occurrence worklist -/
+
+@[simp] theorem exprMentionsAddr_equation (e : KExpr m) (addr : Address) :
+    exprMentionsAddr e addr = exprMentionsAddr.go addr [e] := rfl
+
+@[simp] theorem exprMentionsAddr_go_nil (addr : Address) :
+    exprMentionsAddr.go (m := m) addr [] = false := by
+  rw [exprMentionsAddr.go]
+
+@[simp] theorem exprMentionsAddr_go_app (addr : Address)
+    (f a : KExpr m) (info : ExprInfo m) (stack : List (KExpr m)) :
+    exprMentionsAddr.go addr (.app f a info :: stack) =
+      exprMentionsAddr.go addr (a :: f :: stack) := by
+  rw [exprMentionsAddr.go]
+
+@[simp] theorem exprMentionsAddr_go_const (addr : Address)
+    (id : KId m) (us : Array (KUniv m)) (info : ExprInfo m)
+    (stack : List (KExpr m)) :
+    exprMentionsAddr.go addr (.const id us info :: stack) =
+      if id.addr == addr then true else exprMentionsAddr.go addr stack := by
+  rw [exprMentionsAddr.go]
+
+/-! ## Tier B: bounded context-pop loops -/
+
+@[simp] theorem EquivManager.find_equation
+    (em : EquivManager) (node : Nat) :
+    em.find node =
+      let (root, parent) :=
+        EquivManager.find.go em.parent node em.parent.size
+      (root, { em with parent }) := rfl
+
+@[simp] theorem EquivManager.find_go_zero
+    (parent : Array Nat) (node : Nat) :
+    EquivManager.find.go parent node 0 = (node, parent) := rfl
+
+@[simp] theorem EquivManager.find_go_succ
+    (parent : Array Nat) (node fuel : Nat) :
+    EquivManager.find.go parent node (fuel + 1) =
+      if parent[node]! != node then
+        let parent := parent.set! node parent[parent[node]!]!
+        let node := parent[node]!
+        EquivManager.find.go parent node fuel
+      else
+        (node, parent) := rfl
+
+@[simp] theorem LocalContext.truncate_equation
+    (lctx : LocalContext m) (len : Nat) :
+    lctx.truncate len =
+      LocalContext.truncate.go len lctx.decls lctx.index
+        (lctx.decls.size - len) := rfl
+
+@[simp] theorem LocalContext.truncate_go_zero
+    (len : Nat) (decls : Array (FVarId × LocalDecl m))
+    (index : Std.HashMap FVarId Nat) :
+    LocalContext.truncate.go len decls index 0 = { decls, index } := rfl
+
+@[simp] theorem LocalContext.truncate_go_succ
+    (len fuel : Nat) (decls : Array (FVarId × LocalDecl m))
+    (index : Std.HashMap FVarId Nat) :
+    LocalContext.truncate.go len decls index (fuel + 1) =
+      if decls.size > len then
+        let (id, _) := decls.back!
+        LocalContext.truncate.go len decls.pop (index.erase id) fuel
+      else
+        { decls, index } := rfl
+
+/-- `restoreDepth` derives its total pop count from the current, not an
+earlier, state. This is the exact replacement equation for the old `while`.
+-/
+@[simp] theorem TcM.restoreDepth_apply (saved : Nat) (s : TcState m) :
+    TcM.restoreDepth saved s =
+      TcM.restoreDepth.go saved (s.ctx.size - saved) s := rfl
+
+@[simp] theorem TcM.restoreDepth_go_zero (saved : Nat) (s : TcState m) :
+    TcM.restoreDepth.go saved 0 s = .ok () s := rfl
+
+@[simp] theorem TcM.ctxSuffixNeed_zero (s : TcState m) (need : Nat) :
+    TcM.ctxSuffixNeed s 0 need = need := rfl
+
+@[simp] theorem TcM.ctxSuffixNeed_succ
+    (s : TcState m) (fuel need : Nat) :
+    TcM.ctxSuffixNeed s (fuel + 1) need =
+      let nextNeed := TcM.ctxSuffixNeedStep s need
+      if nextNeed == need then need
+      else TcM.ctxSuffixNeed s fuel nextNeed := rfl
+
+/-- Once the suffix closure step is stable, every positive remaining bound
+returns immediately with the same suffix. -/
+theorem TcM.ctxSuffixNeed_of_fixed (s : TcState m) (fuel need : Nat)
+    (hfixed : TcM.ctxSuffixNeedStep s need = need) :
+    TcM.ctxSuffixNeed s (fuel + 1) need = need := by
+  simp [TcM.ctxSuffixNeed, hfixed]
+
+/-! ## Tier A: pure WHNF helpers -/
+
+/-- Exact recursive-branch equation for the structurally recursive
+constructor-numeral walker. An application with a constant head has exactly
+one spine argument, matching the former `collectSpine`/size test. -/
+@[simp] theorem extractNatValue_app_const_equation
+    (id : KId m) (us : Array (KUniv m)) (constInfo : ExprInfo m)
+    (arg : KExpr m) (appInfo : ExprInfo m) (prims : Primitives m) :
+    extractNatValue (.app (.const id us constInfo) arg appInfo) prims =
+      if id.addr == prims.natSucc.addr then
+        (extractNatValue arg prims).map (· + 1)
+      else none := rfl
+
+@[simp] theorem extractNatValue_nat_equation
+    (n : Nat) (blob : Address) (info : ExprInfo m)
+    (prims : Primitives m) :
+    extractNatValue (.nat n blob info) prims = some n := rfl
+
+@[simp] theorem RecM.natOffset_equation (e : KExpr m) (depth : Nat) :
+    RecM.natOffset e depth = RecM.natOffsetFuel (256 - depth) e := rfl
+
+@[simp] theorem RecM.natOffsetOrZero_equation
+    (e : KExpr m) (depth : Nat) :
+    RecM.natOffsetOrZero e depth = do
+      return (← RecM.natOffset e depth).getD (e, 0) := rfl
+
+@[simp] theorem RecM.evalNatOffsetLiteral_equation
+    (e : KExpr m) (depth : Nat) :
+    RecM.evalNatOffsetLiteral e depth =
+      RecM.evalNatOffsetLiteralFuel (256 - depth) e := rfl
+
+@[simp] theorem RecM.natOffsetFuel_zero
+    (e : KExpr m) (methods : Methods m) (s : TcState m) :
+    (RecM.natOffsetFuel 0 e).run methods s = .ok none s := rfl
+
+@[simp] theorem RecM.evalNatOffsetLiteralFuel_zero
+    (e : KExpr m) (methods : Methods m) (s : TcState m) :
+    (RecM.evalNatOffsetLiteralFuel 0 e).run methods s = .ok none s := rfl
+
+@[simp] theorem RecM.tryEvalNatValueForPred_equation
+    (e : KExpr m) (depth : Nat) :
+    RecM.tryEvalNatValueForPred e depth =
+      RecM.tryEvalNatValueForPredFuel (64 - depth) e := rfl
+
+@[simp] theorem RecM.tryEvalNatValueForPredFuel_zero
+    (e : KExpr m) (methods : Methods m) (s : TcState m) :
+    (RecM.tryEvalNatValueForPredFuel 0 e).run methods s = .ok none s := rfl
+
+/-! ## Tier B: explicitly bounded kernel-loop driver -/
+
+@[simp] theorem RecM.runBounded_zero
+    (step : σ → RecM m (RecM.BoundedStep σ α))
+    (state : σ) (methods : Methods m) (s : TcState m) :
+    (RecM.runBounded step 0 state).run methods s =
+      .error .maxRecDepth s := rfl
+
+theorem RecM.runBounded_succ
+    (step : σ → RecM m (RecM.BoundedStep σ α))
+    (fuel : Nat) (state : σ) :
+    RecM.runBounded step (fuel + 1) state = (do
+      match ← step state with
+      | .next state => RecM.runBounded step fuel state
+      | .done result => return result) := rfl
+
+@[simp] theorem RecM.consumeBetaLams_equation
+    (body : KExpr m) (args : Array (KExpr m)) :
+    RecM.consumeBetaLams body args =
+      RecM.consumeBetaLamsFuel args.size body args
+        (Array.mkEmpty args.size) := rfl
+
+@[simp] theorem RecM.consumeBetaLamsFuel_zero
+    (body : KExpr m) (args consumed : Array (KExpr m)) :
+    RecM.consumeBetaLamsFuel 0 body args consumed =
+      (body, consumed) := rfl
+
+theorem RecM.consumeBetaLamsFuel_succ
+    (fuel : Nat) (body : KExpr m)
+    (args consumed : Array (KExpr m)) :
+    RecM.consumeBetaLamsFuel (fuel + 1) body args consumed =
+      if consumed.size ≥ args.size then
+        (body, consumed)
+      else
+        match body with
+        | .lam _ _ _ inner _ =>
+          RecM.consumeBetaLamsFuel fuel inner args
+            (consumed.push args[consumed.size]!)
+        | _ => (body, consumed) := rfl
+
+/-- Exact unfolding equation for the structurally recursive
+projection-wrapper telescope walk. -/
+theorem projectionDefinitionInfo_go_equation (cur : KExpr m) (arity : Nat) :
+    projectionDefinitionInfo.go cur arity =
+      match cur with
+      | .lam _ _ _ body _ => projectionDefinitionInfo.go body (arity + 1)
+      | .prj structId field projected _ =>
+        match projected with
+        | .var idx _ _ =>
+          if idx.toNat ≥ arity then none
+          else some (arity, structId, field, arity - 1 - idx.toNat)
+        | _ => none
+      | _ => none := by
+  cases cur <;> rfl
+
+/-! ## Tier A: extracted non-recursive WHNF helpers -/
+
+theorem RecM.unfoldConstValue_equation (headExpr val : KExpr m)
+    (us : Array (KUniv m)) :
+    RecM.unfoldConstValue headExpr val us = do
+      let key := headExpr.addr
+      if let some cached := (← get).env.unfoldCache[key]? then
+        return cached
+      let result ← TcM.instantiateUnivParams val us
+      modify fun s => { s with env := { s.env with
+        unfoldCache := s.env.unfoldCache.insert key result } }
+      return result := rfl
+
+theorem RecM.tryDeltaUnfold_equation (e : KExpr m) :
+    RecM.tryDeltaUnfold e = do
+      let (head, args) := e.collectSpine
+      let .const id us _ := head | return none
+      let val ← match (← TcM.tryGetConst id) with
+        | some (.defn (kind := kind) (val := val) ..) =>
+          match kind with
+          | .defn | .thm => pure val
+          | .opaq => return none
+        | _ => return none
+      let val ← RecM.unfoldConstValue head val us
+      let mut result := val
+      for arg in args do
+        result ← TcM.intern (KExpr.mkApp result arg)
+      return some result := rfl
+
+theorem RecM.deltaUnfoldOne_equation (e : KExpr m) :
+    RecM.deltaUnfoldOne e = do
+      if let some unfolded ← RecM.tryDeltaUnfold e then
+        return some unfolded
+      if let .const id us _ := e then
+        match (← TcM.tryGetConst id) with
+        | some (.defn (kind := kind) (val := val) ..) =>
+          match kind with
+          | .defn | .thm =>
+            return some (← RecM.unfoldConstValue e val us)
+          | .opaq => return none
+        | _ => return none
+      return none := rfl
+
+@[simp] theorem RecM.applyIotaArg_false (result arg : KExpr m) :
+    RecM.applyIotaArg result arg false =
+      TcM.intern (KExpr.mkApp result arg) := rfl
+
+@[simp] theorem RecM.applyIotaArg_true_lam
+    (name : m.F Name) (bi : m.F Lean.BinderInfo)
+    (dom body arg : KExpr m) (info : ExprInfo m) :
+    RecM.applyIotaArg (.lam name bi dom body info) arg true =
+      pure (substNoIntern body arg 0) := rfl
+
+theorem RecM.isNatLiteralRecursorApp_equation (e : KExpr m) :
+    RecM.isNatLiteralRecursorApp e = do
+      let (head, spine) := e.collectSpine
+      let .const id _ _ := head | return false
+      let p ← RecM.prims
+      if id.addr != p.natRec.addr && id.addr != p.natCasesOn.addr then
+        return false
+      let some (.recr (params := params) (motives := motives)
+          (minors := minors) (indices := indices) ..) ←
+          TcM.tryGetConst id | return false
+      let majorIdx := (params + motives + minors + indices).toNat
+      match spine[majorIdx]? with
+      | some (.nat ..) => return true
+      | _ => return false := rfl
+
+theorem RecM.isTransientNatLiteralWork_equation (e : KExpr m) :
+    RecM.isTransientNatLiteralWork e = do
+      if (← RecM.isNatLiteralRecursorApp e) then
+        return true
+      let (head, args) := e.collectSpine
+      let .const id _ _ := head | return false
+      if id.addr == (← RecM.prims).natSucc.addr && args.size == 1 then
+        RecM.isNatLiteralRecursorApp args[0]!
+      else
+        return false := rfl
+
+theorem RecM.cleanupNatOffsetMajor_equation (e : KExpr m) :
+    RecM.cleanupNatOffsetMajor e = do
+      if (← RecM.evalNatOffsetLiteral e 0).isSome then
+        return none
+      let some (base, offset) ← RecM.natOffset e 0 | return none
+      if offset == 0 then
+        return none
+      let predOffset := offset - 1
+      let pred ← if predOffset == 0 then pure base
+        else do RecM.mkNatAdd base (RecM.natExprFromValue predOffset)
+      return some (← RecM.mkNatSucc pred) := rfl
+
+theorem RecM.projectDecidableFinValMinor_equation
+    (id : KId m) (field : UInt64) (minor : KExpr m) :
+    RecM.projectDecidableFinValMinor id field minor = do
+      let .lam name bi dom body _ := minor | return none
+      let proj ← TcM.intern (KExpr.mkPrj id field body)
+      return some (← TcM.intern (KExpr.mkLam name bi dom proj)) := rfl
+
+theorem RecM.tryReduceFinValDecidableRec_equation
+    (id : KId m) (field : UInt64) (head : KExpr m)
+    (args : Array (KExpr m)) :
+    RecM.tryReduceFinValDecidableRec id field head args = do
+      if (← get).noAccel then return none
+      let p ← RecM.prims
+      if id.addr != p.fin.addr || field != 0 then
+        return none
+      let .const recId recUs _ := head | return none
+      if recId.addr != p.decidableRec.addr || args.size < 5 then
+        return none
+      let .lam motiveName motiveBi motiveDom _ _ := args[1]!
+        | return none
+      let some falseMinor ←
+          RecM.projectDecidableFinValMinor id field args[2]!
+        | return none
+      let some trueMinor ←
+          RecM.projectDecidableFinValMinor id field args[3]!
+        | return none
+      let natTy ← TcM.intern (.mkConst p.nat #[])
+      let motive ←
+        TcM.intern (KExpr.mkLam motiveName motiveBi motiveDom natTy)
+      let mut result ← TcM.intern (KExpr.mkConst recId recUs)
+      result ← TcM.intern (KExpr.mkApp result args[0]!)
+      result ← TcM.intern (KExpr.mkApp result motive)
+      result ← TcM.intern (KExpr.mkApp result falseMinor)
+      result ← TcM.intern (KExpr.mkApp result trueMinor)
+      result ← TcM.intern (KExpr.mkApp result args[4]!)
+      for arg in args.extract 5 args.size do
+        result ← TcM.intern (KExpr.mkApp result arg)
+      return some result := rfl
+
+theorem RecM.tryReduceProjectionDefinition_equation (e : KExpr m) :
+    RecM.tryReduceProjectionDefinition e = do
+      let (head, args) := e.collectSpine
+      let .const id _ _ := head | return none
+      let val ← match (← TcM.tryGetConst id) with
+        | some (.defn (kind := .defn) (val := val) ..) => pure val
+        | _ => return none
+      let some (arity, structId, field, structArgIdx) :=
+        projectionDefinitionInfo val | return none
+      if args.size < arity then
+        return none
+      let mut result ←
+        TcM.intern (KExpr.mkPrj structId field args[structArgIdx]!)
+      for arg in args.extract arity args.size do
+        result ← TcM.intern (KExpr.mkApp result arg)
+      return some result := rfl
+
+theorem RecM.natRecLiteralParts_equation (e : KExpr m) :
+    RecM.natRecLiteralParts e = do
+      let (head, spine) := e.collectSpine
+      let .const id _ _ := head | return none
+      if id.addr != (← RecM.prims).natRec.addr then
+        return none
+      let some (.recr (params := params) (motives := motives)
+          (minors := minors) (indices := indices) ..) ←
+          TcM.tryGetConst id | return none
+      if minors.toNat < 2 then
+        return none
+      let baseIdx := params.toNat + motives.toNat
+      let stepIdx := baseIdx + 1
+      let majorIdx :=
+        params.toNat + motives.toNat + minors.toNat + indices.toNat
+      let some (.nat major _ _) := spine[majorIdx]? | return none
+      return some { spine, major, baseIdx, stepIdx } := rfl
+
+theorem RecM.isNatStuckRecursorAddr_equation (addr : Address) :
+    RecM.isNatStuckRecursorAddr (m := m) addr = do
+      let p ← RecM.prims
+      return addr == p.natRec.addr || addr == p.natCasesOn.addr
+        || addr == p.bitVecToNat.addr := rfl
+
+theorem RecM.isStuckNatPredicateProbe_equation (e : KExpr m) :
+    RecM.isStuckNatPredicateProbe e = do
+      let (head, _) := e.collectSpine
+      match head with
+      | .const id _ _ =>
+        return (← RecM.isNatBinPredAddr id.addr) ||
+          (← RecM.isNatStuckRecursorAddr id.addr)
+      | .prj id _ val _ =>
+        if id.addr == (← RecM.prims).fin.addr then
+          return true
+        let (valHead, _) := val.collectSpine
+        match valHead with
+        | .const valId _ _ => RecM.isNatStuckRecursorAddr valId.addr
+        | _ => return false
+      | _ => return false := rfl
+
+theorem RecM.bitvecOfNatArgs_equation (e : KExpr m) :
+    RecM.bitvecOfNatArgs e = do
+      let p ← RecM.prims
+      let (head, args) := e.collectSpine
+      let .const id _ _ := head | return none
+      if id.addr == p.bitVecOfNat.addr && args.size == 2 then
+        return some (args[0]!, args[1]!)
+      if id.addr != p.ofNatOfNat.addr || args.size < 2 then
+        return none
+      let (typeHead, typeArgs) := args[0]!.collectSpine
+      let .const typeId _ _ := typeHead | return none
+      if typeId.addr == p.bitVec.addr && typeArgs.size == 1 then
+        return some (typeArgs[0]!, args[1]!)
+      return none := rfl
+
+theorem RecM.charOfNatExpr_equation (n : Nat) :
+    RecM.charOfNatExpr (m := m) n = do
+      let charOfNat ← TcM.intern (.mkConst (← RecM.prims).charOfNat #[])
+      let natLit ← TcM.intern (RecM.natExprFromValue n : KExpr m)
+      return some (← TcM.intern (KExpr.mkApp charOfNat natLit)) := rfl
+
+theorem RecM.tryReduceString_equation (e : KExpr m) :
+    RecM.tryReduceString e = (do
+      let (head, args) := e.collectSpine
+      if args.size != 1 then
+        return none
+      let .const id _ _ := head | return none
+      let p ← RecM.prims
+      let isBack := id.addr == p.stringBack.addr ||
+        id.addr == p.stringLegacyBack.addr
+      let isUtf8ByteSize := id.addr == p.stringUtf8ByteSize.addr
+      let isToByteArray := id.addr == p.stringToByteArray.addr
+      if !isBack && !isUtf8ByteSize && !isToByteArray then
+        return none
+      let .str s _ _ := args[0]! | return none
+      if isUtf8ByteSize then
+        return some (← TcM.intern
+          (RecM.natExprFromValue s.utf8ByteSize : KExpr m))
+      if isToByteArray then
+        if s.isEmpty then
+          return some (← TcM.intern (.mkConst p.byteArrayEmpty #[]))
+        return none
+      let codepoint := (s.toList.getLast?.map (·.toNat)).getD 65
+      RecM.charOfNatExpr codepoint) := rfl
+
+theorem RecM.discoverBlockInductives_equation (blockId : KId m) :
+    RecM.discoverBlockInductives blockId = do
+      let some members ← TcM.tryGetBlock blockId | return #[]
+      let mut inds : Array (KId m) := #[]
+      for id in members do
+        if let some (.indc ..) ← TcM.tryGetConst id then
+          inds := inds.push id
+      return inds := rfl
+
+/-! ## Tier A: extracted non-recursive def-eq helpers -/
+
+@[simp] theorem RecM.compareRank_equation (a b : Nat × Nat) :
+    RecM.compareRank a b =
+      match compare a.1 b.1 with
+      | .eq => compare a.2 b.2
+      | o => o := rfl
+
+theorem RecM.isNatLike_equation (e : KExpr m) :
+    RecM.isNatLike e = do
+      let p ← RecM.prims
+      match e with
+      | .nat .. => return true
+      | .const id _ _ => return id.addr == p.natZero.addr
+      | .app f _ _ =>
+        match f with
+        | .const id _ _ => return id.addr == p.natSucc.addr
+        | _ => return false
+      | _ => return false := rfl
+
+theorem RecM.isNatZero_equation (e : KExpr m) :
+    RecM.isNatZero e = do
+      let p ← RecM.prims
+      match e with
+      | .nat v _ _ => return v == 0
+      | .const id _ _ => return id.addr == p.natZero.addr
+      | _ => return false := rfl
+
+theorem RecM.natSuccOf_equation (e : KExpr m) :
+    RecM.natSuccOf e = do
+      let p ← RecM.prims
+      match e with
+      | .nat v _ _ =>
+        if v == 0 then
+          return none
+        return some (← TcM.intern
+          (RecM.natExprFromValue (v - 1) : KExpr m))
+      | .app f arg _ =>
+        match f with
+        | .const id _ _ =>
+          if id.addr == p.natSucc.addr then
+            return some arg
+          return none
+        | _ => return none
+      | _ => return none := rfl
+
+theorem RecM.isBoolTrue_equation (e : KExpr m) :
+    RecM.isBoolTrue e = do
+      match e with
+      | .const id us _ =>
+        return us.isEmpty && id.addr == (← RecM.prims).boolTrue.addr
+      | _ => return false := rfl
+
+theorem RecM.isDelta_equation (id : KId m) :
+    RecM.isDelta id = do
+      match (← TcM.tryGetConst id) with
+      | some (.defn (kind := kind) ..) =>
+        match kind with
+        | .defn | .thm => return true
+        | .opaq => return false
+      | _ => return false := rfl
+
+theorem RecM.isRegular_equation (id : KId m) :
+    RecM.isRegular id = do
+      match (← TcM.tryGetConst id) with
+      | some (.defn (hints := .regular _) ..) => return true
+      | _ => return false := rfl
+
+theorem RecM.defRankId_equation (id : KId m) :
+    RecM.defRankId id = do
+      match (← TcM.tryGetConst id) with
+      | some (.defn (kind := kind) (hints := hints) ..) =>
+        match kind with
+        | .opaq | .thm => return (0, 0)
+        | .defn =>
+          match hints with
+          | .opaque => return (0, 0)
+          | .regular h => return (1, h.toNat)
+          | .abbrev => return (2, 0)
+      | _ => return (0, 0) := rfl
+
+/-! ## Tier C: Infer's method-indexed structural recursion -/
+
+@[simp] theorem RecM.infer_eq_inferWith (e : KExpr m) :
+    RecM.infer e = RecM.inferWith RecM.inferCall e := rfl
+
+@[simp] theorem RecM.inferCall_run (e : KExpr m)
+    (methods : Methods m) (s : TcState m) :
+    (RecM.inferCall e).run methods s = methods.infer e s := rfl
+
+@[simp] theorem RecM.inferOnlyCall_run (e : KExpr m)
+    (methods : Methods m) (s : TcState m) :
+    (RecM.inferOnlyCall e).run methods s =
+      TcM.withInferOnly (methods.infer e) s := rfl
+
+@[simp] theorem RecM.isDefEqCall_run (a b : KExpr m)
+    (methods : Methods m) (s : TcState m) :
+    (RecM.isDefEqCall a b).run methods s = methods.isDefEq a b s := rfl
+
+@[simp] theorem RecM.whnfRec_run (e : KExpr m)
+    (methods : Methods m) (s : TcState m) :
+    (RecM.whnfRec e).run methods s = methods.whnf e s := rfl
+
+@[simp] theorem RecM.whnfModeRec_run (e : KExpr m) (mode : NatSuccMode)
+    (methods : Methods m) (s : TcState m) :
+    (RecM.whnfModeRec e mode).run methods s =
+      methods.whnfMode e mode s := rfl
+
+@[simp] theorem RecM.whnfCoreFlagsRec_run
+    (e : KExpr m) (flags : WhnfFlags)
+    (methods : Methods m) (s : TcState m) :
+    (RecM.whnfCoreFlagsRec e flags).run methods s =
+      methods.whnfCoreFlags e flags s := rfl
+
+@[simp] theorem RecM.whnf_eq_whnfWithNatSuccMode (e : KExpr m) :
+    RecM.whnf e = RecM.whnfWithNatSuccMode e .collapse := rfl
+
+@[simp] theorem RecM.whnfCore_eq_whnfCoreWithFlags (e : KExpr m) :
+    RecM.whnfCore e = RecM.whnfCoreWithFlags e .FULL := rfl
+
+@[simp] theorem RecM.whnfNoDelta_eq_whnfNoDeltaImpl (e : KExpr m) :
+    RecM.whnfNoDelta e =
+      RecM.whnfNoDeltaImpl e .FULL .collapse := rfl
+
+theorem RecM.ensureSortDirect_equation (e : KExpr m) :
+    RecM.ensureSortDirect e = (do
+      if let .sort u _ := e then
+        return u
+      match (← RecM.whnf e) with
+      | .sort u _ => return u
+      | _ => throw .typeExpected) := rfl
+
+theorem RecM.ensureForallDirect_equation (e : KExpr m) :
+    RecM.ensureForallDirect e = (do
+      if let .all _ _ a b _ := e then
+        return (a, b)
+      let w ← RecM.whnf e
+      match w with
+      | .all _ _ a b _ => return (a, b)
+      | _ => throw (.funExpected e w)) := rfl
+
+theorem RecM.peelProjForall_equation (e : KExpr m) (err : String) :
+    RecM.peelProjForall e err = (do
+      if let .all _ _ dom body _ := e then
+        return (dom, body)
+      match (← RecM.whnf e) with
+      | .all _ _ dom body _ => return (dom, body)
+      | _ => throw (.other err)) := rfl
+
+/-! ## Tier A: total safety-reference worklist -/
+
+@[simp] theorem RecM.checkNoUnsafeRefs_equation
+    (root : KExpr m) (callerSafety : Ix.DefinitionSafety) :
+    RecM.checkNoUnsafeRefs root callerSafety =
+      RecM.checkNoUnsafeRefs.go callerSafety [root] {} {} := rfl
+
+@[simp] theorem RecM.checkNoUnsafeRefs_go_nil
+    (callerSafety : Ix.DefinitionSafety)
+    (seenExprs seenConsts : Std.HashSet Address) :
+    RecM.checkNoUnsafeRefs.go (m := m) callerSafety []
+      seenExprs seenConsts = pure () := by
+  rw [RecM.checkNoUnsafeRefs.go]
+
+theorem RecM.checkNoUnsafeRefs_go_app
+    (callerSafety : Ix.DefinitionSafety) (f a : KExpr m)
+    (info : ExprInfo m) (stack : List (KExpr m))
+    (seenExprs seenConsts : Std.HashSet Address) :
+    RecM.checkNoUnsafeRefs.go callerSafety (.app f a info :: stack)
+        seenExprs seenConsts =
+      if seenExprs.contains (.app f a info : KExpr m).addr then
+        RecM.checkNoUnsafeRefs.go callerSafety stack seenExprs seenConsts
+      else
+        RecM.checkNoUnsafeRefs.go callerSafety (a :: f :: stack)
+          (seenExprs.insert (.app f a info : KExpr m).addr) seenConsts := by
+  rw [RecM.checkNoUnsafeRefs.go]
+  split <;> simp
+
+/-! ## Tier A/B: total inductive validation and telescope scans -/
+
+@[simp] theorem RecM.validateUnivParamsSeen_equation
+    (root : KUniv m) (bound : Nat) (seen : Std.HashSet Address) :
+    RecM.validateUnivParamsSeen root bound seen =
+      RecM.validateUnivParamsSeen.go bound [root] seen := rfl
+
+@[simp] theorem RecM.validateUnivParamsSeen_go_nil
+    (bound : Nat) (seen : Std.HashSet Address) :
+    RecM.validateUnivParamsSeen.go (m := m) bound [] seen = pure seen := by
+  rw [RecM.validateUnivParamsSeen.go]
+
+theorem RecM.validateUnivParamsSeen_go_max
+    (bound : Nat) (a b : KUniv m) (addr : Address)
+    (stack : List (KUniv m)) (seen : Std.HashSet Address) :
+    RecM.validateUnivParamsSeen.go bound (.max a b addr :: stack) seen =
+      if seen.contains addr then
+        RecM.validateUnivParamsSeen.go bound stack seen
+      else
+        RecM.validateUnivParamsSeen.go bound (b :: a :: stack)
+          (seen.insert addr) := by
+  rw [RecM.validateUnivParamsSeen.go]
+  simp [KUniv.addr]
+
+@[simp] theorem RecM.validateExprWellScoped_equation
+    (root : KExpr m) (rootDepth : UInt64) (lvlBound : Nat) :
+    RecM.validateExprWellScoped root rootDepth lvlBound =
+      RecM.validateExprWellScoped.go lvlBound [(root, rootDepth)] {} {} := rfl
+
+@[simp] theorem RecM.validateExprWellScoped_go_nil
+    (lvlBound : Nat) (seenExprs : Std.HashSet (Address × UInt64))
+    (seenUnivs : Std.HashSet Address) :
+    RecM.validateExprWellScoped.go (m := m) lvlBound []
+      seenExprs seenUnivs = pure () := by
+  rw [RecM.validateExprWellScoped.go]
+
+theorem RecM.validateExprWellScoped_go_app
+    (lvlBound : Nat) (f a : KExpr m) (info : ExprInfo m) (depth : UInt64)
+    (stack : List (KExpr m × UInt64))
+    (seenExprs : Std.HashSet (Address × UInt64))
+    (seenUnivs : Std.HashSet Address) :
+    RecM.validateExprWellScoped.go lvlBound
+        ((.app f a info, depth) :: stack) seenExprs seenUnivs =
+      if seenExprs.contains ((.app f a info : KExpr m).addr, depth) then
+        RecM.validateExprWellScoped.go lvlBound stack seenExprs seenUnivs
+      else
+        RecM.validateExprWellScoped.go lvlBound
+          ((a, depth) :: (f, depth) :: stack)
+          (seenExprs.insert ((.app f a info : KExpr m).addr, depth))
+          seenUnivs := by
+  rw [RecM.validateExprWellScoped.go]
+  split <;> simp
+
+@[simp] theorem RecM.peelRuleIhForalls_equation
+    (root : KExpr m) (flat : Array (FlatBlockMember m)) :
+    RecM.peelRuleIhForalls root flat =
+      RecM.peelRuleIhForalls.go flat root #[] := rfl
+
+@[simp] theorem RecM.checkPositivityDomain_equation
+    (dom : KExpr m) (blockAddrs : Array Address) :
+    RecM.checkPositivityDomain dom blockAddrs =
+      RecM.checkPositivityDomainFuel maxWhnfFuel.toNat dom blockAddrs := rfl
+
+@[simp] theorem RecM.checkPositivityDomainFuel_zero
+    (dom : KExpr m) (blockAddrs : Array Address) :
+    RecM.checkPositivityDomainFuel 0 dom blockAddrs =
+      throw .maxRecDepth := rfl
+
+@[simp] theorem RecM.checkNestedCtorFieldsFuel_zero
+    (ctorTy : KExpr m) (nParams : Nat) (paramArgs : Array (KExpr m))
+    (us : Array (KUniv m)) (augmentedAddrs : Array Address) :
+    RecM.checkNestedCtorFieldsFuel 0 ctorTy nParams paramArgs us
+      augmentedAddrs = throw .maxRecDepth := rfl
+
+@[simp] theorem RecM.checkNestedCtorFieldsLoopFuel_zero
+    (ty : KExpr m) (augmentedAddrs : Array Address) :
+    RecM.checkNestedCtorFieldsLoopFuel 0 ty augmentedAddrs =
+      throw .maxRecDepth := rfl
+
+theorem RecM.countForalls_equation (ty : KExpr m) :
+    RecM.countForalls ty = (do
+      let saved := (← get).lctx.size
+      RecM.runBounded (fun (cur, n) => do
+        let w ← RecM.whnf cur
+        match w with
+        | .all name bi dom body _ =>
+          let fvId ← TcM.freshFVarId (m := m)
+          let fv ← TcM.intern (.mkFVar fvId name)
+          modify fun s =>
+            { s with lctx := s.lctx.push fvId (.cdecl name bi dom) }
+          let cur ← TcM.runIntern (instantiateRev body #[fv])
+          return .next (cur, n + 1)
+        | _ =>
+          modify fun s => { s with lctx := s.lctx.truncate saved }
+          return .done n) maxWhnfFuel.toNat (ty, 0)) := rfl
+
+/-! ## Tier C: total recursive-methods knot -/
+
+@[simp] theorem methodsN_zero : methodsN (m := m) 0 = methodsOut := rfl
+
+@[simp] theorem methodsN_succ_whnf (n : Nat) (e : KExpr m) :
+    (methodsN (m := m) (n + 1)).whnf e =
+      (RecM.whnf e).run (methodsN n) := rfl
+
+@[simp] theorem methodsN_succ_whnfCore (n : Nat) (e : KExpr m) :
+    (methodsN (m := m) (n + 1)).whnfCore e =
+      (RecM.whnfCore e).run (methodsN n) := rfl
+
+@[simp] theorem methodsN_succ_whnfMode
+    (n : Nat) (e : KExpr m) (mode : NatSuccMode) :
+    (methodsN (m := m) (n + 1)).whnfMode e mode =
+      (RecM.whnfWithNatSuccMode e mode).run (methodsN n) := rfl
+
+@[simp] theorem methodsN_succ_whnfCoreFlags
+    (n : Nat) (e : KExpr m) (flags : WhnfFlags) :
+    (methodsN (m := m) (n + 1)).whnfCoreFlags e flags =
+      (RecM.whnfCoreWithFlags e flags).run (methodsN n) := rfl
+
+@[simp] theorem methodsN_succ_infer (n : Nat) (e : KExpr m) :
+    (methodsN (m := m) (n + 1)).infer e =
+      (RecM.infer e).run (methodsN n) := rfl
+
+@[simp] theorem methodsN_succ_isDefEq (n : Nat) (a b : KExpr m) :
+    (methodsN (m := m) (n + 1)).isDefEq a b =
+      (RecM.isDefEq a b).run (methodsN n) := rfl
+
+@[simp] theorem methodsOut_whnf (e : KExpr m) (s : TcState m) :
+    methodsOut.whnf e s = .error .maxRecFuel s := rfl
+
+@[simp] theorem methodsOut_whnfCore (e : KExpr m) (s : TcState m) :
+    methodsOut.whnfCore e s = .error .maxRecFuel s := rfl
+
+@[simp] theorem methodsOut_whnfMode
+    (e : KExpr m) (mode : NatSuccMode) (s : TcState m) :
+    methodsOut.whnfMode e mode s = .error .maxRecFuel s := rfl
+
+@[simp] theorem methodsOut_whnfCoreFlags
+    (e : KExpr m) (flags : WhnfFlags) (s : TcState m) :
+    methodsOut.whnfCoreFlags e flags s = .error .maxRecFuel s := rfl
+
+@[simp] theorem methodsOut_infer (e : KExpr m) (s : TcState m) :
+    methodsOut.infer e s = .error .maxRecFuel s := rfl
+
+@[simp] theorem methodsOut_isDefEq (a b : KExpr m) (s : TcState m) :
+    methodsOut.isDefEq a b s = .error .maxRecFuel s := rfl
+
+/-- Public recursive computations select their table from the current
+`recFuel`; `fuelBudget` does not participate in this equation. -/
+@[simp] theorem TcM.runRec_apply (x : RecM m α) (s : TcState m) :
+    TcM.runRec x s = x.run (methodsN s.recFuel.toNat) s := rfl
+
+/-- At zero current fuel, the first direct `infer` table back-edge has the
+same error and unchanged error state as `methodsOut`. The top-level `x`
+itself is still allowed to run if it never takes a back-edge. -/
+theorem TcM.runRec_directInfer_zero (e : KExpr m) (s : TcState m)
+    (hzero : s.recFuel = 0) :
+    TcM.runRec (fun methods => methods.infer e) s =
+      .error .maxRecFuel s := by
+  unfold TcM.runRec
+  rw [hzero]
+  rfl
+
+@[simp] theorem TcM.whnf_eq_runRec (e : KExpr m) :
+    TcM.whnf e = TcM.runRec (RecM.whnf e) := rfl
+
+@[simp] theorem TcM.whnfCore_eq_runRec (e : KExpr m) :
+    TcM.whnfCore e = TcM.runRec (RecM.whnfCore e) := rfl
+
+@[simp] theorem TcM.whnfNoDelta_eq_runRec (e : KExpr m) :
+    TcM.whnfNoDelta e = TcM.runRec (RecM.whnfNoDelta e) := rfl
+
+@[simp] theorem TcM.infer_eq_runRec (e : KExpr m) :
+    TcM.infer e = TcM.runRec (RecM.infer e) := rfl
+
+@[simp] theorem TcM.isDefEq_eq_runRec (a b : KExpr m) :
+    TcM.isDefEq a b = TcM.runRec (RecM.isDefEq a b) := rfl
+
+@[simp] theorem TcM.ensureSort_eq_runRec (e : KExpr m) :
+    TcM.ensureSort e = TcM.runRec (RecM.ensureSortDirect e) := rfl
+
+@[simp] theorem TcM.ensureForall_eq_runRec (e : KExpr m) :
+    TcM.ensureForall e = TcM.runRec (RecM.ensureForallDirect e) := rfl
+
+end Ix.Tc
diff --git a/Ix/Tc/Verify/Trans.lean b/Ix/Tc/Verify/Trans.lean
index da0bf9d7..c9617b9f 100644
--- a/Ix/Tc/Verify/Trans.lean
+++ b/Ix/Tc/Verify/Trans.lean
@@ -16,7 +16,8 @@ source languages agree, with the divergences owned deliberately:
   lookup), our rules carry the explicit bound `(toVLevel u).WF uvars`.
 - **Constants resolve by address.** An anon `KId` is a bare content
   address; the `nameOf : Address → Option Lean.Name` parameter abstracts
-  the KEnv-side resolution that `TrKEnv` (Verify/Env.lean) provides. The rule
+  the trusted-world resolution that `TrustedConstRel` (Verify/Env.lean)
+  provides to consumers. The rule
   then mirrors upstream: the resolved name must be a declared `env`
   constant with matching universe arity.
 - **Literals are first-class.** `KExpr` has `.nat`/`.str` constructors,
diff --git a/Ix/Tc/Verify/Whnf.lean b/Ix/Tc/Verify/Whnf.lean
new file mode 100644
index 00000000..7ab0a3dc
--- /dev/null
+++ b/Ix/Tc/Verify/Whnf.lean
@@ -0,0 +1,3717 @@
+import Ix.Tc.Verify.Ctx
+import Ix.Tc.Verify.Inductive
+import Ix.Tc.Verify.Run
+import Ix.Tc.Verify.State
+
+/-!
+# WHNF soundness boundary
+
+This file starts K1 at the semantic boundary shared by reduction, caches, and
+the recursive method knot.  It intentionally does not identify a context
+hash with a typing context by fiat.  `WhnfContextKeys.Represents` is the one
+named ghost relation whose production implementation must be connected to
+`TcM.ctxAddrForLbr`; K2 supplies the suffix-sufficiency transport theorem.
+
+The semantic payload is already concrete: `WhnfMeaning` says that source and
+result have structural `TrKExprS` translations in the same `KVLCtx`, and that
+those translations are definitionally equal in the current Theory world.
+Consequently a cache hit is useful only after supplying both its finite
+source witness and the represented context.  Address equality alone carries
+no semantic meaning.
+
+K1 has five expression-cache policies.  The inference caches are excluded
+from this layer and continue through a caller-supplied fallback semantics;
+K2 replaces that fallback with their exact typing contracts.
+-/
+
+namespace Ix.Tc
+
+open Lean4Lean (VExpr)
+open Std (HashSet)
+
+/-! ## Concrete reduction meaning -/
+
+/-- Theory meaning of one concrete reduction result.  Both terms retain a
+structural translation witness; their translations may differ, but must be
+definitionally equal in the same world and mixed local context. -/
+def WhnfMeaning (trProj : RawProjRel) (world : VerifyWorld)
+    (uvars : Nat) (Δ : KVLCtx) (source result : KExpr .anon) : Prop :=
+  ∃ sourceV resultV,
+    TrKExprS world.venv uvars world.nameOf trProj Δ source sourceV ∧
+    TrKExprS world.venv uvars world.nameOf trProj Δ result resultV ∧
+    world.venv.IsDefEqU uvars Δ.toCtx sourceV resultV
+
+namespace WhnfMeaning
+
+/-- A translated, well-formed expression has the reflexive reduction
+meaning.  Keeping the WF premise explicit prevents an arbitrary raw syntax
+node from entering the semantic cache contract. -/
+theorem refl {trProj : RawProjRel} {world : VerifyWorld} {uvars : Nat}
+    {Δ : KVLCtx} {e : KExpr .anon} {ve : VExpr}
+    (htr : TrKExprS world.venv uvars world.nameOf trProj Δ e ve)
+    (hwf : VExpr.WF world.venv uvars Δ.toCtx ve) :
+    WhnfMeaning trProj world uvars Δ e e :=
+  ⟨ve, ve, htr, htr, hwf⟩
+
+/-- Reduction meaning is symmetric at the semantic level.  This does not
+claim the operational WHNF relation is symmetric. -/
+theorem symm {trProj : RawProjRel} {world : VerifyWorld} {uvars : Nat}
+    {Δ : KVLCtx} {source result : KExpr .anon}
+    (h : WhnfMeaning trProj world uvars Δ source result) :
+    WhnfMeaning trProj world uvars Δ result source := by
+  obtain ⟨sourceV, resultV, hsource, hresult, hdefeq⟩ := h
+  exact ⟨resultV, sourceV, hresult, hsource, hdefeq.symm⟩
+
+/-- A certified reduction remains certified when the trusted Theory world
+grows.  `VerifyWorld.LE` fixes `nameOf`, so both structural translations are
+transported without changing their address interpretation. -/
+theorem mono {trProj : RawProjRel} {before after : VerifyWorld}
+    (hle : before ≤ after) {uvars : Nat} {Δ : KVLCtx}
+    {source result : KExpr .anon}
+    (h : WhnfMeaning trProj before uvars Δ source result) :
+    WhnfMeaning trProj after uvars Δ source result := by
+  obtain ⟨sourceV, resultV, hsource, hresult, hdefeq⟩ := h
+  refine ⟨sourceV, resultV, ?_, ?_, hdefeq.mono hle.venv⟩
+  · simpa only [← hle.nameOf] using hsource.mono hle.venv
+  · simpa only [← hle.nameOf] using hresult.mono hle.venv
+
+end WhnfMeaning
+
+/-! ## Cache-policy partition -/
+
+/-- The five semantic policies implemented by the WHNF expression caches.
+The policy records operational strength; every policy has the same C1
+soundness consequence (`WhnfMeaning`). -/
+inductive WhnfCachePolicy where
+  | full
+  | noDelta
+  | noDeltaCheap
+  | core
+  | coreCheap
+  deriving Repr, DecidableEq
+
+namespace ExprCacheKind
+
+/-- Classify exactly the K1 cache families.  Inference caches are K2. -/
+def whnfPolicy? : ExprCacheKind → Option WhnfCachePolicy
+  | .whnf => some .full
+  | .whnfNoDelta => some .noDelta
+  | .whnfNoDeltaCheap => some .noDeltaCheap
+  | .whnfCore => some .core
+  | .whnfCoreCheap => some .coreCheap
+  | .infer | .inferOnly => none
+
+@[simp] theorem whnfPolicy?_whnf :
+    ExprCacheKind.whnf.whnfPolicy? = some .full := rfl
+
+@[simp] theorem whnfPolicy?_whnfNoDelta :
+    ExprCacheKind.whnfNoDelta.whnfPolicy? = some .noDelta := rfl
+
+@[simp] theorem whnfPolicy?_whnfNoDeltaCheap :
+    ExprCacheKind.whnfNoDeltaCheap.whnfPolicy? = some .noDeltaCheap := rfl
+
+@[simp] theorem whnfPolicy?_whnfCore :
+    ExprCacheKind.whnfCore.whnfPolicy? = some .core := rfl
+
+@[simp] theorem whnfPolicy?_whnfCoreCheap :
+    ExprCacheKind.whnfCoreCheap.whnfPolicy? = some .coreCheap := rfl
+
+@[simp] theorem whnfPolicy?_infer :
+    ExprCacheKind.infer.whnfPolicy? = none := rfl
+
+@[simp] theorem whnfPolicy?_inferOnly :
+    ExprCacheKind.inferOnly.whnfPolicy? = none := rfl
+
+/-- Proof-relevant membership in the K1 cache partition. -/
+inductive IsWhnf : ExprCacheKind → Prop
+  | whnf : IsWhnf .whnf
+  | whnfNoDelta : IsWhnf .whnfNoDelta
+  | whnfNoDeltaCheap : IsWhnf .whnfNoDeltaCheap
+  | whnfCore : IsWhnf .whnfCore
+  | whnfCoreCheap : IsWhnf .whnfCoreCheap
+
+theorem isWhnf_iff {kind : ExprCacheKind} :
+    kind.IsWhnf ↔ ∃ policy, kind.whnfPolicy? = some policy := by
+  cases kind <;> constructor
+  · intro _
+    exact ⟨.full, rfl⟩
+  · intro _
+    exact .whnf
+  · intro _
+    exact ⟨.noDelta, rfl⟩
+  · intro _
+    exact .whnfNoDelta
+  · intro _
+    exact ⟨.noDeltaCheap, rfl⟩
+  · intro _
+    exact .whnfNoDeltaCheap
+  · intro _
+    exact ⟨.core, rfl⟩
+  · intro _
+    exact .whnfCore
+  · intro _
+    exact ⟨.coreCheap, rfl⟩
+  · intro _
+    exact .whnfCoreCheap
+  · intro h
+    cases h
+  · rintro ⟨policy, h⟩
+    cases h
+  · intro h
+    cases h
+  · rintro ⟨policy, h⟩
+    cases h
+
+end ExprCacheKind
+
+/-! ## Context-key interpretation and exact cache semantics -/
+
+/-- Ghost interpretation of suffix-aware context addresses.  `Represents`
+may relate one key to several definitionally equal contexts; K1 cache
+validity is deliberately quantified over every represented context.  K2
+constructs this model from `ctxAddrForLbr` plus suffix sufficiency. -/
+structure WhnfContextKeys where
+  uvars : Nat
+  Represents : Address → KVLCtx → Prop
+
+namespace WhnfContextKeys
+
+/-- Closed expressions use the distinguished empty-context key. -/
+def closed (uvars : Nat) : WhnfContextKeys where
+  uvars := uvars
+  Represents key Δ := key = emptyCtxAddr ∧ Δ = []
+
+@[simp] theorem closed_represents {uvars : Nat} {key : Address}
+    {Δ : KVLCtx} :
+    (closed uvars).Represents key Δ ↔ key = emptyCtxAddr ∧ Δ = [] :=
+  Iff.rfl
+
+/-- A represented semantic context tied to the actual production cache-key
+computation in a concrete state.  Constructing this witness—not merely
+postulating `Represents`—is the K1/K2 context-key proof obligation. -/
+def Matches (keys : WhnfContextKeys) (trProj : RawProjRel)
+    (world : VerifyWorld) (s : TcState .anon) (Δ : KVLCtx)
+    (source : KExpr .anon) (key : Address × Address) : Prop :=
+  CtxRecon world.venv keys.uvars world.nameOf trProj s Δ ∧
+    keys.Represents key.2 Δ ∧
+    ∃ s', TcM.whnfKey source s = .ok key s'
+
+end WhnfContextKeys
+
+/-- Exact state frame of suffix-key computation.  The memo table may grow;
+every other checker-state field is fixed.  In particular, this is stronger
+than merely saying the environment and logical context are unchanged. -/
+def ContextKeyFrame (before after : TcState .anon) : Prop :=
+  after = { before with ctxAddrCache := after.ctxAddrCache }
+
+/-- Exact state frame of an `InternM` computation lifted through
+`TcM.runIntern`: only the intern table may change. -/
+def InternUpdateFrame (before after : TcState .anon) : Prop :=
+  after = { before with env := { before.env with intern := after.env.intern } }
+
+/-- The empty projection relation satisfies every structural closure law
+vacuously.  This is the canonical K1 fixture interpretation for fragments
+that contain no projection nodes. -/
+theorem RawProjRel.none_ok (env : Lean4Lean.VEnv) (uvars : Nat) :
+    TrProjOK env uvars RawProjRel.none := by
+  constructor <;> intros <;> contradiction
+
+namespace TcM
+
+@[simp] theorem ctxAddrForLbr_zero (s : TcState .anon) :
+    TcM.ctxAddrForLbr 0 s = .ok emptyCtxAddr s := by
+  rfl
+
+/-- Closed expressions compute the distinguished empty-context key without
+mutating even the context-address memo. -/
+theorem whnfKey_closed {source : KExpr .anon} {s : TcState .anon}
+    (hclosed : source.lbr = 0) :
+    TcM.whnfKey source s = .ok (source.addr, emptyCtxAddr) s := by
+  unfold TcM.whnfKey
+  rw [hclosed]
+  change EStateM.bind (TcM.ctxAddrForLbr 0)
+    (fun addr => pure (source.addr, addr)) s = _
+  unfold EStateM.bind
+  rw [TcM.ctxAddrForLbr_zero]
+  rfl
+
+/-- The first component produced by the concrete WHNF-key computation is
+the source expression's address, independent of suffix hashing and its memo
+state. -/
+theorem whnfKey_fst {s s' : TcState .anon} {source : KExpr .anon}
+    {key : Address × Address}
+    (h : TcM.whnfKey source s = .ok key s') :
+    key.1 = source.addr := by
+  unfold TcM.whnfKey at h
+  change EStateM.bind (TcM.ctxAddrForLbr source.lbr)
+    (fun addr => pure (source.addr, addr)) s = .ok key s' at h
+  unfold EStateM.bind at h
+  split at h
+  · cases h
+    rfl
+  · contradiction
+
+end TcM
+
+namespace WhnfContextKeys.Matches
+
+theorem sourceAddr {keys : WhnfContextKeys} {trProj : RawProjRel}
+    {world : VerifyWorld} {s : TcState .anon} {Δ : KVLCtx}
+    {source : KExpr .anon} {key : Address × Address}
+    (h : keys.Matches trProj world s Δ source key) :
+    source.addr = key.1 := by
+  obtain ⟨_, _, s', hkey⟩ := h
+  exact (TcM.whnfKey_fst hkey).symm
+
+end WhnfContextKeys.Matches
+
+namespace CacheSemantics
+
+/-- Minimal fallback used by a WHNF-only verification slice: cached block
+errors remain replayable, while every semantic family not owned by K1 is
+rejected.  K2 replaces this fallback when inference and defeq caches become
+available. -/
+def blockErrorsOnly : CacheSemantics where
+  Valid _ _ entry :=
+    match entry with
+    | .blockResult _ (.error _) => True
+    | _ => False
+  mono := by
+    intro before after support entry hle h
+    exact h
+  blockError := by
+    intro authority support block err
+    trivial
+
+end CacheSemantics
+
+/-- Exact K1 validity for one tagged entry.  The fallback owns every non-K1
+cache family.  A WHNF entry must be sound for every finite-support source
+whose address is its first key component and every context represented by
+its second component. -/
+def WhnfCacheValid (keys : WhnfContextKeys) (trProj : RawProjRel)
+    (fallback : CacheSemantics) (authority : CacheAuthority)
+    (support : RunSupport) : CacheEntry → Prop
+  | .expr .whnf key value =>
+      ∀ source, support source → source.addr = key.1 →
+        ∀ Δ, keys.Represents key.2 Δ →
+          WhnfMeaning trProj authority.world keys.uvars Δ source value
+  | .expr .whnfNoDelta key value =>
+      ∀ source, support source → source.addr = key.1 →
+        ∀ Δ, keys.Represents key.2 Δ →
+          WhnfMeaning trProj authority.world keys.uvars Δ source value
+  | .expr .whnfNoDeltaCheap key value =>
+      ∀ source, support source → source.addr = key.1 →
+        ∀ Δ, keys.Represents key.2 Δ →
+          WhnfMeaning trProj authority.world keys.uvars Δ source value
+  | .expr .whnfCore key value =>
+      ∀ source, support source → source.addr = key.1 →
+        ∀ Δ, keys.Represents key.2 Δ →
+          WhnfMeaning trProj authority.world keys.uvars Δ source value
+  | .expr .whnfCoreCheap key value =>
+      ∀ source, support source → source.addr = key.1 →
+        ∀ Δ, keys.Represents key.2 Δ →
+          WhnfMeaning trProj authority.world keys.uvars Δ source value
+  | entry => fallback.Valid authority support entry
+
+namespace WhnfCacheValid
+
+theorem mono {keys : WhnfContextKeys} {trProj : RawProjRel}
+    {fallback : CacheSemantics} {before after : CacheAuthority}
+    {support : RunSupport} {entry : CacheEntry} (hle : before ≤ after)
+    (h : WhnfCacheValid keys trProj fallback before support entry) :
+    WhnfCacheValid keys trProj fallback after support entry := by
+  cases entry with
+  | expr kind key value =>
+    cases kind with
+    | whnf | whnfNoDelta | whnfNoDeltaCheap | whnfCore | whnfCoreCheap =>
+      intro source hsource haddr Δ hctx
+      exact (h source hsource haddr Δ hctx).mono hle.world
+    | infer | inferOnly =>
+      exact fallback.mono hle h
+  | defEq | defEqFailure | unfold | natSuccStuck | isProp | isRec |
+      recursor | recMajors | blockPeer | blockResult =>
+    exact fallback.mono hle h
+
+/-- Project the concrete reduction meaning from any of the five K1 cache
+families. -/
+theorem expr {keys : WhnfContextKeys} {trProj : RawProjRel}
+    {fallback : CacheSemantics} {authority : CacheAuthority}
+    {support : RunSupport} {kind : ExprCacheKind}
+    {key : Address × Address} {value source : KExpr .anon}
+    (hkind : kind.IsWhnf)
+    (h : WhnfCacheValid keys trProj fallback authority support
+      (.expr kind key value))
+    (hsource : support source) (haddr : source.addr = key.1)
+    {Δ : KVLCtx} (hctx : keys.Represents key.2 Δ) :
+    WhnfMeaning trProj authority.world keys.uvars Δ source value := by
+  cases hkind <;> exact h source hsource haddr Δ hctx
+
+end WhnfCacheValid
+
+/-- Overlay the exact K1 meanings on an existing semantic family. -/
+def whnfCacheSemantics (keys : WhnfContextKeys) (trProj : RawProjRel)
+    (fallback : CacheSemantics) : CacheSemantics where
+  Valid := WhnfCacheValid keys trProj fallback
+  mono := WhnfCacheValid.mono
+  blockError := by
+    intro authority support block err
+    exact fallback.blockError authority support block err
+
+namespace CacheProvenance
+
+/-- A provenance-certified K1 hit exposes concrete Theory reduction
+meaning; support and dependency facts remain available in `h`. -/
+theorem whnfMeaning {keys : WhnfContextKeys} {trProj : RawProjRel}
+    {fallback : CacheSemantics} {authority : CacheAuthority}
+    {support : RunSupport} {kind : ExprCacheKind}
+    {key : Address × Address} {value source : KExpr .anon}
+    (h : CacheProvenance (whnfCacheSemantics keys trProj fallback)
+      authority support (.expr kind key value))
+    (hkind : kind.IsWhnf) (hsource : support source)
+    (haddr : source.addr = key.1) {Δ : KVLCtx}
+    (hctx : keys.Represents key.2 Δ) :
+    WhnfMeaning trProj authority.world keys.uvars Δ source value := by
+  exact WhnfCacheValid.expr hkind h.valid hsource haddr hctx
+
+/-- Operationally matched form of `whnfMeaning`: the concrete key execution
+supplies the address equality and represented context together. -/
+theorem whnfMeaningOfMatches {keys : WhnfContextKeys}
+    {trProj : RawProjRel} {fallback : CacheSemantics}
+    {authority : CacheAuthority} {support : RunSupport}
+    {kind : ExprCacheKind} {key : Address × Address}
+    {value source : KExpr .anon} {s : TcState .anon} {Δ : KVLCtx}
+    (h : CacheProvenance (whnfCacheSemantics keys trProj fallback)
+      authority support (.expr kind key value))
+    (hkind : kind.IsWhnf) (hsource : support source)
+    (hmatch : keys.Matches trProj authority.world s Δ source key) :
+    WhnfMeaning trProj authority.world keys.uvars Δ source value :=
+  h.whnfMeaning hkind hsource hmatch.sourceAddr hmatch.2.1
+
+end CacheProvenance
+
+namespace CacheInvariant
+
+/-- Physical hit plus the exact K1 cache invariant yields its Theory
+meaning. -/
+theorem whnfHit {keys : WhnfContextKeys} {trProj : RawProjRel}
+    {fallback : CacheSemantics} {authority : CacheAuthority}
+    {support : RunSupport} {env : KEnv .anon} {kind : ExprCacheKind}
+    {key : Address × Address} {value source : KExpr .anon}
+    (h : CacheInvariant (whnfCacheSemantics keys trProj fallback)
+      authority support env)
+    (hhit : env.HasCacheEntry (.expr kind key value))
+    (hkind : kind.IsWhnf) (hsource : support source)
+    (haddr : source.addr = key.1) {Δ : KVLCtx}
+    (hctx : keys.Represents key.2 Δ) :
+    WhnfMeaning trProj authority.world keys.uvars Δ source value :=
+  (h.hit hhit).whnfMeaning hkind hsource haddr hctx
+
+/-- Physical-hit form using the concrete key computation/context match. -/
+theorem whnfHitOfMatches {keys : WhnfContextKeys} {trProj : RawProjRel}
+    {fallback : CacheSemantics} {authority : CacheAuthority}
+    {support : RunSupport} {env : KEnv .anon} {kind : ExprCacheKind}
+    {key : Address × Address} {value source : KExpr .anon}
+    {s : TcState .anon} {Δ : KVLCtx}
+    (h : CacheInvariant (whnfCacheSemantics keys trProj fallback)
+      authority support env)
+    (hhit : env.HasCacheEntry (.expr kind key value))
+    (hkind : kind.IsWhnf) (hsource : support source)
+    (hmatch : keys.Matches trProj authority.world s Δ source key) :
+    WhnfMeaning trProj authority.world keys.uvars Δ source value :=
+  (h.hit hhit).whnfMeaningOfMatches hkind hsource hmatch
+
+end CacheInvariant
+
+/-! ## Conditional recursive-method interface -/
+
+/-- The two theorem layers required by K1.  The no-acceleration layer pins
+the production flag; the accelerated layer permits native helpers and hence
+requires `NativeOracle` at their successful branches. -/
+inductive WhnfLayer where
+  | noAccel
+  | accelerated
+  deriving Repr, DecidableEq
+
+def WhnfLayer.StateOK : WhnfLayer → TcState .anon → Prop
+  | .noAccel, s => s.noAccel = true
+  | .accelerated, _ => True
+
+/-- Fixed-world state invariant for one method call.  Ordinary reduction
+does not promote declarations.  Cache/intern coherence, concrete/ghost
+context reconciliation, and the selected acceleration policy are all
+preserved on success and error. -/
+def WhnfStateInv (layer : WhnfLayer) (semantics : CacheSemantics)
+    (trProj : RawProjRel) (world : VerifyWorld) (support : RunSupport)
+    (uvars : Nat) (Δ : KVLCtx) (s : TcState .anon) : Prop :=
+  KernelStateWF semantics trProj world support s ∧
+    CtxRecon world.venv uvars world.nameOf trProj s Δ ∧
+    layer.StateOK s
+
+namespace WhnfStateInv
+
+/-- Changing only operational bookkeeping fields preserves the complete
+fixed-world WHNF invariant.  The explicit field equations keep fuel and
+instrumentation updates from being mistaken for semantic state changes. -/
+theorem of_semantic_fields_eq
+    {layer : WhnfLayer} {semantics : CacheSemantics}
+    {trProj : RawProjRel} {world : VerifyWorld} {support : RunSupport}
+    {uvars : Nat} {Δ : KVLCtx} {before after : TcState .anon}
+    (h : WhnfStateInv layer semantics trProj world support uvars Δ before)
+    (henv : after.env = before.env)
+    (hctx : after.ctx = before.ctx)
+    (hlet : after.letVals = before.letVals)
+    (hnum : after.numLetBindings = before.numLetBindings)
+    (hlctx : after.lctx = before.lctx)
+    (hnoAccel : after.noAccel = before.noAccel) :
+    WhnfStateInv layer semantics trProj world support uvars Δ after := by
+  rcases h with ⟨hkernel, hrecon, hlayer⟩
+  refine ⟨?_, ?_, ?_⟩
+  · exact {
+      core := hkernel.core.of_env_eq henv
+      internSupport := by simpa only [henv] using hkernel.internSupport
+      caches := by simpa only [henv] using hkernel.caches }
+  · exact hrecon.of_fields_eq hctx hlet hnum hlctx (by simp [henv])
+  · cases layer with
+    | noAccel => simpa only [WhnfLayer.StateOK, hnoAccel] using hlayer
+    | accelerated => trivial
+
+end WhnfStateInv
+
+namespace ContextKeyFrame
+
+/-- Populating the suffix-key memo preserves the complete K1 invariant.
+The proof projects the exact frame rather than treating the memo operation as
+pure; this catches future writes to context, environment, fuel, or flags. -/
+theorem whnfStateInv {layer : WhnfLayer} {semantics : CacheSemantics}
+    {trProj : RawProjRel} {world : VerifyWorld} {support : RunSupport}
+    {uvars : Nat} {Δ : KVLCtx} {before after : TcState .anon}
+    (hframe : ContextKeyFrame before after)
+    (hI : WhnfStateInv layer semantics trProj world support uvars Δ before) :
+    WhnfStateInv layer semantics trProj world support uvars Δ after := by
+  rcases hI with ⟨hkernel, hctx, hlayer⟩
+  have henv : after.env = before.env := by
+    simpa [ContextKeyFrame] using congrArg TcState.env hframe
+  have hctxEq : after.ctx = before.ctx := by
+    simpa [ContextKeyFrame] using congrArg TcState.ctx hframe
+  have hlet : after.letVals = before.letVals := by
+    simpa [ContextKeyFrame] using congrArg TcState.letVals hframe
+  have hnum : after.numLetBindings = before.numLetBindings := by
+    simpa [ContextKeyFrame] using congrArg TcState.numLetBindings hframe
+  have hlctx : after.lctx = before.lctx := by
+    simpa [ContextKeyFrame] using congrArg TcState.lctx hframe
+  have hnoAccel : after.noAccel = before.noAccel := by
+    simpa [ContextKeyFrame] using congrArg TcState.noAccel hframe
+  refine ⟨?_, ?_, ?_⟩
+  · exact {
+      core := hkernel.core.of_env_eq henv
+      internSupport := by simpa [henv] using hkernel.internSupport
+      caches := by simpa [henv] using hkernel.caches }
+  · exact hctx.of_fields_eq hctxEq hlet hnum hlctx (by simp [henv])
+  · cases layer with
+    | noAccel => simpa [WhnfLayer.StateOK, hnoAccel] using hlayer
+    | accelerated => trivial
+
+end ContextKeyFrame
+
+namespace InternUpdateFrame
+
+/-- Intern-table growth preserves the context and acceleration components of
+the K1 invariant once the post-state kernel invariant has been re-established.
+Keeping the kernel premise explicit lets the finite-support walker proofs
+supply its new intern-table coherence and coverage facts. -/
+theorem whnfStateInv {layer : WhnfLayer} {semantics : CacheSemantics}
+    {trProj : RawProjRel} {world : VerifyWorld} {support : RunSupport}
+    {uvars : Nat} {Δ : KVLCtx} {before after : TcState .anon}
+    (hframe : InternUpdateFrame before after)
+    (hkernel : KernelStateWF semantics trProj world support after)
+    (hI : WhnfStateInv layer semantics trProj world support uvars Δ before) :
+    WhnfStateInv layer semantics trProj world support uvars Δ after := by
+  rcases hI with ⟨_, hctx, hlayer⟩
+  have hctxEq : after.ctx = before.ctx := by
+    simpa [InternUpdateFrame] using congrArg TcState.ctx hframe
+  have hlet : after.letVals = before.letVals := by
+    simpa [InternUpdateFrame] using congrArg TcState.letVals hframe
+  have hnum : after.numLetBindings = before.numLetBindings := by
+    simpa [InternUpdateFrame] using congrArg TcState.numLetBindings hframe
+  have hlctx : after.lctx = before.lctx := by
+    simpa [InternUpdateFrame] using congrArg TcState.lctx hframe
+  have hnext : after.env.nextFVarId = before.env.nextFVarId := by
+    simpa [InternUpdateFrame] using
+      congrArg (fun s : TcState .anon => s.env.nextFVarId) hframe
+  have hnoAccel : after.noAccel = before.noAccel := by
+    simpa [InternUpdateFrame] using congrArg TcState.noAccel hframe
+  refine ⟨hkernel, ?_, ?_⟩
+  · exact hctx.of_fields_eq hctxEq hlet hnum hlctx (by simp [hnext])
+  · cases layer with
+    | noAccel => simpa [WhnfLayer.StateOK, hnoAccel] using hlayer
+    | accelerated => trivial
+
+end InternUpdateFrame
+
+namespace TcM
+
+/-- Lift an exact `InternM` specification to the complete K1 state invariant.
+This is the common state bridge for beta/zeta walkers: the intern table may
+grow, but contexts, flags, loaded declarations, and semantic caches frame. -/
+theorem runIntern_whnf_wf {layer : WhnfLayer}
+    {semantics : CacheSemantics} {trProj : RawProjRel}
+    {world : VerifyWorld} {support : RunSupport} {uvars : Nat}
+    {Δ : KVLCtx} {x : InternM .anon α} {expected : α}
+    {s : TcState .anon}
+    (hspec : ∀ it : InternTable .anon, it.WF →
+      support.CoversIntern it →
+      (x it).1 = expected ∧ (x it).2.WF ∧
+        support.CoversIntern (x it).2) :
+    TcM.WF (WhnfStateInv layer semantics trProj world support uvars Δ) s
+      (TcM.runIntern x)
+      (fun result s' => result = expected ∧ InternUpdateFrame s s') := by
+  intro hI
+  have hkernel := hI.1
+  rcases hrun : x s.env.intern with ⟨result, intern⟩
+  have hpost := hspec s.env.intern hkernel.core.intern hkernel.internSupport
+  rw [hrun] at hpost
+  simp only [TcM.runIntern, hrun]
+  have hframe : InternUpdateFrame s
+      { s with env := { s.env with intern } } := rfl
+  have hkernel' : KernelStateWF semantics trProj world support
+      { s with env := { s.env with intern } } :=
+    ⟨hkernel.core.of_consts_eq rfl hpost.2.1,
+      hpost.2.2, hkernel.caches.of_intern_update⟩
+  exact ⟨hframe.whnfStateInv hkernel' hI, hpost.1, hframe⟩
+
+/-- Executable form of `runIntern_whnf_wf`.  `InternM` cannot throw, so an
+inhabited pre-state yields a concrete successful state and the exact expected
+result, while retaining the complete invariant and intern-only frame. -/
+theorem runIntern_whnf_eval {layer : WhnfLayer}
+    {semantics : CacheSemantics} {trProj : RawProjRel}
+    {world : VerifyWorld} {support : RunSupport} {uvars : Nat}
+    {Δ : KVLCtx} {x : InternM .anon α} {expected : α}
+    {s : TcState .anon}
+    (hspec : ∀ it : InternTable .anon, it.WF →
+      support.CoversIntern it →
+      (x it).1 = expected ∧ (x it).2.WF ∧
+        support.CoversIntern (x it).2)
+    (hI : WhnfStateInv layer semantics trProj world support uvars Δ s) :
+    ∃ s', TcM.runIntern x s = .ok expected s' ∧
+      WhnfStateInv layer semantics trProj world support uvars Δ s' ∧
+      InternUpdateFrame s s' := by
+  rcases hrun : x s.env.intern with ⟨result, intern⟩
+  have hwf := TcM.runIntern_whnf_wf (s := s) hspec hI
+  simp only [TcM.runIntern, hrun] at hwf
+  refine ⟨{ s with env := { s.env with intern } }, ?_, hwf.1, hwf.2.2⟩
+  simp only [TcM.runIntern, hrun]
+  rw [hwf.2.1]
+
+private theorem get_bind_run {α : Type} (s : TcState .anon)
+    (f : TcState .anon → TcM .anon α) :
+    ((get >>= f : TcM .anon α) s) = f s s := rfl
+
+/-- Exact evaluator for the successful legacy-let read.  The array premise
+is deliberately the production `getElem!` observation; context
+reconciliation supplies it from the safer optional read in the combined
+zeta theorem below. -/
+theorem lookupLetVal_eval {idx : UInt64}
+    {val result : KExpr .anon} {s s' : TcState .anon}
+    (hidx : idx.toNat < s.ctx.size)
+    (hval : s.letVals[s.ctx.size - 1 - idx.toNat]! = some val)
+    (hlift : TcM.runIntern (lift val (idx + 1) 0) s = .ok result s') :
+    TcM.lookupLetVal idx s = .ok (some result) s' := by
+  unfold TcM.lookupLetVal
+  rw [get_bind_run]
+  rw [if_neg (by omega)]
+  simp only [pure_bind]
+  rw [hval]
+  change EStateM.bind (TcM.runIntern (lift val (idx + 1) 0))
+    (fun r => pure (some r)) s = _
+  unfold EStateM.bind
+  rw [hlift]
+  rfl
+
+/-- Implementation-level frame theorem for `ctxAddrForLbr`.  It is
+polymorphic in the invariant: clients only need to prove closure under the
+single permitted memo-table write. -/
+theorem ctxAddrForLbr_wf {I : TcState .anon → Prop}
+    (hframe : ∀ {before after}, I before → ContextKeyFrame before after →
+      I after) (lbr : UInt64) (s : TcState .anon) :
+    TcM.WF I s (TcM.ctxAddrForLbr lbr)
+      (fun _ s' => ContextKeyFrame s s') := by
+  unfold TcM.ctxAddrForLbr
+  apply TcM.WF.bind (Q₁ := fun read s' => read = s ∧ s' = s)
+    (TcM.WF.get fun _ => ⟨rfl, rfl⟩)
+  rintro read before ⟨rfl, rfl⟩
+  split
+  · exact TcM.WF.pure fun _ => rfl
+  · apply TcM.WF.bind
+      (Q₁ := fun _ after => after = before)
+      (TcM.WF.pure fun _ => rfl)
+    intro _ after hafter
+    subst after
+    simp only
+    split
+    · exact TcM.WF.pure fun _ => rfl
+    · apply TcM.WF.bind
+        (Q₁ := fun _ after => after = before)
+        (TcM.WF.pure fun _ => rfl)
+      intro _ after hafter
+      subst after
+      refine TcM.WF.bind
+        (Q₁ := fun _ after => ContextKeyFrame before after) ?_ ?_
+      · exact TcM.WF.modifyGet
+          (fun hI => hframe hI
+            (show ContextKeyFrame before _ from rfl))
+          (fun _ => show ContextKeyFrame before _ from rfl)
+      · intro _ after hafter
+        exact TcM.WF.pure fun _ => hafter
+
+/-- `whnfKey` preserves K1 state and fixes the expression-address component
+of the returned key. -/
+theorem whnfKey_wf {layer : WhnfLayer} {semantics : CacheSemantics}
+    {trProj : RawProjRel} {world : VerifyWorld} {support : RunSupport}
+    {uvars : Nat} {Δ : KVLCtx} {source : KExpr .anon}
+    {s : TcState .anon} :
+    TcM.WF (WhnfStateInv layer semantics trProj world support uvars Δ) s
+      (TcM.whnfKey source)
+      (fun key s' => key.1 = source.addr ∧ ContextKeyFrame s s') := by
+  unfold TcM.whnfKey
+  apply TcM.WF.bind
+    (TcM.ctxAddrForLbr_wf
+      (fun hI hframe => hframe.whnfStateInv hI) source.lbr s)
+  intro addr after hframe
+  exact TcM.WF.pure fun _ => ⟨rfl, hframe⟩
+
+/-- Operational context-match constructor.  `hrep` is deliberately the only
+remaining ghost obligation: K1 cannot infer suffix sufficiency from a hash,
+and K2 will discharge it from the concrete context-closure algorithm. -/
+theorem whnfKey_matches_wf {layer : WhnfLayer}
+    {semantics : CacheSemantics} {trProj : RawProjRel}
+    {world : VerifyWorld} {support : RunSupport} {keys : WhnfContextKeys}
+    {Δ : KVLCtx} {source : KExpr .anon} {s : TcState .anon}
+    (hrep : ∀ key s', TcM.whnfKey source s = .ok key s' →
+      keys.Represents key.2 Δ) :
+    TcM.WF
+      (WhnfStateInv layer semantics trProj world support keys.uvars Δ) s
+      (TcM.whnfKey source)
+      (fun key s' => keys.Matches trProj world s Δ source key ∧
+        ContextKeyFrame s s') := by
+  intro hI
+  have hwf := TcM.whnfKey_wf (layer := layer) (semantics := semantics)
+    (trProj := trProj) (world := world) (support := support)
+    (uvars := keys.uvars) (Δ := Δ) (source := source) (s := s) hI
+  match hrun : TcM.whnfKey source s with
+  | .ok key s' =>
+      rw [hrun] at hwf
+      exact ⟨hwf.1,
+        ⟨⟨hI.2.1, hrep key s' hrun, ⟨s', hrun⟩⟩, hwf.2.2⟩⟩
+  | .error err s' =>
+      rw [hrun] at hwf
+      exact hwf
+
+/-! ### Exact instrumentation and fuel equations -/
+
+/-- A disabled step journal is an exact state-preserving no-op. -/
+theorem stepTrace_disabled {s : TcState .anon}
+    (h : s.stepTrace = false) (tag : String) (payload : Unit → String) :
+    TcM.stepTrace tag payload s = .ok () s := by
+  unfold TcM.stepTrace
+  change EStateM.bind (get : TcM .anon (TcState .anon)) _ s = _
+  unfold EStateM.bind
+  rw [show (get : TcM .anon (TcState .anon)) s = .ok s s from rfl]
+  simp [h]
+  rfl
+
+/-- Disabled statistics make every counter update an exact no-op. -/
+theorem bumpStats_disabled {s : TcState .anon}
+    (h : s.stats = false) (f : TcState .anon → TcState .anon) :
+    TcM.bumpStats f s = .ok () s := by
+  unfold TcM.bumpStats
+  change EStateM.bind (get : TcM .anon (TcState .anon)) _ s = _
+  unfold EStateM.bind
+  rw [show (get : TcM .anon (TcState .anon)) s = .ok s s from rfl]
+  simp [h]
+  rfl
+
+/-- A positive fuel counter is decremented exactly once. -/
+theorem tick_success {s : TcState .anon}
+    (h : (s.recFuel == 0) = false) :
+    TcM.tick s = .ok () {s with recFuel := s.recFuel - 1} := by
+  unfold TcM.tick
+  change EStateM.bind (get : TcM .anon (TcState .anon)) _ s = _
+  unfold EStateM.bind
+  rw [show (get : TcM .anon (TcState .anon)) s = .ok s s from rfl]
+  simp only [h, Bool.false_eq_true, if_false]
+  rfl
+
+end TcM
+
+namespace RunAssumptions
+
+/-- The verified lifting walker preserves the complete K1 invariant.  This
+is the legacy-zeta sibling of `simulSubst_whnf_wf`: the stored let value is
+rebased to the current de Bruijn depth while only the intern table may grow. -/
+theorem lift_whnf_wf {α : Type} {initial : TcState .anon}
+    {program : TcM .anon α} {requests : List WalkerRequest}
+    {support : RunSupport}
+    (h : RunAssumptions initial program requests support)
+    {layer : WhnfLayer} {semantics : CacheSemantics}
+    {trProj : RawProjRel} {world : VerifyWorld} {uvars : Nat}
+    {Δ : KVLCtx} {e : KExpr .anon} {shift cutoff : UInt64}
+    (hmem : WalkerRequest.lift e shift cutoff ∈ requests)
+    {s : TcState .anon} :
+    TcM.WF (WhnfStateInv layer semantics trProj world support uvars Δ) s
+      (TcM.runIntern (lift e shift cutoff))
+      (fun result s' => result = KExpr.liftSpec e shift cutoff ∧
+        InternUpdateFrame s s') :=
+  TcM.runIntern_whnf_wf fun _ hwf hsup =>
+    h.lift_spec hmem hwf hsup
+
+/-- Concrete-success projection of `lift_whnf_wf`, used to rewrite the
+production `lookupLetVal` branch. -/
+theorem lift_whnf_eval {α : Type} {initial : TcState .anon}
+    {program : TcM .anon α} {requests : List WalkerRequest}
+    {support : RunSupport}
+    (h : RunAssumptions initial program requests support)
+    {layer : WhnfLayer} {semantics : CacheSemantics}
+    {trProj : RawProjRel} {world : VerifyWorld} {uvars : Nat}
+    {Δ : KVLCtx} {e : KExpr .anon} {shift cutoff : UInt64}
+    (hmem : WalkerRequest.lift e shift cutoff ∈ requests)
+    {s : TcState .anon}
+    (hI : WhnfStateInv layer semantics trProj world support uvars Δ s) :
+    ∃ s', TcM.runIntern (lift e shift cutoff) s =
+        .ok (KExpr.liftSpec e shift cutoff) s' ∧
+      WhnfStateInv layer semantics trProj world support uvars Δ s' ∧
+      InternUpdateFrame s s' :=
+  TcM.runIntern_whnf_eval
+    (fun _ hwf hsup => h.lift_spec hmem hwf hsup) hI
+
+/-- The verified simultaneous-substitution walker preserves the complete K1
+invariant, not merely intern-table coherence.  Its request membership keeps
+finite collision/support and UInt64 resource assumptions tied to an actual
+execution certificate. -/
+theorem simulSubst_whnf_wf {α : Type} {initial : TcState .anon}
+    {program : TcM .anon α} {requests : List WalkerRequest}
+    {support : RunSupport}
+    (h : RunAssumptions initial program requests support)
+    {layer : WhnfLayer} {semantics : CacheSemantics}
+    {trProj : RawProjRel} {world : VerifyWorld} {uvars : Nat}
+    {Δ : KVLCtx} {body : KExpr .anon}
+    {substs : Array (KExpr .anon)} {depth : UInt64}
+    (hmem : WalkerRequest.simulSubst body substs depth ∈ requests)
+    {s : TcState .anon} :
+    TcM.WF (WhnfStateInv layer semantics trProj world support uvars Δ) s
+      (TcM.runIntern (simulSubst body substs depth))
+      (fun result s' =>
+        result = KExpr.simulSubstSpec body substs depth ∧
+        InternUpdateFrame s s') :=
+  TcM.runIntern_whnf_wf fun _ hwf hsup =>
+    h.simulSubst_spec hmem hwf hsup
+
+/-- Concrete-success projection of `simulSubst_whnf_wf`, suitable for
+rewriting the production beta branch. -/
+theorem simulSubst_whnf_eval {α : Type} {initial : TcState .anon}
+    {program : TcM .anon α} {requests : List WalkerRequest}
+    {support : RunSupport}
+    (h : RunAssumptions initial program requests support)
+    {layer : WhnfLayer} {semantics : CacheSemantics}
+    {trProj : RawProjRel} {world : VerifyWorld} {uvars : Nat}
+    {Δ : KVLCtx} {body : KExpr .anon}
+    {substs : Array (KExpr .anon)} {depth : UInt64}
+    (hmem : WalkerRequest.simulSubst body substs depth ∈ requests)
+    {s : TcState .anon}
+    (hI : WhnfStateInv layer semantics trProj world support uvars Δ s) :
+    ∃ s',
+      TcM.runIntern (simulSubst body substs depth) s =
+        .ok (KExpr.simulSubstSpec body substs depth) s' ∧
+      WhnfStateInv layer semantics trProj world support uvars Δ s' ∧
+      InternUpdateFrame s s' :=
+  TcM.runIntern_whnf_eval
+    (fun _ hwf hsup => h.simulSubst_spec hmem hwf hsup) hI
+
+end RunAssumptions
+
+/-- Successful reduction postcondition relative to the structural
+translation of the input. -/
+def WhnfPost (trProj : RawProjRel) (world : VerifyWorld)
+    (uvars : Nat) (Δ : KVLCtx) (sourceV : VExpr)
+    (result : KExpr .anon) : Prop :=
+  ∃ resultV,
+    TrKExprS world.venv uvars world.nameOf trProj Δ result resultV ∧
+    world.venv.IsDefEqU uvars Δ.toCtx sourceV resultV
+
+/-- Theory-side assumptions needed to turn a structural translation into a
+well-formed expression.  Literal typing and projection closure are explicit;
+the ordered environment comes from `VerifyWorld.venvWF`. -/
+structure WhnfTheory (trProj : RawProjRel) (world : VerifyWorld)
+    (uvars : Nat) : Prop where
+  literalWF : ∀ literal, world.venv.ContainsLits literal →
+    VExpr.WF world.venv uvars [] (VExpr.trLiteral literal)
+  projections : TrProjOK world.venv uvars trProj
+
+namespace WhnfTheory
+
+theorem exprWF {trProj : RawProjRel} {world : VerifyWorld} {uvars : Nat}
+    (theory : WhnfTheory trProj world uvars) {s : TcState .anon}
+    {Δ : KVLCtx} (hctx :
+      CtxRecon world.venv uvars world.nameOf trProj s Δ)
+    {e : KExpr .anon} {ve : VExpr}
+    (htr : TrKExprS world.venv uvars world.nameOf trProj Δ e ve) :
+    VExpr.WF world.venv uvars Δ.toCtx ve :=
+  htr.wf world.venvWF.ordered theory.literalWF theory.projections.wf
+    hctx.wf
+
+/-- Compose two concrete reduction meanings.  The middle concrete term may
+have two different structural translations; `TrKExprS.uniq` bridges them
+before Theory transitivity is applied.  This is the semantic loop invariant
+used by the forthcoming bounded WHNF proofs. -/
+theorem transMeaning {trProj : RawProjRel} {world : VerifyWorld}
+    {uvars : Nat} (theory : WhnfTheory trProj world uvars)
+    {Δ : KVLCtx} (hΔ : KVLCtx.WF world.venv uvars Δ)
+    {source middle result : KExpr .anon}
+    (h₁ : WhnfMeaning trProj world uvars Δ source middle)
+    (h₂ : WhnfMeaning trProj world uvars Δ middle result) :
+    WhnfMeaning trProj world uvars Δ source result := by
+  obtain ⟨sourceV, middleV₁, hsource, hmiddle₁, hdefeq₁⟩ := h₁
+  obtain ⟨middleV₂, resultV, hmiddle₂, hresult, hdefeq₂⟩ := h₂
+  have hctx := KVLCtx.IsDefEq.refl world.venvWF hΔ
+  have hmiddle := hmiddle₁.uniq world.venvWF theory.literalWF
+    theory.projections hctx hmiddle₂
+  refine ⟨sourceV, resultV, hsource, hresult, ?_⟩
+  exact hdefeq₁.trans world.venvWF hΔ <|
+    hmiddle.trans world.venvWF hΔ hdefeq₂
+
+end WhnfTheory
+
+namespace WhnfMeaning
+
+/-- Legacy de-Bruijn zeta meaning.  `lookupLetVal` and `KVLCtx.find?`
+perform the same re-basing: the concrete walker lifts the stored value by
+`idx + 1`, while the translation context inlines that lifted value at the
+variable use site. -/
+theorem zetaVar {trProj : RawProjRel} {world : VerifyWorld}
+    {uvars : Nat} {s : TcState .anon} {Δ : KVLCtx}
+    {idx : UInt64} {name : Mode.anon.F Name} {md : ExprInfo .anon}
+    {ty val : KExpr .anon}
+    (hctx : CtxRecon world.venv uvars world.nameOf trProj s Δ)
+    (htp : TrProjOK world.venv uvars trProj)
+    (hidx : idx.toNat < s.ctx.size) (hsz : s.ctx.size < UInt64.size)
+    (hty : s.ctx[s.ctx.size - 1 - idx.toNat]? = some ty)
+    (hov : s.letVals[s.ctx.size - 1 - idx.toNat]? = some (some val))
+    (hbig : Δ.bvars + val.size < UInt64.size) :
+    WhnfMeaning trProj world uvars Δ (.var idx name md)
+      (KExpr.liftSpec val (idx + 1) 0) := by
+  obtain ⟨e, A, hfind, hresult⟩ := hctx.lookupLetVal
+    world.venvWF.ordered htp hidx hsz hty hov hbig
+  have hsource : TrKExprS world.venv uvars world.nameOf trProj Δ
+      (.var idx name md) e := .var hfind
+  have hwf : VExpr.WF world.venv uvars Δ.toCtx e :=
+    ⟨A, hctx.wf.find?_wf world.venvWF.ordered hfind⟩
+  exact ⟨e, e, hsource, hresult, hwf⟩
+
+/-- Let-bound fvar zeta meaning under the exact condition needed by the
+production branch: the stored value has no loose legacy bvars, so returning
+it without a shift agrees with the mixed-context lookup. -/
+theorem zetaFVar {trProj : RawProjRel} {world : VerifyWorld}
+    {uvars : Nat} {s : TcState .anon} {Δ : KVLCtx}
+    {fv : FVarId} {name : Mode.anon.F Name} {md : ExprInfo .anon}
+    {declName : Mode.anon.F Name} {ty val : KExpr .anon}
+    (hctx : CtxRecon world.venv uvars world.nameOf trProj s Δ)
+    (htp : TrProjOK world.venv uvars trProj)
+    (hfind : s.lctx.find? fv = some (.ldecl declName ty val))
+    (hcon : KExpr.Constructed val) (hclosed : val.lbr = 0)
+    (hbig : Δ.bvars + val.size < UInt64.size) :
+    WhnfMeaning trProj world uvars Δ (.fvar fv name md) val := by
+  obtain ⟨e, A, hresolve, hresult⟩ := hctx.lctxFindLetVal
+    world.venvWF.ordered htp hfind hcon hclosed hbig
+  have hsource : TrKExprS world.venv uvars world.nameOf trProj Δ
+      (.fvar fv name md) e := .fvar hresolve
+  have hwf : VExpr.WF world.venv uvars Δ.toCtx e :=
+    ⟨A, hctx.wf.find?_wf world.venvWF.ordered hresolve⟩
+  exact ⟨e, e, hsource, hresult, hwf⟩
+
+/-- One concrete beta step.  The result is the same `substSpec` computed by
+the verified substitution walker; the proof uses `TrKExprS.instN` and the
+Theory's beta rule, so no syntactic address equality stands in for reduction
+meaning.  The resource bound is exactly the walker's UInt64 safety premise. -/
+theorem beta {trProj : RawProjRel} {world : VerifyWorld} {uvars : Nat}
+    (projections : TrProjOK world.venv uvars trProj)
+    {Δ : KVLCtx} {nm : Mode.anon.F Name}
+    {bi : Mode.anon.F Lean.BinderInfo}
+    {ty body arg : KExpr .anon} {lamMd appMd : ExprInfo .anon}
+    {A bodyV argV B : VExpr} {u : Lean4Lean.VLevel}
+    (hty : TrKExprS world.venv uvars world.nameOf trProj Δ ty A)
+    (hbody : TrKExprS world.venv uvars world.nameOf trProj
+      ((none, .vlam A) :: Δ) body bodyV)
+    (harg : TrKExprS world.venv uvars world.nameOf trProj Δ arg argV)
+    (hA : world.venv.HasType uvars Δ.toCtx A (.sort u))
+    (hbodyTy : world.venv.HasType uvars (A :: Δ.toCtx) bodyV B)
+    (hargTy : world.venv.HasType uvars Δ.toCtx argV A)
+    (hbig : Δ.bvars + body.size + arg.size < UInt64.size) :
+    WhnfMeaning trProj world uvars Δ
+      (.app (.lam nm bi ty body lamMd) arg appMd)
+      (KExpr.substSpec body arg 0) := by
+  have hlam : TrKExprS world.venv uvars world.nameOf trProj Δ
+      (.lam nm bi ty body lamMd) (.lam A bodyV) :=
+    .lam ⟨u, hA⟩ hty hbody
+  have hsource : TrKExprS world.venv uvars world.nameOf trProj Δ
+      (.app (.lam nm bi ty body lamMd) arg appMd)
+      (.app (.lam A bodyV) argV) :=
+    .app (Lean4Lean.VEnv.HasType.lam hA hbodyTy) hargTy hlam harg
+  have hresult : TrKExprS world.venv uvars world.nameOf trProj Δ
+      (KExpr.substSpec body arg 0) (bodyV.inst argV) :=
+    TrKExprS.instN world.venvWF.ordered projections.weakN
+      projections.instN harg hargTy hbody (.zero) rfl hbig
+  exact ⟨_, _, hsource, hresult, ⟨_, .beta hbodyTy hargTy⟩⟩
+
+/-- Bridge the Theory beta rule's single-substitution result to the exact
+singleton simultaneous-substitution specification used by production WHNF.
+The equality remains explicit: it is a pure walker lemma, not a consequence
+of semantic definitional equality. -/
+theorem betaSimul {trProj : RawProjRel} {world : VerifyWorld}
+    {uvars : Nat} {Δ : KVLCtx} {nm : Mode.anon.F Name}
+    {bi : Mode.anon.F Lean.BinderInfo}
+    {ty body arg : KExpr .anon} {lamMd appMd : ExprInfo .anon}
+    (hbeta : WhnfMeaning trProj world uvars Δ
+      (.app (.lam nm bi ty body lamMd) arg appMd)
+      (KExpr.substSpec body arg 0))
+    (hspec : KExpr.simulSubstSpec body #[arg] 0 =
+      KExpr.substSpec body arg 0) :
+    WhnfMeaning trProj world uvars Δ
+      (.app (.lam nm bi ty body lamMd) arg appMd)
+      (KExpr.simulSubstSpec body #[arg] 0) := by
+  rw [hspec]
+  exact hbeta
+
+/-- A projection result has reduction meaning when the source projection and
+the concrete result translate to the same Theory expression selected by the
+explicit projection relation.  This theorem deliberately consumes a
+`trProj` witness; successful execution of the syntax-directed production
+helper cannot manufacture one. -/
+theorem projection {trProj : RawProjRel} {world : VerifyWorld}
+    {uvars : Nat} {Δ : KVLCtx} {id : KId .anon} {field : UInt64}
+    {value result : KExpr .anon} {info : ExprInfo .anon}
+    {structName : Lean.Name} {valueV resultV : VExpr}
+    (hname : world.nameOf id.addr = some structName)
+    (hvalue :
+      TrKExprS world.venv uvars world.nameOf trProj Δ value valueV)
+    (hproj : trProj Δ.toCtx structName field.toNat valueV resultV)
+    (hresult :
+      TrKExprS world.venv uvars world.nameOf trProj Δ result resultV)
+    (hwf : VExpr.WF world.venv uvars Δ.toCtx resultV) :
+    WhnfMeaning trProj world uvars Δ (.prj id field value info) result :=
+  ⟨resultV, resultV, .prj hname hvalue hproj, hresult, hwf⟩
+
+/-- Turn one exact registered Theory computation equation into reduction
+meaning.  The caller must translate the concrete source and result to the
+instantiated left- and right-hand sides; mere membership of a raw recursor
+rule does not determine the production argument spine. -/
+theorem registeredDefEq {trProj : RawProjRel} {world : VerifyWorld}
+    {uvars : Nat} {Δ : KVLCtx} {source result : KExpr .anon}
+    {df : Lean4Lean.VDefEq} {levels : List Lean4Lean.VLevel}
+    (hsource : TrKExprS world.venv uvars world.nameOf trProj Δ source
+      (df.lhs.instL levels))
+    (hresult : TrKExprS world.venv uvars world.nameOf trProj Δ result
+      (df.rhs.instL levels))
+    (hregistered : world.venv.defeqs df)
+    (hlevels : ∀ level ∈ levels, level.WF uvars)
+    (harity : levels.length = df.uvars) :
+    WhnfMeaning trProj world uvars Δ source result :=
+  ⟨_, _, hsource, hresult,
+    ⟨_, .extra hregistered hlevels harity⟩⟩
+
+end WhnfMeaning
+
+namespace WhnfPost
+
+theorem refl {trProj : RawProjRel} {world : VerifyWorld} {uvars : Nat}
+    {Δ : KVLCtx} {e : KExpr .anon} {sourceV : VExpr}
+    (htr : TrKExprS world.venv uvars world.nameOf trProj Δ e sourceV)
+    (hwf : VExpr.WF world.venv uvars Δ.toCtx sourceV) :
+    WhnfPost trProj world uvars Δ sourceV e :=
+  ⟨sourceV, htr, hwf⟩
+
+end WhnfPost
+
+/-- Successful inference callback postcondition used inside WHNF's K/struct
+fallbacks.  K2 proves this field for the concrete method table. -/
+def InferPost (trProj : RawProjRel) (world : VerifyWorld)
+    (uvars : Nat) (Δ : KVLCtx) (sourceV : VExpr)
+    (ty : KExpr .anon) : Prop :=
+  ∃ tyV,
+    TrKExpr world.venv uvars world.nameOf trProj Δ ty tyV ∧
+    world.venv.HasType uvars Δ.toCtx sourceV tyV
+
+namespace Methods
+
+/-- Conditional semantic closure of all six K0 method-table back-edges.
+K1 consumes this record while proving WHNF; K2 proves the inference/defeq
+fields and closes `methodsN` by induction. -/
+structure WF (layer : WhnfLayer) (semantics : CacheSemantics)
+    (trProj : RawProjRel) (world : VerifyWorld) (support : RunSupport)
+    (methods : Methods .anon) : Prop where
+  whnf : ∀ {uvars Δ s e sourceV},
+    TrKExprS world.venv uvars world.nameOf trProj Δ e sourceV →
+    TcM.WF (WhnfStateInv layer semantics trProj world support uvars Δ) s
+      (methods.whnf e)
+      (fun result _ => WhnfPost trProj world uvars Δ sourceV result)
+  whnfCore : ∀ {uvars Δ s e sourceV},
+    TrKExprS world.venv uvars world.nameOf trProj Δ e sourceV →
+    TcM.WF (WhnfStateInv layer semantics trProj world support uvars Δ) s
+      (methods.whnfCore e)
+      (fun result _ => WhnfPost trProj world uvars Δ sourceV result)
+  whnfMode : ∀ {uvars Δ s e sourceV} {mode : NatSuccMode},
+    TrKExprS world.venv uvars world.nameOf trProj Δ e sourceV →
+    TcM.WF (WhnfStateInv layer semantics trProj world support uvars Δ) s
+      (methods.whnfMode e mode)
+      (fun result _ => WhnfPost trProj world uvars Δ sourceV result)
+  whnfCoreFlags : ∀ {uvars Δ s e sourceV} {flags : WhnfFlags},
+    TrKExprS world.venv uvars world.nameOf trProj Δ e sourceV →
+    TcM.WF (WhnfStateInv layer semantics trProj world support uvars Δ) s
+      (methods.whnfCoreFlags e flags)
+      (fun result _ => WhnfPost trProj world uvars Δ sourceV result)
+  infer : ∀ {uvars Δ s e sourceV},
+    TrKExprS world.venv uvars world.nameOf trProj Δ e sourceV →
+    TcM.WF (WhnfStateInv layer semantics trProj world support uvars Δ) s
+      (methods.infer e)
+      (fun ty _ => InferPost trProj world uvars Δ sourceV ty)
+  isDefEq : ∀ {uvars Δ s a b va vb},
+    TrKExprS world.venv uvars world.nameOf trProj Δ a va →
+    TrKExprS world.venv uvars world.nameOf trProj Δ b vb →
+    TcM.WF (WhnfStateInv layer semantics trProj world support uvars Δ) s
+      (methods.isDefEq a b)
+      (fun answer _ => answer = true →
+        world.venv.IsDefEqU uvars Δ.toCtx va vb)
+
+end Methods
+
+/-! ## Projection/iota semantic boundary -/
+
+/-- Conditional K1e boundary for the two inductive structural reducers.
+
+The production helpers are intentionally syntax-directed: a loaded
+constructor-shaped constant is enough for them to select a projection field
+or recursor rule.  Therefore helper success alone is not semantic evidence.
+Each clause additionally requires a structural translation of the original
+source and is indexed by the exact callback/helper equations used by the
+production branch.
+
+This record is proof debt, not a new axiom.  Projection theory must construct
+`projection` from the concrete `trProj` implementation.  Inductive-block
+verification must construct `iota` from the registered defeq and the exact
+parameter/motive/minor/field/trailing-argument correspondence.  The existing
+`RawRecursorRuleRel` records the registered rule but intentionally does not
+yet imply that spine correspondence. -/
+structure InductiveReductionOracle (layer : WhnfLayer)
+    (semantics : CacheSemantics) (trProj : RawProjRel)
+    (world : VerifyWorld) (support : RunSupport) : Prop where
+  projection : ∀ {uvars Δ methods s s₁ s₂ id field value wvalue result info
+      flags sourceV},
+    Methods.WF layer semantics trProj world support methods →
+    TrKExprS world.venv uvars world.nameOf trProj Δ
+      (.prj id field value info) sourceV →
+    WhnfStateInv layer semantics trProj world support uvars Δ s →
+    (if flags.cheapProj then
+        (RecM.whnfCoreFlagsRec value flags).run methods s
+      else (RecM.whnfRec value).run methods s) = .ok wvalue s₁ →
+    (RecM.tryProjReduce id field wvalue).run methods s₁ =
+      .ok (some result) s₂ →
+    WhnfStateInv layer semantics trProj world support uvars Δ s₂ ∧
+      WhnfMeaning trProj world uvars Δ
+        (.prj id field value info) result
+  iota : ∀ {uvars Δ methods s s₁ s₂ recId us headInfo appInfo f arg args
+      result flags sourceV},
+    Methods.WF layer semantics trProj world support methods →
+    TrKExprS world.venv uvars world.nameOf trProj Δ
+      (.app f arg appInfo) sourceV →
+    WhnfStateInv layer semantics trProj world support uvars Δ s →
+    (.app f arg appInfo : KExpr .anon).collectSpine =
+      (.const recId us headInfo, args) →
+    methods.whnfCoreFlags (.const recId us headInfo) flags s =
+      .ok (.const recId us headInfo) s₁ →
+    ((.const recId us headInfo : KExpr .anon) !=
+      .const recId us headInfo) = false →
+    (RecM.tryIotaWithFlags (.app f arg appInfo) flags).run methods s₁ =
+      .ok (some result) s₂ →
+    WhnfStateInv layer semantics trProj world support uvars Δ s₂ ∧
+      WhnfMeaning trProj world uvars Δ (.app f arg appInfo) result
+
+namespace RecM
+
+/-- Reader-level Hoare triple conditional on a semantically closed method
+table.  Quantification over every `Methods.WF` table is what lets K1 land
+before K2 ties the total recursive knot. -/
+def WF (layer : WhnfLayer) (semantics : CacheSemantics)
+    (trProj : RawProjRel) (world : VerifyWorld) (support : RunSupport)
+    (uvars : Nat) (Δ : KVLCtx) (s : TcState .anon) (x : RecM .anon α)
+    (Q : α → TcState .anon → Prop)
+    (E : TcError .anon → TcState .anon → Prop := fun _ _ => True) : Prop :=
+  ∀ methods, methods.WF layer semantics trProj world support →
+    TcM.WF (WhnfStateInv layer semantics trProj world support uvars Δ) s
+      (x.run methods) Q E
+
+namespace WF
+
+theorem pure {layer : WhnfLayer} {semantics : CacheSemantics}
+    {trProj : RawProjRel} {world : VerifyWorld} {support : RunSupport}
+    {uvars : Nat} {Δ : KVLCtx} {s : TcState .anon}
+    {Q : α → TcState .anon → Prop}
+    {E : TcError .anon → TcState .anon → Prop} {a : α}
+    (h : WhnfStateInv layer semantics trProj world support uvars Δ s →
+      Q a s) :
+    RecM.WF layer semantics trProj world support uvars Δ s
+      (pure a) Q E := by
+  intro methods hmethods
+  exact TcM.WF.pure h
+
+theorem throw {layer : WhnfLayer} {semantics : CacheSemantics}
+    {trProj : RawProjRel} {world : VerifyWorld} {support : RunSupport}
+    {uvars : Nat} {Δ : KVLCtx} {s : TcState .anon}
+    {Q : α → TcState .anon → Prop}
+    {E : TcError .anon → TcState .anon → Prop} {err : TcError .anon}
+    (h : WhnfStateInv layer semantics trProj world support uvars Δ s →
+      E err s) :
+    RecM.WF layer semantics trProj world support uvars Δ s
+      (throw err) Q E := by
+  intro methods hmethods
+  exact TcM.WF.throw h
+
+theorem mono {layer : WhnfLayer} {semantics : CacheSemantics}
+    {trProj : RawProjRel} {world : VerifyWorld} {support : RunSupport}
+    {uvars : Nat} {Δ : KVLCtx} {s : TcState .anon}
+    {x : RecM .anon α} {Q Q' : α → TcState .anon → Prop}
+    {E E' : TcError .anon → TcState .anon → Prop}
+    (hx : RecM.WF layer semantics trProj world support uvars Δ s x Q E)
+    (hq : ∀ a s', Q a s' → Q' a s')
+    (he : ∀ err s', E err s' → E' err s') :
+    RecM.WF layer semantics trProj world support uvars Δ s x Q' E' := by
+  intro methods hmethods
+  exact TcM.WF.mono (hx methods hmethods) hq he
+
+theorem bind {layer : WhnfLayer} {semantics : CacheSemantics}
+    {trProj : RawProjRel} {world : VerifyWorld} {support : RunSupport}
+    {uvars : Nat} {Δ : KVLCtx} {s : TcState .anon}
+    {x : RecM .anon α} {f : α → RecM .anon β}
+    {Q₁ : α → TcState .anon → Prop} {Q₂ : β → TcState .anon → Prop}
+    {E : TcError .anon → TcState .anon → Prop}
+    (hx : RecM.WF layer semantics trProj world support uvars Δ s x Q₁ E)
+    (hf : ∀ a s', Q₁ a s' →
+      RecM.WF layer semantics trProj world support uvars Δ s'
+        (f a) Q₂ E) :
+    RecM.WF layer semantics trProj world support uvars Δ s
+      (x >>= f) Q₂ E := by
+  intro methods hmethods
+  exact TcM.WF.bind (hx methods hmethods) fun a s' ha =>
+    hf a s' ha methods hmethods
+
+end WF
+
+/-- Generic invariant rule for K0's total bounded-loop driver.  Exhaustion
+is explicit in `hexhaust`; every successful `.next` re-establishes `P`, and
+every `.done` establishes the final postcondition. -/
+theorem runBounded_wf {layer : WhnfLayer} {semantics : CacheSemantics}
+    {trProj : RawProjRel} {world : VerifyWorld} {support : RunSupport}
+    {uvars : Nat} {Δ : KVLCtx}
+    {step : σ → RecM .anon (BoundedStep σ α)}
+    {P : σ → Prop} {Q : α → TcState .anon → Prop}
+    {E : TcError .anon → TcState .anon → Prop}
+    (hstep : ∀ state s, P state →
+      RecM.WF layer semantics trProj world support uvars Δ s (step state)
+        (fun action s' => match action with
+          | .next next => P next
+          | .done result => Q result s') E)
+    (hexhaust : ∀ s,
+      WhnfStateInv layer semantics trProj world support uvars Δ s →
+      E .maxRecDepth s) :
+    ∀ fuel state s, P state →
+      RecM.WF layer semantics trProj world support uvars Δ s
+        (runBounded step fuel state) Q E
+  | 0, state, s, hP => by
+      rw [runBounded]
+      exact RecM.WF.throw (hexhaust s)
+  | fuel + 1, state, s, hP => by
+      rw [runBounded]
+      apply RecM.WF.bind (hstep state s hP)
+      intro action s' haction
+      cases action with
+      | next next =>
+        exact runBounded_wf hstep hexhaust fuel next s' haction
+      | done result =>
+        exact RecM.WF.pure fun _ => haction
+
+/-- Execution-indexed semantic certificate for the production structural
+WHNF loop.  Its fuel index is the actual fuel presented to `runBounded`.
+Every iteration records the exact production equation, the fixed
+world/context invariant on both sides, and the local Theory meaning.
+
+This is intentionally stronger than successful raw execution: neither a
+callback result nor syntax-directed projection/iota success can manufacture
+the `WhnfMeaning` field.  Conversely, zero fuel has no constructor, matching
+the production exhaustion error. -/
+inductive WhnfCoreTrace (layer : WhnfLayer) (semantics : CacheSemantics)
+    (trProj : RawProjRel) (world : VerifyWorld) (support : RunSupport)
+    (uvars : Nat) (Δ : KVLCtx) (methods : Methods .anon)
+    (flags : WhnfFlags) :
+    Nat → KExpr .anon → TcState .anon → KExpr .anon → TcState .anon → Prop
+  | done {fuel : Nat} {cur result : KExpr .anon} {s s' : TcState .anon} :
+      WhnfStateInv layer semantics trProj world support uvars Δ s →
+      (whnfCoreWithFlagsStep cur flags).run methods s =
+        .ok (.done result) s' →
+      WhnfStateInv layer semantics trProj world support uvars Δ s' →
+      WhnfMeaning trProj world uvars Δ cur result →
+      WhnfCoreTrace layer semantics trProj world support uvars Δ methods flags
+        (fuel + 1) cur s result s'
+  | next {fuel : Nat} {cur middle result : KExpr .anon}
+      {s s' s'' : TcState .anon} :
+      WhnfStateInv layer semantics trProj world support uvars Δ s →
+      (whnfCoreWithFlagsStep cur flags).run methods s =
+        .ok (.next middle) s' →
+      WhnfStateInv layer semantics trProj world support uvars Δ s' →
+      WhnfMeaning trProj world uvars Δ cur middle →
+      WhnfCoreTrace layer semantics trProj world support uvars Δ methods flags
+        fuel middle s' result s'' →
+      WhnfCoreTrace layer semantics trProj world support uvars Δ methods flags
+        (fuel + 1) cur s result s''
+
+namespace WhnfCoreTrace
+
+/-- Exhaustion cannot be mislabeled as a certified structural reduction. -/
+theorem no_zero {layer : WhnfLayer} {semantics : CacheSemantics}
+    {trProj : RawProjRel} {world : VerifyWorld} {support : RunSupport}
+    {uvars : Nat} {Δ : KVLCtx} {methods : Methods .anon}
+    {flags : WhnfFlags} {source result : KExpr .anon}
+    {s s' : TcState .anon} :
+    ¬WhnfCoreTrace layer semantics trProj world support uvars Δ methods flags
+      0 source s result s' := by
+  intro h
+  cases h
+
+/-- Erase the semantic payload to the exact successful production execution.
+This direction is deliberately one-way: raw success alone is not a semantic
+certificate. -/
+theorem eval {layer : WhnfLayer} {semantics : CacheSemantics}
+    {trProj : RawProjRel} {world : VerifyWorld} {support : RunSupport}
+    {uvars : Nat} {Δ : KVLCtx} {methods : Methods .anon}
+    {flags : WhnfFlags} {fuel : Nat} {source result : KExpr .anon}
+    {s s' : TcState .anon}
+    (h : WhnfCoreTrace layer semantics trProj world support uvars Δ methods
+      flags fuel source s result s') :
+    (runBounded (fun cur => whnfCoreWithFlagsStep cur flags) fuel source).run
+      methods s = .ok result s' := by
+  induction h with
+  | done hI hstep hI' hmeaning =>
+      rw [runBounded, ReaderT.run_bind]
+      change EStateM.bind
+        (ReaderT.run (whnfCoreWithFlagsStep _ _) _) _ _ = _
+      unfold EStateM.bind
+      rw [hstep]
+      rfl
+  | next hI hstep hI' hmeaning htail ih =>
+      rw [runBounded, ReaderT.run_bind]
+      change EStateM.bind
+        (ReaderT.run (whnfCoreWithFlagsStep _ _) _) _ _ = _
+      unfold EStateM.bind
+      rw [hstep]
+      exact ih
+
+/-- The first state in a trace satisfies the same fixed K1 invariant carried
+by every later state. -/
+theorem initialInv {layer : WhnfLayer} {semantics : CacheSemantics}
+    {trProj : RawProjRel} {world : VerifyWorld} {support : RunSupport}
+    {uvars : Nat} {Δ : KVLCtx} {methods : Methods .anon}
+    {flags : WhnfFlags} {fuel : Nat} {source result : KExpr .anon}
+    {s s' : TcState .anon}
+    (h : WhnfCoreTrace layer semantics trProj world support uvars Δ methods
+      flags fuel source s result s') :
+    WhnfStateInv layer semantics trProj world support uvars Δ s := by
+  cases h <;> assumption
+
+/-- The last state in a trace still satisfies the fixed K1 invariant. -/
+theorem finalInv {layer : WhnfLayer} {semantics : CacheSemantics}
+    {trProj : RawProjRel} {world : VerifyWorld} {support : RunSupport}
+    {uvars : Nat} {Δ : KVLCtx} {methods : Methods .anon}
+    {flags : WhnfFlags} {fuel : Nat} {source result : KExpr .anon}
+    {s s' : TcState .anon}
+    (h : WhnfCoreTrace layer semantics trProj world support uvars Δ methods
+      flags fuel source s result s') :
+    WhnfStateInv layer semantics trProj world support uvars Δ s' := by
+  induction h with
+  | done hI hstep hI' hmeaning => exact hI'
+  | next hI hstep hI' hmeaning htail ih => exact ih
+
+/-- Compose every local reduction meaning in a trace.  Translation
+uniqueness at an intermediate concrete term is discharged by
+`WhnfTheory.transMeaning`; no syntactic address equality is assumed. -/
+theorem meaning {layer : WhnfLayer} {semantics : CacheSemantics}
+    {trProj : RawProjRel} {world : VerifyWorld} {support : RunSupport}
+    {uvars : Nat} {Δ : KVLCtx} {methods : Methods .anon}
+    {flags : WhnfFlags} {fuel : Nat} {source result : KExpr .anon}
+    {s s' : TcState .anon}
+    (theory : WhnfTheory trProj world uvars)
+    (h : WhnfCoreTrace layer semantics trProj world support uvars Δ methods
+      flags fuel source s result s') :
+    WhnfMeaning trProj world uvars Δ source result := by
+  induction h with
+  | done hI hstep hI' hmeaning => exact hmeaning
+  | next hI hstep hI' hmeaning htail ih =>
+      exact theory.transMeaning hI.2.1.wf hmeaning ih
+
+/-- Specialize trace execution to the actual 10,000-fuel uncached driver. -/
+theorem uncached_eval {layer : WhnfLayer} {semantics : CacheSemantics}
+    {trProj : RawProjRel} {world : VerifyWorld} {support : RunSupport}
+    {uvars : Nat} {Δ : KVLCtx} {methods : Methods .anon}
+    {flags : WhnfFlags} {source result : KExpr .anon}
+    {s s' : TcState .anon}
+    (h : WhnfCoreTrace layer semantics trProj world support uvars Δ methods
+      flags maxWhnfFuel.toNat source s result s') :
+    (whnfCoreWithFlagsUncached source flags).run methods s = .ok result s' := by
+  unfold whnfCoreWithFlagsUncached
+  exact h.eval
+
+/-- K1 structural-loop acceptance package: exact production execution,
+initial/final fixed-world invariants, and the transitively composed Theory
+meaning. -/
+theorem uncached_acceptance {layer : WhnfLayer}
+    {semantics : CacheSemantics} {trProj : RawProjRel}
+    {world : VerifyWorld} {support : RunSupport} {uvars : Nat}
+    {Δ : KVLCtx} {methods : Methods .anon} {flags : WhnfFlags}
+    {source result : KExpr .anon} {s s' : TcState .anon}
+    (theory : WhnfTheory trProj world uvars)
+    (h : WhnfCoreTrace layer semantics trProj world support uvars Δ methods
+      flags maxWhnfFuel.toNat source s result s') :
+    (whnfCoreWithFlagsUncached source flags).run methods s = .ok result s' ∧
+      WhnfStateInv layer semantics trProj world support uvars Δ s ∧
+      WhnfStateInv layer semantics trProj world support uvars Δ s' ∧
+      WhnfMeaning trProj world uvars Δ source result :=
+  ⟨h.uncached_eval, h.initialInv, h.finalInv, h.meaning theory⟩
+
+end WhnfCoreTrace
+
+/-! ## Outer structural-WHNF cache composition -/
+
+/-- Forms that pass the syntactic leaf/legacy-variable prefix and enter the
+keyed structural-WHNF body without consulting `isLetVar`. -/
+inductive WhnfCoreNonLeaf : KExpr .anon → Prop
+  | fvar {id name info} : WhnfCoreNonLeaf (.fvar id name info)
+  | app {f a info} : WhnfCoreNonLeaf (.app f a info)
+  | letE {name ty value body nondep info} :
+      WhnfCoreNonLeaf (.letE name ty value body nondep info)
+  | prj {id field value info} : WhnfCoreNonLeaf (.prj id field value info)
+
+namespace WhnfCoreNonLeaf
+
+/-- Exact bridge from the public structural entry point to its keyed body. -/
+theorem enter {e : KExpr .anon} (h : WhnfCoreNonLeaf e)
+    (flags : WhnfFlags) :
+    whnfCoreWithFlags e flags = whnfCoreWithFlagsNonLeaf e flags := by
+  cases h <;> rfl
+
+end WhnfCoreNonLeaf
+
+/-- A legacy variable that is not backed by a let frame returns before key
+computation, exactly like the syntactic leaf forms. -/
+theorem whnfCoreWithFlags_varNotLet
+    {methods : Methods .anon} {s s' : TcState .anon}
+    {idx : UInt64} {name : Mode.anon.F Name} {info : ExprInfo .anon}
+    {flags : WhnfFlags}
+    (hlet : TcM.isLetVar idx s = .ok false s') :
+    (whnfCoreWithFlags (.var idx name info) flags).run methods s =
+      .ok (.var idx name info) s' := by
+  unfold whnfCoreWithFlags
+  rw [ReaderT.run_bind]
+  change EStateM.bind (TcM.isLetVar idx) _ s = _
+  unfold EStateM.bind
+  rw [hlet]
+  rfl
+
+/-- A let-backed legacy variable crosses the public prefix and enters the
+same keyed cache body as every direct non-leaf form. -/
+theorem whnfCoreWithFlags_varEnter
+    {methods : Methods .anon} {s s' : TcState .anon}
+    {idx : UInt64} {name : Mode.anon.F Name} {info : ExprInfo .anon}
+    {flags : WhnfFlags}
+    (hlet : TcM.isLetVar idx s = .ok true s') :
+    (whnfCoreWithFlags (.var idx name info) flags).run methods s =
+      (whnfCoreWithFlagsNonLeaf (.var idx name info) flags).run methods s' := by
+  unfold whnfCoreWithFlags
+  rw [ReaderT.run_bind]
+  change EStateM.bind (TcM.isLetVar idx) _ s = _
+  unfold EStateM.bind
+  rw [hlet]
+  rfl
+
+/-- Execution-indexed evidence that the public structural entry point reaches
+its keyed body.  Direct non-leaves preserve the state; a legacy variable may
+first execute `isLetVar`. -/
+inductive WhnfCoreKeyedEntry (methods : Methods .anon) (flags : WhnfFlags) :
+    KExpr .anon → TcState .anon → TcState .anon → Prop
+  | direct {source s} (h : WhnfCoreNonLeaf source) :
+      WhnfCoreKeyedEntry methods flags source s s
+  | varLet {idx name info s s'}
+      (hlet : TcM.isLetVar idx s = .ok true s') :
+      WhnfCoreKeyedEntry methods flags (.var idx name info) s s'
+
+namespace WhnfCoreKeyedEntry
+
+theorem eval {methods : Methods .anon} {flags : WhnfFlags}
+    {source : KExpr .anon} {s s' : TcState .anon}
+    (h : WhnfCoreKeyedEntry methods flags source s s') :
+    (whnfCoreWithFlags source flags).run methods s =
+      (whnfCoreWithFlagsNonLeaf source flags).run methods s' := by
+  cases h with
+  | direct h => rw [h.enter]
+  | varLet hlet => exact whnfCoreWithFlags_varEnter hlet
+
+end WhnfCoreKeyedEntry
+
+/-- Exact full-policy cache-hit execution after key and transient checks. -/
+theorem whnfCoreWithFlagsNonLeaf_fullHit
+    {methods : Methods .anon} {s s₁ s₂ : TcState .anon}
+    {source cached : KExpr .anon} {flags : WhnfFlags}
+    {key : Address × Address}
+    (hfull : flags.isFull = true)
+    (hkey : TcM.whnfKey source s = .ok key s₁)
+    (htransient : (isTransientNatLiteralWork source).run methods s₁ =
+      .ok false s₂)
+    (hhit : s₂.env.whnfCoreCache[key]? = some cached) :
+    (whnfCoreWithFlagsNonLeaf source flags).run methods s =
+      .ok cached s₂ := by
+  unfold whnfCoreWithFlagsNonLeaf
+  rw [ReaderT.run_bind]
+  change EStateM.bind (TcM.whnfKey source) _ s = _
+  unfold EStateM.bind
+  rw [hkey]
+  simp only
+  rw [ReaderT.run_bind]
+  change EStateM.bind ((isTransientNatLiteralWork source).run methods) _ s₁ = _
+  unfold EStateM.bind
+  rw [htransient]
+  simp [hfull]
+  change EStateM.bind (get : TcM .anon (TcState .anon)) _ s₂ = _
+  unfold EStateM.bind
+  rw [show (get : TcM .anon (TcState .anon)) s₂ = .ok s₂ s₂ from rfl]
+  simp only [hhit]
+  rfl
+
+/-- Exact cheap-policy cache-hit execution after key and transient checks. -/
+theorem whnfCoreWithFlagsNonLeaf_cheapHit
+    {methods : Methods .anon} {s s₁ s₂ : TcState .anon}
+    {source cached : KExpr .anon} {flags : WhnfFlags}
+    {key : Address × Address}
+    (hcheap : flags.isFull = false)
+    (hkey : TcM.whnfKey source s = .ok key s₁)
+    (htransient : (isTransientNatLiteralWork source).run methods s₁ =
+      .ok false s₂)
+    (hhit : s₂.env.whnfCoreCheapCache[key]? = some cached) :
+    (whnfCoreWithFlagsNonLeaf source flags).run methods s =
+      .ok cached s₂ := by
+  unfold whnfCoreWithFlagsNonLeaf
+  rw [ReaderT.run_bind]
+  change EStateM.bind (TcM.whnfKey source) _ s = _
+  unfold EStateM.bind
+  rw [hkey]
+  simp only
+  rw [ReaderT.run_bind]
+  change EStateM.bind ((isTransientNatLiteralWork source).run methods) _ s₁ = _
+  unfold EStateM.bind
+  rw [htransient]
+  simp [hcheap]
+  change EStateM.bind (get : TcM .anon (TcState .anon)) _ s₂ = _
+  unfold EStateM.bind
+  rw [show (get : TcM .anon (TcState .anon)) s₂ = .ok s₂ s₂ from rfl]
+  simp only [hhit]
+  rfl
+
+/-- Exact full-policy miss execution, including the physical insertion. -/
+theorem whnfCoreWithFlagsNonLeaf_fullMiss
+    {methods : Methods .anon} {s s₁ s₂ s₃ : TcState .anon}
+    {source result : KExpr .anon} {flags : WhnfFlags}
+    {key : Address × Address}
+    (hfull : flags.isFull = true)
+    (hkey : TcM.whnfKey source s = .ok key s₁)
+    (htransient : (isTransientNatLiteralWork source).run methods s₁ =
+      .ok false s₂)
+    (hmiss : s₂.env.whnfCoreCache[key]? = none)
+    (hrun : (whnfCoreWithFlagsUncached source flags).run methods s₂ =
+      .ok result s₃) :
+    (whnfCoreWithFlagsNonLeaf source flags).run methods s =
+      .ok result {s₃ with env := {s₃.env with
+        whnfCoreCache := s₃.env.whnfCoreCache.insert key result}} := by
+  unfold whnfCoreWithFlagsNonLeaf
+  rw [ReaderT.run_bind]
+  change EStateM.bind (TcM.whnfKey source) _ s = _
+  unfold EStateM.bind
+  rw [hkey]
+  simp only
+  rw [ReaderT.run_bind]
+  change EStateM.bind ((isTransientNatLiteralWork source).run methods) _ s₁ = _
+  unfold EStateM.bind
+  rw [htransient]
+  simp [hfull]
+  change EStateM.bind (get : TcM .anon (TcState .anon)) _ s₂ = _
+  unfold EStateM.bind
+  rw [show (get : TcM .anon (TcState .anon)) s₂ = .ok s₂ s₂ from rfl]
+  simp only [hmiss]
+  rw [ReaderT.run_bind]
+  change EStateM.bind
+    ((whnfCoreWithFlagsUncached source flags).run methods) _ s₂ = _
+  unfold EStateM.bind
+  rw [hrun]
+  rfl
+
+/-- Exact cheap-policy miss execution, including its separate insertion. -/
+theorem whnfCoreWithFlagsNonLeaf_cheapMiss
+    {methods : Methods .anon} {s s₁ s₂ s₃ : TcState .anon}
+    {source result : KExpr .anon} {flags : WhnfFlags}
+    {key : Address × Address}
+    (hcheap : flags.isFull = false)
+    (hkey : TcM.whnfKey source s = .ok key s₁)
+    (htransient : (isTransientNatLiteralWork source).run methods s₁ =
+      .ok false s₂)
+    (hmiss : s₂.env.whnfCoreCheapCache[key]? = none)
+    (hrun : (whnfCoreWithFlagsUncached source flags).run methods s₂ =
+      .ok result s₃) :
+    (whnfCoreWithFlagsNonLeaf source flags).run methods s =
+      .ok result {s₃ with env := {s₃.env with
+        whnfCoreCheapCache := s₃.env.whnfCoreCheapCache.insert key result}} := by
+  unfold whnfCoreWithFlagsNonLeaf
+  rw [ReaderT.run_bind]
+  change EStateM.bind (TcM.whnfKey source) _ s = _
+  unfold EStateM.bind
+  rw [hkey]
+  simp only
+  rw [ReaderT.run_bind]
+  change EStateM.bind ((isTransientNatLiteralWork source).run methods) _ s₁ = _
+  unfold EStateM.bind
+  rw [htransient]
+  simp [hcheap]
+  change EStateM.bind (get : TcM .anon (TcState .anon)) _ s₂ = _
+  unfold EStateM.bind
+  rw [show (get : TcM .anon (TcState .anon)) s₂ = .ok s₂ s₂ from rfl]
+  simp only [hmiss]
+  rw [ReaderT.run_bind]
+  change EStateM.bind
+    ((whnfCoreWithFlagsUncached source flags).run methods) _ s₂ = _
+  unfold EStateM.bind
+  rw [hrun]
+  rfl
+
+/-- Transient Nat work bypasses both cache reads and cache writes under
+either flag policy. -/
+theorem whnfCoreWithFlagsNonLeaf_transient
+    {methods : Methods .anon} {s s₁ s₂ s₃ : TcState .anon}
+    {source result : KExpr .anon} {flags : WhnfFlags}
+    {key : Address × Address}
+    (hkey : TcM.whnfKey source s = .ok key s₁)
+    (htransient : (isTransientNatLiteralWork source).run methods s₁ =
+      .ok true s₂)
+    (hrun : (whnfCoreWithFlagsUncached source flags).run methods s₂ =
+      .ok result s₃) :
+    (whnfCoreWithFlagsNonLeaf source flags).run methods s =
+      .ok result s₃ := by
+  unfold whnfCoreWithFlagsNonLeaf
+  rw [ReaderT.run_bind]
+  change EStateM.bind (TcM.whnfKey source) _ s = _
+  unfold EStateM.bind
+  rw [hkey]
+  simp only
+  rw [ReaderT.run_bind]
+  change EStateM.bind ((isTransientNatLiteralWork source).run methods) _ s₁ = _
+  unfold EStateM.bind
+  rw [htransient]
+  cases flags.isFull <;> simp [hrun]
+
+namespace WhnfCoreCacheUpdate
+
+/-- Inserting one provenance-certified full-core result preserves the entire
+fixed-world WHNF state invariant. -/
+theorem full_whnfStateInv
+    {layer : WhnfLayer} {semantics : CacheSemantics}
+    {trProj : RawProjRel} {world : VerifyWorld} {support : RunSupport}
+    {uvars : Nat} {Δ : KVLCtx} {s : TcState .anon}
+    {key : Address × Address} {result : KExpr .anon}
+    (hI : WhnfStateInv layer semantics trProj world support uvars Δ s)
+    (hnew : CacheProvenance semantics (CacheAuthority.stable world) support
+      (.expr .whnfCore key result)) :
+    WhnfStateInv layer semantics trProj world support uvars Δ
+      {s with env := {s.env with
+        whnfCoreCache := s.env.whnfCoreCache.insert key result}} := by
+  rcases hI with ⟨hkernel, hctx, hlayer⟩
+  refine ⟨?_, ?_, ?_⟩
+  · refine ⟨?_, ?_, ?_⟩
+    · exact hkernel.core.of_consts_eq rfl (by
+        simpa using hkernel.core.intern)
+    · simpa using hkernel.internSupport
+    · exact hkernel.caches.insertWhnfCore hnew
+  · exact hctx.of_fields_eq rfl rfl rfl rfl (by simp)
+  · cases layer with
+    | noAccel => simpa [WhnfLayer.StateOK] using hlayer
+    | accelerated => trivial
+
+/-- Inserting one provenance-certified cheap-core result preserves the full
+invariant without changing the full-policy partition. -/
+theorem cheap_whnfStateInv
+    {layer : WhnfLayer} {semantics : CacheSemantics}
+    {trProj : RawProjRel} {world : VerifyWorld} {support : RunSupport}
+    {uvars : Nat} {Δ : KVLCtx} {s : TcState .anon}
+    {key : Address × Address} {result : KExpr .anon}
+    (hI : WhnfStateInv layer semantics trProj world support uvars Δ s)
+    (hnew : CacheProvenance semantics (CacheAuthority.stable world) support
+      (.expr .whnfCoreCheap key result)) :
+    WhnfStateInv layer semantics trProj world support uvars Δ
+      {s with env := {s.env with
+        whnfCoreCheapCache := s.env.whnfCoreCheapCache.insert key result}} := by
+  rcases hI with ⟨hkernel, hctx, hlayer⟩
+  refine ⟨?_, ?_, ?_⟩
+  · refine ⟨?_, ?_, ?_⟩
+    · exact hkernel.core.of_consts_eq rfl (by
+        simpa using hkernel.core.intern)
+    · simpa using hkernel.internSupport
+    · exact hkernel.caches.insertWhnfCoreCheap hnew
+  · exact hctx.of_fields_eq rfl rfl rfl rfl (by simp)
+  · cases layer with
+    | noAccel => simpa [WhnfLayer.StateOK] using hlayer
+    | accelerated => trivial
+
+end WhnfCoreCacheUpdate
+
+/-- A physical full-core hit is accepted only with both a semantic cache
+invariant and an executed/context-reconciled key match. -/
+theorem whnfCoreWithFlags_fullHit_acceptance
+    {keys : WhnfContextKeys} {fallback : CacheSemantics}
+    {layer : WhnfLayer} {trProj : RawProjRel} {world : VerifyWorld}
+    {support : RunSupport} {Δ : KVLCtx} {methods : Methods .anon}
+    {flags : WhnfFlags} {source cached : KExpr .anon}
+    {key : Address × Address} {s s₀ s₁ s₂ : TcState .anon}
+    (hentry : WhnfCoreKeyedEntry methods flags source s s₀)
+    (hfull : flags.isFull = true)
+    (hkey : TcM.whnfKey source s₀ = .ok key s₁)
+    (htransient : (isTransientNatLiteralWork source).run methods s₁ =
+      .ok false s₂)
+    (hhit : s₂.env.whnfCoreCache[key]? = some cached)
+    (hI : WhnfStateInv layer (whnfCacheSemantics keys trProj fallback)
+      trProj world support keys.uvars Δ s₂)
+    (hsource : support source)
+    (hmatch : keys.Matches trProj world s₂ Δ source key) :
+    (whnfCoreWithFlags source flags).run methods s = .ok cached s₂ ∧
+      WhnfStateInv layer (whnfCacheSemantics keys trProj fallback)
+        trProj world support keys.uvars Δ s₂ ∧
+      WhnfMeaning trProj world keys.uvars Δ source cached := by
+  refine ⟨?_, hI, ?_⟩
+  · rw [hentry.eval]
+    exact whnfCoreWithFlagsNonLeaf_fullHit hfull hkey htransient hhit
+  · exact hI.1.caches.whnfHitOfMatches (.whnfCore hhit)
+      .whnfCore hsource hmatch
+
+/-- Cheap-core hits are read only from the cheap partition and carry the
+same semantic consequence as full-core hits. -/
+theorem whnfCoreWithFlags_cheapHit_acceptance
+    {keys : WhnfContextKeys} {fallback : CacheSemantics}
+    {layer : WhnfLayer} {trProj : RawProjRel} {world : VerifyWorld}
+    {support : RunSupport} {Δ : KVLCtx} {methods : Methods .anon}
+    {flags : WhnfFlags} {source cached : KExpr .anon}
+    {key : Address × Address} {s s₀ s₁ s₂ : TcState .anon}
+    (hentry : WhnfCoreKeyedEntry methods flags source s s₀)
+    (hcheap : flags.isFull = false)
+    (hkey : TcM.whnfKey source s₀ = .ok key s₁)
+    (htransient : (isTransientNatLiteralWork source).run methods s₁ =
+      .ok false s₂)
+    (hhit : s₂.env.whnfCoreCheapCache[key]? = some cached)
+    (hI : WhnfStateInv layer (whnfCacheSemantics keys trProj fallback)
+      trProj world support keys.uvars Δ s₂)
+    (hsource : support source)
+    (hmatch : keys.Matches trProj world s₂ Δ source key) :
+    (whnfCoreWithFlags source flags).run methods s = .ok cached s₂ ∧
+      WhnfStateInv layer (whnfCacheSemantics keys trProj fallback)
+        trProj world support keys.uvars Δ s₂ ∧
+      WhnfMeaning trProj world keys.uvars Δ source cached := by
+  refine ⟨?_, hI, ?_⟩
+  · rw [hentry.eval]
+    exact whnfCoreWithFlagsNonLeaf_cheapHit hcheap hkey htransient hhit
+  · exact hI.1.caches.whnfHitOfMatches (.whnfCoreCheap hhit)
+      .whnfCoreCheap hsource hmatch
+
+/-- A full-core miss may populate the cache only after the uncached trace
+certifies this execution and the new entry has universal cache provenance. -/
+theorem whnfCoreWithFlags_fullMiss_acceptance
+    {keys : WhnfContextKeys} {fallback : CacheSemantics}
+    {layer : WhnfLayer} {trProj : RawProjRel} {world : VerifyWorld}
+    {support : RunSupport} {Δ : KVLCtx} {methods : Methods .anon}
+    {flags : WhnfFlags} {source result : KExpr .anon}
+    {key : Address × Address} {s s₀ s₁ s₂ s₃ : TcState .anon}
+    (theory : WhnfTheory trProj world keys.uvars)
+    (hentry : WhnfCoreKeyedEntry methods flags source s s₀)
+    (hfull : flags.isFull = true)
+    (hkey : TcM.whnfKey source s₀ = .ok key s₁)
+    (htransient : (isTransientNatLiteralWork source).run methods s₁ =
+      .ok false s₂)
+    (hmiss : s₂.env.whnfCoreCache[key]? = none)
+    (htrace : WhnfCoreTrace layer (whnfCacheSemantics keys trProj fallback)
+      trProj world support keys.uvars Δ methods flags maxWhnfFuel.toNat
+      source s₂ result s₃)
+    (hnew : CacheProvenance (whnfCacheSemantics keys trProj fallback)
+      (CacheAuthority.stable world) support (.expr .whnfCore key result)) :
+    let s₄ := {s₃ with env := {s₃.env with
+      whnfCoreCache := s₃.env.whnfCoreCache.insert key result}}
+    (whnfCoreWithFlags source flags).run methods s = .ok result s₄ ∧
+      WhnfStateInv layer (whnfCacheSemantics keys trProj fallback)
+        trProj world support keys.uvars Δ s₂ ∧
+      WhnfStateInv layer (whnfCacheSemantics keys trProj fallback)
+        trProj world support keys.uvars Δ s₄ ∧
+      WhnfMeaning trProj world keys.uvars Δ source result := by
+  dsimp only
+  refine ⟨?_, htrace.initialInv, ?_, htrace.meaning theory⟩
+  · rw [hentry.eval]
+    exact whnfCoreWithFlagsNonLeaf_fullMiss hfull hkey htransient hmiss
+      htrace.uncached_eval
+  · exact WhnfCoreCacheUpdate.full_whnfStateInv htrace.finalInv hnew
+
+/-- Cheap misses insert only into the cheap partition; as for full misses,
+raw uncached success is insufficient without a trace and entry provenance. -/
+theorem whnfCoreWithFlags_cheapMiss_acceptance
+    {keys : WhnfContextKeys} {fallback : CacheSemantics}
+    {layer : WhnfLayer} {trProj : RawProjRel} {world : VerifyWorld}
+    {support : RunSupport} {Δ : KVLCtx} {methods : Methods .anon}
+    {flags : WhnfFlags} {source result : KExpr .anon}
+    {key : Address × Address} {s s₀ s₁ s₂ s₃ : TcState .anon}
+    (theory : WhnfTheory trProj world keys.uvars)
+    (hentry : WhnfCoreKeyedEntry methods flags source s s₀)
+    (hcheap : flags.isFull = false)
+    (hkey : TcM.whnfKey source s₀ = .ok key s₁)
+    (htransient : (isTransientNatLiteralWork source).run methods s₁ =
+      .ok false s₂)
+    (hmiss : s₂.env.whnfCoreCheapCache[key]? = none)
+    (htrace : WhnfCoreTrace layer (whnfCacheSemantics keys trProj fallback)
+      trProj world support keys.uvars Δ methods flags maxWhnfFuel.toNat
+      source s₂ result s₃)
+    (hnew : CacheProvenance (whnfCacheSemantics keys trProj fallback)
+      (CacheAuthority.stable world) support
+      (.expr .whnfCoreCheap key result)) :
+    let s₄ := {s₃ with env := {s₃.env with
+      whnfCoreCheapCache := s₃.env.whnfCoreCheapCache.insert key result}}
+    (whnfCoreWithFlags source flags).run methods s = .ok result s₄ ∧
+      WhnfStateInv layer (whnfCacheSemantics keys trProj fallback)
+        trProj world support keys.uvars Δ s₂ ∧
+      WhnfStateInv layer (whnfCacheSemantics keys trProj fallback)
+        trProj world support keys.uvars Δ s₄ ∧
+      WhnfMeaning trProj world keys.uvars Δ source result := by
+  dsimp only
+  refine ⟨?_, htrace.initialInv, ?_, htrace.meaning theory⟩
+  · rw [hentry.eval]
+    exact whnfCoreWithFlagsNonLeaf_cheapMiss hcheap hkey htransient hmiss
+      htrace.uncached_eval
+  · exact WhnfCoreCacheUpdate.cheap_whnfStateInv htrace.finalInv hnew
+
+/-- Transient Nat-literal work executes the certified uncached path without
+reading or writing either core cache. -/
+theorem whnfCoreWithFlags_transient_acceptance
+    {keys : WhnfContextKeys} {fallback : CacheSemantics}
+    {layer : WhnfLayer} {trProj : RawProjRel} {world : VerifyWorld}
+    {support : RunSupport} {Δ : KVLCtx} {methods : Methods .anon}
+    {flags : WhnfFlags} {source result : KExpr .anon}
+    {key : Address × Address} {s s₀ s₁ s₂ s₃ : TcState .anon}
+    (theory : WhnfTheory trProj world keys.uvars)
+    (hentry : WhnfCoreKeyedEntry methods flags source s s₀)
+    (hkey : TcM.whnfKey source s₀ = .ok key s₁)
+    (htransient : (isTransientNatLiteralWork source).run methods s₁ =
+      .ok true s₂)
+    (htrace : WhnfCoreTrace layer (whnfCacheSemantics keys trProj fallback)
+      trProj world support keys.uvars Δ methods flags maxWhnfFuel.toNat
+      source s₂ result s₃) :
+    (whnfCoreWithFlags source flags).run methods s = .ok result s₃ ∧
+      WhnfStateInv layer (whnfCacheSemantics keys trProj fallback)
+        trProj world support keys.uvars Δ s₂ ∧
+      WhnfStateInv layer (whnfCacheSemantics keys trProj fallback)
+        trProj world support keys.uvars Δ s₃ ∧
+      WhnfMeaning trProj world keys.uvars Δ source result := by
+  refine ⟨?_, htrace.initialInv, htrace.finalInv, htrace.meaning theory⟩
+  rw [hentry.eval]
+  exact whnfCoreWithFlagsNonLeaf_transient hkey htransient
+    htrace.uncached_eval
+
+/-! ## No-delta and full-WHNF driver composition -/
+
+/-- Execution-indexed semantic certificate for the production no-delta
+WHNF loop.  Each constructor records the exact named step equation, the
+fixed K1 invariant on both sides, and the local Theory meaning. -/
+inductive WhnfNoDeltaTrace (layer : WhnfLayer)
+    (semantics : CacheSemantics) (trProj : RawProjRel)
+    (world : VerifyWorld) (support : RunSupport) (uvars : Nat)
+    (Δ : KVLCtx) (methods : Methods .anon) (flags : WhnfFlags)
+    (natSuccMode : NatSuccMode) :
+    Nat → KExpr .anon → TcState .anon → KExpr .anon → TcState .anon → Prop
+  | done {fuel : Nat} {cur result : KExpr .anon} {s s' : TcState .anon} :
+      WhnfStateInv layer semantics trProj world support uvars Δ s →
+      (whnfNoDeltaImplStep flags natSuccMode cur).run methods s =
+        .ok (.done result) s' →
+      WhnfStateInv layer semantics trProj world support uvars Δ s' →
+      WhnfMeaning trProj world uvars Δ cur result →
+      WhnfNoDeltaTrace layer semantics trProj world support uvars Δ methods
+        flags natSuccMode (fuel + 1) cur s result s'
+  | next {fuel : Nat} {cur middle result : KExpr .anon}
+      {s s' s'' : TcState .anon} :
+      WhnfStateInv layer semantics trProj world support uvars Δ s →
+      (whnfNoDeltaImplStep flags natSuccMode cur).run methods s =
+        .ok (.next middle) s' →
+      WhnfStateInv layer semantics trProj world support uvars Δ s' →
+      WhnfMeaning trProj world uvars Δ cur middle →
+      WhnfNoDeltaTrace layer semantics trProj world support uvars Δ methods
+        flags natSuccMode fuel middle s' result s'' →
+      WhnfNoDeltaTrace layer semantics trProj world support uvars Δ methods
+        flags natSuccMode (fuel + 1) cur s result s''
+
+namespace WhnfNoDeltaTrace
+
+theorem no_zero {layer : WhnfLayer} {semantics : CacheSemantics}
+    {trProj : RawProjRel} {world : VerifyWorld} {support : RunSupport}
+    {uvars : Nat} {Δ : KVLCtx} {methods : Methods .anon}
+    {flags : WhnfFlags} {natSuccMode : NatSuccMode}
+    {source result : KExpr .anon} {s s' : TcState .anon} :
+    ¬WhnfNoDeltaTrace layer semantics trProj world support uvars Δ methods
+      flags natSuccMode 0 source s result s' := by
+  intro h
+  cases h
+
+theorem eval {layer : WhnfLayer} {semantics : CacheSemantics}
+    {trProj : RawProjRel} {world : VerifyWorld} {support : RunSupport}
+    {uvars : Nat} {Δ : KVLCtx} {methods : Methods .anon}
+    {flags : WhnfFlags} {natSuccMode : NatSuccMode} {fuel : Nat}
+    {source result : KExpr .anon} {s s' : TcState .anon}
+    (h : WhnfNoDeltaTrace layer semantics trProj world support uvars Δ
+      methods flags natSuccMode fuel source s result s') :
+    (runBounded (whnfNoDeltaImplStep flags natSuccMode) fuel source).run
+      methods s = .ok result s' := by
+  induction h with
+  | done hI hstep hI' hmeaning =>
+      rw [runBounded, ReaderT.run_bind]
+      change EStateM.bind
+        (ReaderT.run (whnfNoDeltaImplStep _ _ _) _) _ _ = _
+      unfold EStateM.bind
+      rw [hstep]
+      rfl
+  | next hI hstep hI' hmeaning htail ih =>
+      rw [runBounded, ReaderT.run_bind]
+      change EStateM.bind
+        (ReaderT.run (whnfNoDeltaImplStep _ _ _) _) _ _ = _
+      unfold EStateM.bind
+      rw [hstep]
+      exact ih
+
+theorem initialInv {layer : WhnfLayer} {semantics : CacheSemantics}
+    {trProj : RawProjRel} {world : VerifyWorld} {support : RunSupport}
+    {uvars : Nat} {Δ : KVLCtx} {methods : Methods .anon}
+    {flags : WhnfFlags} {natSuccMode : NatSuccMode} {fuel : Nat}
+    {source result : KExpr .anon} {s s' : TcState .anon}
+    (h : WhnfNoDeltaTrace layer semantics trProj world support uvars Δ
+      methods flags natSuccMode fuel source s result s') :
+    WhnfStateInv layer semantics trProj world support uvars Δ s := by
+  cases h <;> assumption
+
+theorem finalInv {layer : WhnfLayer} {semantics : CacheSemantics}
+    {trProj : RawProjRel} {world : VerifyWorld} {support : RunSupport}
+    {uvars : Nat} {Δ : KVLCtx} {methods : Methods .anon}
+    {flags : WhnfFlags} {natSuccMode : NatSuccMode} {fuel : Nat}
+    {source result : KExpr .anon} {s s' : TcState .anon}
+    (h : WhnfNoDeltaTrace layer semantics trProj world support uvars Δ
+      methods flags natSuccMode fuel source s result s') :
+    WhnfStateInv layer semantics trProj world support uvars Δ s' := by
+  induction h with
+  | done hI hstep hI' hmeaning => exact hI'
+  | next hI hstep hI' hmeaning htail ih => exact ih
+
+theorem meaning {layer : WhnfLayer} {semantics : CacheSemantics}
+    {trProj : RawProjRel} {world : VerifyWorld} {support : RunSupport}
+    {uvars : Nat} {Δ : KVLCtx} {methods : Methods .anon}
+    {flags : WhnfFlags} {natSuccMode : NatSuccMode} {fuel : Nat}
+    {source result : KExpr .anon} {s s' : TcState .anon}
+    (theory : WhnfTheory trProj world uvars)
+    (h : WhnfNoDeltaTrace layer semantics trProj world support uvars Δ
+      methods flags natSuccMode fuel source s result s') :
+    WhnfMeaning trProj world uvars Δ source result := by
+  induction h with
+  | done hI hstep hI' hmeaning => exact hmeaning
+  | next hI hstep hI' hmeaning htail ih =>
+      exact theory.transMeaning hI.2.1.wf hmeaning ih
+
+theorem uncached_eval {layer : WhnfLayer} {semantics : CacheSemantics}
+    {trProj : RawProjRel} {world : VerifyWorld} {support : RunSupport}
+    {uvars : Nat} {Δ : KVLCtx} {methods : Methods .anon}
+    {flags : WhnfFlags} {natSuccMode : NatSuccMode}
+    {source result : KExpr .anon} {s s' : TcState .anon}
+    (h : WhnfNoDeltaTrace layer semantics trProj world support uvars Δ
+      methods flags natSuccMode maxWhnfFuel.toNat source s result s') :
+    (whnfNoDeltaImplUncached source flags natSuccMode).run methods s =
+      .ok result s' := by
+  unfold whnfNoDeltaImplUncached
+  exact h.eval
+
+theorem uncached_acceptance {layer : WhnfLayer}
+    {semantics : CacheSemantics} {trProj : RawProjRel}
+    {world : VerifyWorld} {support : RunSupport} {uvars : Nat}
+    {Δ : KVLCtx} {methods : Methods .anon} {flags : WhnfFlags}
+    {natSuccMode : NatSuccMode} {source result : KExpr .anon}
+    {s s' : TcState .anon} (theory : WhnfTheory trProj world uvars)
+    (h : WhnfNoDeltaTrace layer semantics trProj world support uvars Δ
+      methods flags natSuccMode maxWhnfFuel.toNat source s result s') :
+    (whnfNoDeltaImplUncached source flags natSuccMode).run methods s =
+        .ok result s' ∧
+      WhnfStateInv layer semantics trProj world support uvars Δ s ∧
+      WhnfStateInv layer semantics trProj world support uvars Δ s' ∧
+      WhnfMeaning trProj world uvars Δ source result :=
+  ⟨h.uncached_eval, h.initialInv, h.finalInv, h.meaning theory⟩
+
+end WhnfNoDeltaTrace
+
+/-- Execution-indexed semantic certificate for the production full-WHNF
+loop.  The loop state also records its cycle-detection set; semantic meaning
+is attached only to the expression component. -/
+inductive WhnfFullTrace (layer : WhnfLayer) (semantics : CacheSemantics)
+    (trProj : RawProjRel) (world : VerifyWorld) (support : RunSupport)
+    (uvars : Nat) (Δ : KVLCtx) (methods : Methods .anon)
+    (natSuccMode : NatSuccMode) :
+    Nat → (KExpr .anon × HashSet Address) → TcState .anon →
+      KExpr .anon → TcState .anon → Prop
+  | done {fuel : Nat} {cur : KExpr .anon × HashSet Address}
+      {result : KExpr .anon} {s s' : TcState .anon} :
+      WhnfStateInv layer semantics trProj world support uvars Δ s →
+      (whnfWithNatSuccModeStep natSuccMode cur).run methods s =
+        .ok (.done result) s' →
+      WhnfStateInv layer semantics trProj world support uvars Δ s' →
+      WhnfMeaning trProj world uvars Δ cur.1 result →
+      WhnfFullTrace layer semantics trProj world support uvars Δ methods
+        natSuccMode (fuel + 1) cur s result s'
+  | next {fuel : Nat} {cur middle : KExpr .anon × HashSet Address}
+      {result : KExpr .anon} {s s' s'' : TcState .anon} :
+      WhnfStateInv layer semantics trProj world support uvars Δ s →
+      (whnfWithNatSuccModeStep natSuccMode cur).run methods s =
+        .ok (.next middle) s' →
+      WhnfStateInv layer semantics trProj world support uvars Δ s' →
+      WhnfMeaning trProj world uvars Δ cur.1 middle.1 →
+      WhnfFullTrace layer semantics trProj world support uvars Δ methods
+        natSuccMode fuel middle s' result s'' →
+      WhnfFullTrace layer semantics trProj world support uvars Δ methods
+        natSuccMode (fuel + 1) cur s result s''
+
+namespace WhnfFullTrace
+
+theorem no_zero {layer : WhnfLayer} {semantics : CacheSemantics}
+    {trProj : RawProjRel} {world : VerifyWorld} {support : RunSupport}
+    {uvars : Nat} {Δ : KVLCtx} {methods : Methods .anon}
+    {natSuccMode : NatSuccMode} {source : KExpr .anon × HashSet Address}
+    {result : KExpr .anon} {s s' : TcState .anon} :
+    ¬WhnfFullTrace layer semantics trProj world support uvars Δ methods
+      natSuccMode 0 source s result s' := by
+  intro h
+  cases h
+
+theorem eval {layer : WhnfLayer} {semantics : CacheSemantics}
+    {trProj : RawProjRel} {world : VerifyWorld} {support : RunSupport}
+    {uvars : Nat} {Δ : KVLCtx} {methods : Methods .anon}
+    {natSuccMode : NatSuccMode} {fuel : Nat}
+    {source : KExpr .anon × HashSet Address} {result : KExpr .anon}
+    {s s' : TcState .anon}
+    (h : WhnfFullTrace layer semantics trProj world support uvars Δ methods
+      natSuccMode fuel source s result s') :
+    (runBounded (whnfWithNatSuccModeStep natSuccMode) fuel source).run
+      methods s = .ok result s' := by
+  induction h with
+  | done hI hstep hI' hmeaning =>
+      rw [runBounded, ReaderT.run_bind]
+      change EStateM.bind
+        (ReaderT.run (whnfWithNatSuccModeStep _ _) _) _ _ = _
+      unfold EStateM.bind
+      rw [hstep]
+      rfl
+  | next hI hstep hI' hmeaning htail ih =>
+      rw [runBounded, ReaderT.run_bind]
+      change EStateM.bind
+        (ReaderT.run (whnfWithNatSuccModeStep _ _) _) _ _ = _
+      unfold EStateM.bind
+      rw [hstep]
+      exact ih
+
+theorem initialInv {layer : WhnfLayer} {semantics : CacheSemantics}
+    {trProj : RawProjRel} {world : VerifyWorld} {support : RunSupport}
+    {uvars : Nat} {Δ : KVLCtx} {methods : Methods .anon}
+    {natSuccMode : NatSuccMode} {fuel : Nat}
+    {source : KExpr .anon × HashSet Address} {result : KExpr .anon}
+    {s s' : TcState .anon}
+    (h : WhnfFullTrace layer semantics trProj world support uvars Δ methods
+      natSuccMode fuel source s result s') :
+    WhnfStateInv layer semantics trProj world support uvars Δ s := by
+  cases h <;> assumption
+
+theorem finalInv {layer : WhnfLayer} {semantics : CacheSemantics}
+    {trProj : RawProjRel} {world : VerifyWorld} {support : RunSupport}
+    {uvars : Nat} {Δ : KVLCtx} {methods : Methods .anon}
+    {natSuccMode : NatSuccMode} {fuel : Nat}
+    {source : KExpr .anon × HashSet Address} {result : KExpr .anon}
+    {s s' : TcState .anon}
+    (h : WhnfFullTrace layer semantics trProj world support uvars Δ methods
+      natSuccMode fuel source s result s') :
+    WhnfStateInv layer semantics trProj world support uvars Δ s' := by
+  induction h with
+  | done hI hstep hI' hmeaning => exact hI'
+  | next hI hstep hI' hmeaning htail ih => exact ih
+
+theorem meaning {layer : WhnfLayer} {semantics : CacheSemantics}
+    {trProj : RawProjRel} {world : VerifyWorld} {support : RunSupport}
+    {uvars : Nat} {Δ : KVLCtx} {methods : Methods .anon}
+    {natSuccMode : NatSuccMode} {fuel : Nat}
+    {source : KExpr .anon × HashSet Address} {result : KExpr .anon}
+    {s s' : TcState .anon} (theory : WhnfTheory trProj world uvars)
+    (h : WhnfFullTrace layer semantics trProj world support uvars Δ methods
+      natSuccMode fuel source s result s') :
+    WhnfMeaning trProj world uvars Δ source.1 result := by
+  induction h with
+  | done hI hstep hI' hmeaning => exact hmeaning
+  | next hI hstep hI' hmeaning htail ih =>
+      exact theory.transMeaning hI.2.1.wf hmeaning ih
+
+theorem uncached_eval {layer : WhnfLayer} {semantics : CacheSemantics}
+    {trProj : RawProjRel} {world : VerifyWorld} {support : RunSupport}
+    {uvars : Nat} {Δ : KVLCtx} {methods : Methods .anon}
+    {natSuccMode : NatSuccMode} {source result : KExpr .anon}
+    {s s' : TcState .anon}
+    (h : WhnfFullTrace layer semantics trProj world support uvars Δ methods
+      natSuccMode maxWhnfFuel.toNat (source, {}) s result s') :
+    (whnfWithNatSuccModeUncached source natSuccMode).run methods s =
+      .ok result s' := by
+  unfold whnfWithNatSuccModeUncached
+  exact h.eval
+
+theorem uncached_acceptance {layer : WhnfLayer}
+    {semantics : CacheSemantics} {trProj : RawProjRel}
+    {world : VerifyWorld} {support : RunSupport} {uvars : Nat}
+    {Δ : KVLCtx} {methods : Methods .anon} {natSuccMode : NatSuccMode}
+    {source result : KExpr .anon} {s s' : TcState .anon}
+    (theory : WhnfTheory trProj world uvars)
+    (h : WhnfFullTrace layer semantics trProj world support uvars Δ methods
+      natSuccMode maxWhnfFuel.toNat (source, {}) s result s') :
+    (whnfWithNatSuccModeUncached source natSuccMode).run methods s =
+        .ok result s' ∧
+      WhnfStateInv layer semantics trProj world support uvars Δ s ∧
+      WhnfStateInv layer semantics trProj world support uvars Δ s' ∧
+      WhnfMeaning trProj world uvars Δ source result :=
+  ⟨h.uncached_eval, h.initialInv, h.finalInv, h.meaning theory⟩
+
+end WhnfFullTrace
+
+/-- Non-leaf forms shared by the no-delta and full-WHNF public prefixes. -/
+inductive WhnfDriverNonLeaf : KExpr .anon → Prop
+  | const {id us info} : WhnfDriverNonLeaf (.const id us info)
+  | fvar {id name info} : WhnfDriverNonLeaf (.fvar id name info)
+  | app {f a info} : WhnfDriverNonLeaf (.app f a info)
+  | letE {name ty value body nondep info} :
+      WhnfDriverNonLeaf (.letE name ty value body nondep info)
+  | prj {id field value info} : WhnfDriverNonLeaf (.prj id field value info)
+
+namespace WhnfDriverNonLeaf
+
+theorem noDelta_enter {e : KExpr .anon} (h : WhnfDriverNonLeaf e)
+    (flags : WhnfFlags) (natSuccMode : NatSuccMode) :
+    whnfNoDeltaImpl e flags natSuccMode =
+      whnfNoDeltaImplNonLeaf e flags natSuccMode := by
+  cases h <;> rfl
+
+theorem full_enter {e : KExpr .anon} (h : WhnfDriverNonLeaf e)
+    (natSuccMode : NatSuccMode) :
+    whnfWithNatSuccMode e natSuccMode =
+      whnfWithNatSuccModeNonLeaf e natSuccMode := by
+  cases h <;> rfl
+
+end WhnfDriverNonLeaf
+
+/-- Both outer drivers share the same syntactic prefix.  A direct non-leaf
+preserves state; a legacy variable enters only after an executed let test. -/
+inductive WhnfDriverEntry (methods : Methods .anon) :
+    KExpr .anon → TcState .anon → TcState .anon → Prop
+  | direct {source s} (h : WhnfDriverNonLeaf source) :
+      WhnfDriverEntry methods source s s
+  | varLet {idx name info s s'}
+      (hlet : TcM.isLetVar idx s = .ok true s') :
+      WhnfDriverEntry methods (.var idx name info) s s'
+
+namespace WhnfDriverEntry
+
+theorem noDelta_eval {methods : Methods .anon}
+    {source : KExpr .anon} {s s' : TcState .anon}
+    (h : WhnfDriverEntry methods source s s') (flags : WhnfFlags)
+    (natSuccMode : NatSuccMode) :
+    (whnfNoDeltaImpl source flags natSuccMode).run methods s =
+      (whnfNoDeltaImplNonLeaf source flags natSuccMode).run methods s' := by
+  cases h with
+  | direct h => rw [h.noDelta_enter]
+  | varLet hlet =>
+      unfold whnfNoDeltaImpl
+      rw [ReaderT.run_bind]
+      change EStateM.bind (TcM.isLetVar _ ) _ _ = _
+      unfold EStateM.bind
+      rw [hlet]
+      rfl
+
+theorem full_eval {methods : Methods .anon}
+    {source : KExpr .anon} {s s' : TcState .anon}
+    (h : WhnfDriverEntry methods source s s')
+    (natSuccMode : NatSuccMode) :
+    (whnfWithNatSuccMode source natSuccMode).run methods s =
+      (whnfWithNatSuccModeNonLeaf source natSuccMode).run methods s' := by
+  cases h with
+  | direct h => rw [h.full_enter]
+  | varLet hlet =>
+      unfold whnfWithNatSuccMode
+      rw [ReaderT.run_bind]
+      change EStateM.bind (TcM.isLetVar _) _ _ = _
+      unfold EStateM.bind
+      rw [hlet]
+      rfl
+
+end WhnfDriverEntry
+
+/-- With tracing and statistics disabled, the full-WHNF prefix is an exact
+state-preserving no-op. -/
+theorem whnfWithNatSuccModePrefix_disabled
+    {methods : Methods .anon} {source : KExpr .anon} {s : TcState .anon}
+    (htrace : s.stepTrace = false) (hstats : s.stats = false) :
+    (whnfWithNatSuccModePrefix source).run methods s = .ok () s := by
+  unfold whnfWithNatSuccModePrefix
+  rw [ReaderT.run_bind]
+  change EStateM.bind
+    (TcM.stepTrace "whnf+" (fun _ => TcM.addr8 source.addr)) _ s = _
+  unfold EStateM.bind
+  rw [TcM.stepTrace_disabled htrace]
+  exact TcM.bumpStats_disabled hstats _
+
+/-- With statistics disabled and positive fuel, a full-WHNF cache miss
+performs exactly its single fuel decrement and no other state change. -/
+theorem whnfWithNatSuccModeMissCharge_disabled
+    {methods : Methods .anon} {s : TcState .anon}
+    (hstats : s.stats = false) (hfuel : (s.recFuel == 0) = false) :
+    (whnfWithNatSuccModeMissCharge : RecM .anon Unit).run methods s =
+      .ok () {s with recFuel := s.recFuel - 1} := by
+  unfold whnfWithNatSuccModeMissCharge
+  rw [ReaderT.run_bind]
+  change EStateM.bind
+    (TcM.bumpStats (fun s => {s with whnfMisses := s.whnfMisses + 1})) _
+      s = _
+  unfold EStateM.bind
+  rw [TcM.bumpStats_disabled hstats]
+  exact TcM.tick_success hfuel
+
+/-! ### Exact no-delta cache equations -/
+
+private theorem natSuccMode_collapse_beq :
+    (NatSuccMode.collapse == NatSuccMode.collapse) = true := rfl
+
+private theorem natSuccMode_stuck_beq :
+    (NatSuccMode.stuck == NatSuccMode.collapse) = false := rfl
+
+theorem whnfNoDeltaImplNonLeaf_fullHit
+    {methods : Methods .anon} {s s₁ s₂ : TcState .anon}
+    {source cached : KExpr .anon} {flags : WhnfFlags}
+    {key : Address × Address}
+    (hfull : flags.isFull = true)
+    (hkey : TcM.whnfKey source s = .ok key s₁)
+    (htransient : (isTransientNatLiteralWork source).run methods s₁ =
+      .ok false s₂)
+    (hhit : s₂.env.whnfNoDeltaCache[key]? = some cached) :
+    (whnfNoDeltaImplNonLeaf source flags .collapse).run methods s =
+      .ok cached s₂ := by
+  unfold whnfNoDeltaImplNonLeaf
+  rw [ReaderT.run_bind]
+  change EStateM.bind (TcM.whnfKey source) _ s = _
+  unfold EStateM.bind
+  rw [hkey]
+  simp only
+  rw [ReaderT.run_bind]
+  change EStateM.bind ((isTransientNatLiteralWork source).run methods) _ s₁ = _
+  unfold EStateM.bind
+  rw [htransient]
+  simp [natSuccMode_collapse_beq, hfull]
+  change EStateM.bind (get : TcM .anon (TcState .anon)) _ s₂ = _
+  unfold EStateM.bind
+  rw [show (get : TcM .anon (TcState .anon)) s₂ = .ok s₂ s₂ from rfl]
+  simp only [hhit]
+  rfl
+
+theorem whnfNoDeltaImplNonLeaf_cheapHit
+    {methods : Methods .anon} {s s₁ s₂ : TcState .anon}
+    {source cached : KExpr .anon} {flags : WhnfFlags}
+    {key : Address × Address}
+    (hcheap : flags.isFull = false)
+    (hkey : TcM.whnfKey source s = .ok key s₁)
+    (htransient : (isTransientNatLiteralWork source).run methods s₁ =
+      .ok false s₂)
+    (hhit : s₂.env.whnfNoDeltaCheapCache[key]? = some cached) :
+    (whnfNoDeltaImplNonLeaf source flags .collapse).run methods s =
+      .ok cached s₂ := by
+  unfold whnfNoDeltaImplNonLeaf
+  rw [ReaderT.run_bind]
+  change EStateM.bind (TcM.whnfKey source) _ s = _
+  unfold EStateM.bind
+  rw [hkey]
+  simp only
+  rw [ReaderT.run_bind]
+  change EStateM.bind ((isTransientNatLiteralWork source).run methods) _ s₁ = _
+  unfold EStateM.bind
+  rw [htransient]
+  simp [natSuccMode_collapse_beq, hcheap]
+  change EStateM.bind (get : TcM .anon (TcState .anon)) _ s₂ = _
+  unfold EStateM.bind
+  rw [show (get : TcM .anon (TcState .anon)) s₂ = .ok s₂ s₂ from rfl]
+  simp only [hhit]
+  rfl
+
+theorem whnfNoDeltaImplNonLeaf_fullMiss
+    {methods : Methods .anon} {s s₁ s₂ s₃ : TcState .anon}
+    {source result : KExpr .anon} {flags : WhnfFlags}
+    {key : Address × Address}
+    (hfull : flags.isFull = true)
+    (hkey : TcM.whnfKey source s = .ok key s₁)
+    (htransient : (isTransientNatLiteralWork source).run methods s₁ =
+      .ok false s₂)
+    (hmiss : s₂.env.whnfNoDeltaCache[key]? = none)
+    (hrun : (whnfNoDeltaImplUncached source flags .collapse).run methods s₂ =
+      .ok result s₃)
+    (hnative : s₃.inNativeReduce = false) :
+    (whnfNoDeltaImplNonLeaf source flags .collapse).run methods s =
+      .ok result {s₃ with env := {s₃.env with
+        whnfNoDeltaCache := s₃.env.whnfNoDeltaCache.insert key result}} := by
+  unfold whnfNoDeltaImplNonLeaf
+  rw [ReaderT.run_bind]
+  change EStateM.bind (TcM.whnfKey source) _ s = _
+  unfold EStateM.bind
+  rw [hkey]
+  simp only
+  rw [ReaderT.run_bind]
+  change EStateM.bind ((isTransientNatLiteralWork source).run methods) _ s₁ = _
+  unfold EStateM.bind
+  rw [htransient]
+  simp [natSuccMode_collapse_beq, hfull]
+  change EStateM.bind (get : TcM .anon (TcState .anon)) _ s₂ = _
+  unfold EStateM.bind
+  rw [show (get : TcM .anon (TcState .anon)) s₂ = .ok s₂ s₂ from rfl]
+  simp only [hmiss]
+  rw [ReaderT.run_bind]
+  change EStateM.bind
+    ((whnfNoDeltaImplUncached source flags .collapse).run methods) _ s₂ = _
+  unfold EStateM.bind
+  rw [hrun]
+  simp only
+  rw [ReaderT.run_bind]
+  change EStateM.bind (get : TcM .anon (TcState .anon)) _ s₃ = _
+  unfold EStateM.bind
+  rw [show (get : TcM .anon (TcState .anon)) s₃ = .ok s₃ s₃ from rfl]
+  simp only
+  rw [if_pos hnative]
+  rfl
+
+theorem whnfNoDeltaImplNonLeaf_cheapMiss
+    {methods : Methods .anon} {s s₁ s₂ s₃ : TcState .anon}
+    {source result : KExpr .anon} {flags : WhnfFlags}
+    {key : Address × Address}
+    (hcheap : flags.isFull = false)
+    (hkey : TcM.whnfKey source s = .ok key s₁)
+    (htransient : (isTransientNatLiteralWork source).run methods s₁ =
+      .ok false s₂)
+    (hmiss : s₂.env.whnfNoDeltaCheapCache[key]? = none)
+    (hrun : (whnfNoDeltaImplUncached source flags .collapse).run methods s₂ =
+      .ok result s₃)
+    (hnative : s₃.inNativeReduce = false) :
+    (whnfNoDeltaImplNonLeaf source flags .collapse).run methods s =
+      .ok result {s₃ with env := {s₃.env with
+        whnfNoDeltaCheapCache :=
+          s₃.env.whnfNoDeltaCheapCache.insert key result}} := by
+  unfold whnfNoDeltaImplNonLeaf
+  rw [ReaderT.run_bind]
+  change EStateM.bind (TcM.whnfKey source) _ s = _
+  unfold EStateM.bind
+  rw [hkey]
+  simp only
+  rw [ReaderT.run_bind]
+  change EStateM.bind ((isTransientNatLiteralWork source).run methods) _ s₁ = _
+  unfold EStateM.bind
+  rw [htransient]
+  simp [natSuccMode_collapse_beq, hcheap]
+  change EStateM.bind (get : TcM .anon (TcState .anon)) _ s₂ = _
+  unfold EStateM.bind
+  rw [show (get : TcM .anon (TcState .anon)) s₂ = .ok s₂ s₂ from rfl]
+  simp only [hmiss]
+  rw [ReaderT.run_bind]
+  change EStateM.bind
+    ((whnfNoDeltaImplUncached source flags .collapse).run methods) _ s₂ = _
+  unfold EStateM.bind
+  rw [hrun]
+  simp only
+  rw [ReaderT.run_bind]
+  change EStateM.bind (get : TcM .anon (TcState .anon)) _ s₃ = _
+  unfold EStateM.bind
+  rw [show (get : TcM .anon (TcState .anon)) s₃ = .ok s₃ s₃ from rfl]
+  simp only
+  rw [if_pos hnative]
+  rfl
+
+/-- Stuck-succ mode reads and writes neither no-delta cache partition. -/
+theorem whnfNoDeltaImplNonLeaf_stuck
+    {methods : Methods .anon} {s s₁ s₂ s₃ : TcState .anon}
+    {source result : KExpr .anon} {flags : WhnfFlags}
+    {key : Address × Address} {transient : Bool}
+    (hkey : TcM.whnfKey source s = .ok key s₁)
+    (htransient : (isTransientNatLiteralWork source).run methods s₁ =
+      .ok transient s₂)
+    (hrun : (whnfNoDeltaImplUncached source flags .stuck).run methods s₂ =
+      .ok result s₃) :
+    (whnfNoDeltaImplNonLeaf source flags .stuck).run methods s =
+      .ok result s₃ := by
+  unfold whnfNoDeltaImplNonLeaf
+  rw [ReaderT.run_bind]
+  change EStateM.bind (TcM.whnfKey source) _ s = _
+  unfold EStateM.bind
+  rw [hkey]
+  simp only
+  rw [ReaderT.run_bind]
+  change EStateM.bind ((isTransientNatLiteralWork source).run methods) _ s₁ = _
+  unfold EStateM.bind
+  rw [htransient]
+  simp [natSuccMode_stuck_beq]
+  change EStateM.bind
+    ((whnfNoDeltaImplUncached source flags .stuck).run methods) _ s₂ = _
+  unfold EStateM.bind
+  rw [hrun]
+  rfl
+
+/-- Transient Nat work bypasses both no-delta cache partitions. -/
+theorem whnfNoDeltaImplNonLeaf_transient
+    {methods : Methods .anon} {s s₁ s₂ s₃ : TcState .anon}
+    {source result : KExpr .anon} {flags : WhnfFlags}
+    {key : Address × Address}
+    (hkey : TcM.whnfKey source s = .ok key s₁)
+    (htransient : (isTransientNatLiteralWork source).run methods s₁ =
+      .ok true s₂)
+    (hrun : (whnfNoDeltaImplUncached source flags .collapse).run methods s₂ =
+      .ok result s₃) :
+    (whnfNoDeltaImplNonLeaf source flags .collapse).run methods s =
+      .ok result s₃ := by
+  unfold whnfNoDeltaImplNonLeaf
+  rw [ReaderT.run_bind]
+  change EStateM.bind (TcM.whnfKey source) _ s = _
+  unfold EStateM.bind
+  rw [hkey]
+  simp only
+  rw [ReaderT.run_bind]
+  change EStateM.bind ((isTransientNatLiteralWork source).run methods) _ s₁ = _
+  unfold EStateM.bind
+  rw [htransient]
+  simp [natSuccMode_collapse_beq]
+  change EStateM.bind
+    ((whnfNoDeltaImplUncached source flags .collapse).run methods) _ s₂ = _
+  unfold EStateM.bind
+  rw [hrun]
+  rfl
+
+/-- Native-reduction re-entry may read a stable entry but never inserts a
+new no-delta result after a miss. -/
+theorem whnfNoDeltaImplNonLeaf_nativeNoInsert
+    {methods : Methods .anon} {s s₁ s₂ s₃ : TcState .anon}
+    {source result : KExpr .anon} {flags : WhnfFlags}
+    {key : Address × Address}
+    (hkey : TcM.whnfKey source s = .ok key s₁)
+    (htransient : (isTransientNatLiteralWork source).run methods s₁ =
+      .ok false s₂)
+    (hmiss : if flags.isFull then
+        s₂.env.whnfNoDeltaCache[key]? = none
+      else s₂.env.whnfNoDeltaCheapCache[key]? = none)
+    (hrun : (whnfNoDeltaImplUncached source flags .collapse).run methods s₂ =
+      .ok result s₃)
+    (hnative : s₃.inNativeReduce = true) :
+    (whnfNoDeltaImplNonLeaf source flags .collapse).run methods s =
+      .ok result s₃ := by
+  unfold whnfNoDeltaImplNonLeaf
+  rw [ReaderT.run_bind]
+  change EStateM.bind (TcM.whnfKey source) _ s = _
+  unfold EStateM.bind
+  rw [hkey]
+  simp only
+  rw [ReaderT.run_bind]
+  change EStateM.bind ((isTransientNatLiteralWork source).run methods) _ s₁ = _
+  unfold EStateM.bind
+  rw [htransient]
+  cases hfull : flags.isFull
+  · have hmiss' : s₂.env.whnfNoDeltaCheapCache[key]? = none := by
+      simpa [hfull] using hmiss
+    simp [natSuccMode_collapse_beq]
+    change EStateM.bind (get : TcM .anon (TcState .anon)) _ s₂ = _
+    unfold EStateM.bind
+    rw [show (get : TcM .anon (TcState .anon)) s₂ = .ok s₂ s₂ from rfl]
+    simp only [hmiss']
+    rw [ReaderT.run_bind]
+    change EStateM.bind
+      ((whnfNoDeltaImplUncached source flags .collapse).run methods) _ s₂ = _
+    unfold EStateM.bind
+    rw [hrun]
+    simp only
+    rw [ReaderT.run_bind]
+    change EStateM.bind (get : TcM .anon (TcState .anon)) _ s₃ = _
+    unfold EStateM.bind
+    rw [show (get : TcM .anon (TcState .anon)) s₃ = .ok s₃ s₃ from rfl]
+    simp [hnative]
+    rfl
+  · have hmiss' : s₂.env.whnfNoDeltaCache[key]? = none := by
+      simpa [hfull] using hmiss
+    simp [natSuccMode_collapse_beq]
+    change EStateM.bind (get : TcM .anon (TcState .anon)) _ s₂ = _
+    unfold EStateM.bind
+    rw [show (get : TcM .anon (TcState .anon)) s₂ = .ok s₂ s₂ from rfl]
+    simp only [hmiss']
+    rw [ReaderT.run_bind]
+    change EStateM.bind
+      ((whnfNoDeltaImplUncached source flags .collapse).run methods) _ s₂ = _
+    unfold EStateM.bind
+    rw [hrun]
+    simp only
+    rw [ReaderT.run_bind]
+    change EStateM.bind (get : TcM .anon (TcState .anon)) _ s₃ = _
+    unfold EStateM.bind
+    rw [show (get : TcM .anon (TcState .anon)) s₃ = .ok s₃ s₃ from rfl]
+    simp [hnative]
+    rfl
+
+namespace WhnfDriverCacheUpdate
+
+theorem noDelta_whnfStateInv
+    {layer : WhnfLayer} {semantics : CacheSemantics}
+    {trProj : RawProjRel} {world : VerifyWorld} {support : RunSupport}
+    {uvars : Nat} {Δ : KVLCtx} {s : TcState .anon}
+    {key : Address × Address} {result : KExpr .anon}
+    (hI : WhnfStateInv layer semantics trProj world support uvars Δ s)
+    (hnew : CacheProvenance semantics (CacheAuthority.stable world) support
+      (.expr .whnfNoDelta key result)) :
+    WhnfStateInv layer semantics trProj world support uvars Δ
+      {s with env := {s.env with
+        whnfNoDeltaCache := s.env.whnfNoDeltaCache.insert key result}} := by
+  rcases hI with ⟨hkernel, hctx, hlayer⟩
+  refine ⟨?_, ?_, ?_⟩
+  · refine ⟨?_, ?_, ?_⟩
+    · exact hkernel.core.of_consts_eq rfl (by
+        simpa using hkernel.core.intern)
+    · simpa using hkernel.internSupport
+    · exact hkernel.caches.insertWhnfNoDelta hnew
+  · exact hctx.of_fields_eq rfl rfl rfl rfl (by simp)
+  · cases layer with
+    | noAccel => simpa [WhnfLayer.StateOK] using hlayer
+    | accelerated => trivial
+
+theorem noDeltaCheap_whnfStateInv
+    {layer : WhnfLayer} {semantics : CacheSemantics}
+    {trProj : RawProjRel} {world : VerifyWorld} {support : RunSupport}
+    {uvars : Nat} {Δ : KVLCtx} {s : TcState .anon}
+    {key : Address × Address} {result : KExpr .anon}
+    (hI : WhnfStateInv layer semantics trProj world support uvars Δ s)
+    (hnew : CacheProvenance semantics (CacheAuthority.stable world) support
+      (.expr .whnfNoDeltaCheap key result)) :
+    WhnfStateInv layer semantics trProj world support uvars Δ
+      {s with env := {s.env with
+        whnfNoDeltaCheapCache :=
+          s.env.whnfNoDeltaCheapCache.insert key result}} := by
+  rcases hI with ⟨hkernel, hctx, hlayer⟩
+  refine ⟨?_, ?_, ?_⟩
+  · refine ⟨?_, ?_, ?_⟩
+    · exact hkernel.core.of_consts_eq rfl (by
+        simpa using hkernel.core.intern)
+    · simpa using hkernel.internSupport
+    · exact hkernel.caches.insertWhnfNoDeltaCheap hnew
+  · exact hctx.of_fields_eq rfl rfl rfl rfl (by simp)
+  · cases layer with
+    | noAccel => simpa [WhnfLayer.StateOK] using hlayer
+    | accelerated => trivial
+
+theorem full_whnfStateInv
+    {layer : WhnfLayer} {semantics : CacheSemantics}
+    {trProj : RawProjRel} {world : VerifyWorld} {support : RunSupport}
+    {uvars : Nat} {Δ : KVLCtx} {s : TcState .anon}
+    {key : Address × Address} {result : KExpr .anon}
+    (hI : WhnfStateInv layer semantics trProj world support uvars Δ s)
+    (hnew : CacheProvenance semantics (CacheAuthority.stable world) support
+      (.expr .whnf key result)) :
+    WhnfStateInv layer semantics trProj world support uvars Δ
+      {s with env := {s.env with
+        whnfCache := s.env.whnfCache.insert key result}} := by
+  rcases hI with ⟨hkernel, hctx, hlayer⟩
+  refine ⟨?_, ?_, ?_⟩
+  · refine ⟨?_, ?_, ?_⟩
+    · exact hkernel.core.of_consts_eq rfl (by
+        simpa using hkernel.core.intern)
+    · simpa using hkernel.internSupport
+    · exact hkernel.caches.insertWhnf hnew
+  · exact hctx.of_fields_eq rfl rfl rfl rfl (by simp)
+  · cases layer with
+    | noAccel => simpa [WhnfLayer.StateOK] using hlayer
+    | accelerated => trivial
+
+end WhnfDriverCacheUpdate
+
+theorem whnfNoDeltaImpl_fullHit_acceptance
+    {keys : WhnfContextKeys} {fallback : CacheSemantics}
+    {layer : WhnfLayer} {trProj : RawProjRel} {world : VerifyWorld}
+    {support : RunSupport} {Δ : KVLCtx} {methods : Methods .anon}
+    {flags : WhnfFlags} {source cached : KExpr .anon}
+    {key : Address × Address} {s s₀ s₁ s₂ : TcState .anon}
+    (hentry : WhnfDriverEntry methods source s s₀)
+    (hfull : flags.isFull = true)
+    (hkey : TcM.whnfKey source s₀ = .ok key s₁)
+    (htransient : (isTransientNatLiteralWork source).run methods s₁ =
+      .ok false s₂)
+    (hhit : s₂.env.whnfNoDeltaCache[key]? = some cached)
+    (hI : WhnfStateInv layer (whnfCacheSemantics keys trProj fallback)
+      trProj world support keys.uvars Δ s₂)
+    (hsource : support source)
+    (hmatch : keys.Matches trProj world s₂ Δ source key) :
+    (whnfNoDeltaImpl source flags .collapse).run methods s =
+        .ok cached s₂ ∧
+      WhnfStateInv layer (whnfCacheSemantics keys trProj fallback)
+        trProj world support keys.uvars Δ s₂ ∧
+      WhnfMeaning trProj world keys.uvars Δ source cached := by
+  refine ⟨?_, hI, ?_⟩
+  · rw [hentry.noDelta_eval flags .collapse]
+    exact whnfNoDeltaImplNonLeaf_fullHit hfull hkey htransient hhit
+  · exact hI.1.caches.whnfHitOfMatches (.whnfNoDelta hhit)
+      .whnfNoDelta hsource hmatch
+
+theorem whnfNoDeltaImpl_cheapHit_acceptance
+    {keys : WhnfContextKeys} {fallback : CacheSemantics}
+    {layer : WhnfLayer} {trProj : RawProjRel} {world : VerifyWorld}
+    {support : RunSupport} {Δ : KVLCtx} {methods : Methods .anon}
+    {flags : WhnfFlags} {source cached : KExpr .anon}
+    {key : Address × Address} {s s₀ s₁ s₂ : TcState .anon}
+    (hentry : WhnfDriverEntry methods source s s₀)
+    (hcheap : flags.isFull = false)
+    (hkey : TcM.whnfKey source s₀ = .ok key s₁)
+    (htransient : (isTransientNatLiteralWork source).run methods s₁ =
+      .ok false s₂)
+    (hhit : s₂.env.whnfNoDeltaCheapCache[key]? = some cached)
+    (hI : WhnfStateInv layer (whnfCacheSemantics keys trProj fallback)
+      trProj world support keys.uvars Δ s₂)
+    (hsource : support source)
+    (hmatch : keys.Matches trProj world s₂ Δ source key) :
+    (whnfNoDeltaImpl source flags .collapse).run methods s =
+        .ok cached s₂ ∧
+      WhnfStateInv layer (whnfCacheSemantics keys trProj fallback)
+        trProj world support keys.uvars Δ s₂ ∧
+      WhnfMeaning trProj world keys.uvars Δ source cached := by
+  refine ⟨?_, hI, ?_⟩
+  · rw [hentry.noDelta_eval flags .collapse]
+    exact whnfNoDeltaImplNonLeaf_cheapHit hcheap hkey htransient hhit
+  · exact hI.1.caches.whnfHitOfMatches (.whnfNoDeltaCheap hhit)
+      .whnfNoDeltaCheap hsource hmatch
+
+theorem whnfNoDeltaImpl_fullMiss_acceptance
+    {keys : WhnfContextKeys} {fallback : CacheSemantics}
+    {layer : WhnfLayer} {trProj : RawProjRel} {world : VerifyWorld}
+    {support : RunSupport} {Δ : KVLCtx} {methods : Methods .anon}
+    {flags : WhnfFlags} {source result : KExpr .anon}
+    {key : Address × Address} {s s₀ s₁ s₂ s₃ : TcState .anon}
+    (theory : WhnfTheory trProj world keys.uvars)
+    (hentry : WhnfDriverEntry methods source s s₀)
+    (hfull : flags.isFull = true)
+    (hkey : TcM.whnfKey source s₀ = .ok key s₁)
+    (htransient : (isTransientNatLiteralWork source).run methods s₁ =
+      .ok false s₂)
+    (hmiss : s₂.env.whnfNoDeltaCache[key]? = none)
+    (htrace : WhnfNoDeltaTrace layer
+      (whnfCacheSemantics keys trProj fallback) trProj world support
+      keys.uvars Δ methods flags .collapse maxWhnfFuel.toNat
+      source s₂ result s₃)
+    (hnative : s₃.inNativeReduce = false)
+    (hnew : CacheProvenance (whnfCacheSemantics keys trProj fallback)
+      (CacheAuthority.stable world) support
+      (.expr .whnfNoDelta key result)) :
+    let s₄ := {s₃ with env := {s₃.env with
+      whnfNoDeltaCache := s₃.env.whnfNoDeltaCache.insert key result}}
+    (whnfNoDeltaImpl source flags .collapse).run methods s =
+        .ok result s₄ ∧
+      WhnfStateInv layer (whnfCacheSemantics keys trProj fallback)
+        trProj world support keys.uvars Δ s₂ ∧
+      WhnfStateInv layer (whnfCacheSemantics keys trProj fallback)
+        trProj world support keys.uvars Δ s₄ ∧
+      WhnfMeaning trProj world keys.uvars Δ source result := by
+  dsimp only
+  refine ⟨?_, htrace.initialInv, ?_, htrace.meaning theory⟩
+  · rw [hentry.noDelta_eval flags .collapse]
+    exact whnfNoDeltaImplNonLeaf_fullMiss hfull hkey htransient hmiss
+      htrace.uncached_eval hnative
+  · exact WhnfDriverCacheUpdate.noDelta_whnfStateInv htrace.finalInv hnew
+
+theorem whnfNoDeltaImpl_cheapMiss_acceptance
+    {keys : WhnfContextKeys} {fallback : CacheSemantics}
+    {layer : WhnfLayer} {trProj : RawProjRel} {world : VerifyWorld}
+    {support : RunSupport} {Δ : KVLCtx} {methods : Methods .anon}
+    {flags : WhnfFlags} {source result : KExpr .anon}
+    {key : Address × Address} {s s₀ s₁ s₂ s₃ : TcState .anon}
+    (theory : WhnfTheory trProj world keys.uvars)
+    (hentry : WhnfDriverEntry methods source s s₀)
+    (hcheap : flags.isFull = false)
+    (hkey : TcM.whnfKey source s₀ = .ok key s₁)
+    (htransient : (isTransientNatLiteralWork source).run methods s₁ =
+      .ok false s₂)
+    (hmiss : s₂.env.whnfNoDeltaCheapCache[key]? = none)
+    (htrace : WhnfNoDeltaTrace layer
+      (whnfCacheSemantics keys trProj fallback) trProj world support
+      keys.uvars Δ methods flags .collapse maxWhnfFuel.toNat
+      source s₂ result s₃)
+    (hnative : s₃.inNativeReduce = false)
+    (hnew : CacheProvenance (whnfCacheSemantics keys trProj fallback)
+      (CacheAuthority.stable world) support
+      (.expr .whnfNoDeltaCheap key result)) :
+    let s₄ := {s₃ with env := {s₃.env with
+      whnfNoDeltaCheapCache :=
+        s₃.env.whnfNoDeltaCheapCache.insert key result}}
+    (whnfNoDeltaImpl source flags .collapse).run methods s =
+        .ok result s₄ ∧
+      WhnfStateInv layer (whnfCacheSemantics keys trProj fallback)
+        trProj world support keys.uvars Δ s₂ ∧
+      WhnfStateInv layer (whnfCacheSemantics keys trProj fallback)
+        trProj world support keys.uvars Δ s₄ ∧
+      WhnfMeaning trProj world keys.uvars Δ source result := by
+  dsimp only
+  refine ⟨?_, htrace.initialInv, ?_, htrace.meaning theory⟩
+  · rw [hentry.noDelta_eval flags .collapse]
+    exact whnfNoDeltaImplNonLeaf_cheapMiss hcheap hkey htransient hmiss
+      htrace.uncached_eval hnative
+  · exact WhnfDriverCacheUpdate.noDeltaCheap_whnfStateInv
+      htrace.finalInv hnew
+
+theorem whnfNoDeltaImpl_stuck_acceptance
+    {keys : WhnfContextKeys} {fallback : CacheSemantics}
+    {layer : WhnfLayer} {trProj : RawProjRel} {world : VerifyWorld}
+    {support : RunSupport} {Δ : KVLCtx} {methods : Methods .anon}
+    {flags : WhnfFlags} {source result : KExpr .anon}
+    {key : Address × Address} {transient : Bool}
+    {s s₀ s₁ s₂ s₃ : TcState .anon}
+    (theory : WhnfTheory trProj world keys.uvars)
+    (hentry : WhnfDriverEntry methods source s s₀)
+    (hkey : TcM.whnfKey source s₀ = .ok key s₁)
+    (htransient : (isTransientNatLiteralWork source).run methods s₁ =
+      .ok transient s₂)
+    (htrace : WhnfNoDeltaTrace layer
+      (whnfCacheSemantics keys trProj fallback) trProj world support
+      keys.uvars Δ methods flags .stuck maxWhnfFuel.toNat
+      source s₂ result s₃) :
+    (whnfNoDeltaImpl source flags .stuck).run methods s = .ok result s₃ ∧
+      WhnfStateInv layer (whnfCacheSemantics keys trProj fallback)
+        trProj world support keys.uvars Δ s₂ ∧
+      WhnfStateInv layer (whnfCacheSemantics keys trProj fallback)
+        trProj world support keys.uvars Δ s₃ ∧
+      WhnfMeaning trProj world keys.uvars Δ source result := by
+  refine ⟨?_, htrace.initialInv, htrace.finalInv, htrace.meaning theory⟩
+  rw [hentry.noDelta_eval flags .stuck]
+  exact whnfNoDeltaImplNonLeaf_stuck hkey htransient htrace.uncached_eval
+
+theorem whnfNoDeltaImpl_transient_acceptance
+    {keys : WhnfContextKeys} {fallback : CacheSemantics}
+    {layer : WhnfLayer} {trProj : RawProjRel} {world : VerifyWorld}
+    {support : RunSupport} {Δ : KVLCtx} {methods : Methods .anon}
+    {flags : WhnfFlags} {source result : KExpr .anon}
+    {key : Address × Address} {s s₀ s₁ s₂ s₃ : TcState .anon}
+    (theory : WhnfTheory trProj world keys.uvars)
+    (hentry : WhnfDriverEntry methods source s s₀)
+    (hkey : TcM.whnfKey source s₀ = .ok key s₁)
+    (htransient : (isTransientNatLiteralWork source).run methods s₁ =
+      .ok true s₂)
+    (htrace : WhnfNoDeltaTrace layer
+      (whnfCacheSemantics keys trProj fallback) trProj world support
+      keys.uvars Δ methods flags .collapse maxWhnfFuel.toNat
+      source s₂ result s₃) :
+    (whnfNoDeltaImpl source flags .collapse).run methods s =
+        .ok result s₃ ∧
+      WhnfStateInv layer (whnfCacheSemantics keys trProj fallback)
+        trProj world support keys.uvars Δ s₂ ∧
+      WhnfStateInv layer (whnfCacheSemantics keys trProj fallback)
+        trProj world support keys.uvars Δ s₃ ∧
+      WhnfMeaning trProj world keys.uvars Δ source result := by
+  refine ⟨?_, htrace.initialInv, htrace.finalInv, htrace.meaning theory⟩
+  rw [hentry.noDelta_eval flags .collapse]
+  exact whnfNoDeltaImplNonLeaf_transient hkey htransient
+    htrace.uncached_eval
+
+/-! ### Exact full-WHNF instrumentation/cache equations -/
+
+theorem whnfWithNatSuccModeNonLeaf_hit
+    {methods : Methods .anon} {s s₁ s₂ s₃ : TcState .anon}
+    {source cached : KExpr .anon} {key : Address × Address}
+    (hprefix : (whnfWithNatSuccModePrefix source).run methods s =
+      .ok () s₁)
+    (hkey : TcM.whnfKey source s₁ = .ok key s₂)
+    (htransient : (isTransientNatLiteralWork source).run methods s₂ =
+      .ok false s₃)
+    (hhit : s₃.env.whnfCache[key]? = some cached) :
+    (whnfWithNatSuccModeNonLeaf source .collapse).run methods s =
+      .ok cached s₃ := by
+  unfold whnfWithNatSuccModeNonLeaf
+  rw [ReaderT.run_bind]
+  change EStateM.bind
+    ((whnfWithNatSuccModePrefix source).run methods) _ s = _
+  unfold EStateM.bind
+  rw [hprefix]
+  simp only
+  rw [ReaderT.run_bind]
+  change EStateM.bind (TcM.whnfKey source) _ s₁ = _
+  unfold EStateM.bind
+  rw [hkey]
+  simp only
+  rw [ReaderT.run_bind]
+  change EStateM.bind ((isTransientNatLiteralWork source).run methods) _ s₂ = _
+  unfold EStateM.bind
+  rw [htransient]
+  simp [natSuccMode_collapse_beq]
+  change EStateM.bind (get : TcM .anon (TcState .anon)) _ s₃ = _
+  unfold EStateM.bind
+  rw [show (get : TcM .anon (TcState .anon)) s₃ = .ok s₃ s₃ from rfl]
+  simp only [hhit]
+  rfl
+
+theorem whnfWithNatSuccModeNonLeaf_miss
+    {methods : Methods .anon} {s s₁ s₂ s₃ s₄ s₅ : TcState .anon}
+    {source result : KExpr .anon} {key : Address × Address}
+    (hprefix : (whnfWithNatSuccModePrefix source).run methods s =
+      .ok () s₁)
+    (hkey : TcM.whnfKey source s₁ = .ok key s₂)
+    (htransient : (isTransientNatLiteralWork source).run methods s₂ =
+      .ok false s₃)
+    (hmiss : s₃.env.whnfCache[key]? = none)
+    (hcharge : (whnfWithNatSuccModeMissCharge : RecM .anon Unit).run
+      methods s₃ = .ok () s₄)
+    (hrun : (whnfWithNatSuccModeUncached source .collapse).run methods s₄ =
+      .ok result s₅)
+    (hnative : s₅.inNativeReduce = false) :
+    (whnfWithNatSuccModeNonLeaf source .collapse).run methods s =
+      .ok result {s₅ with env := {s₅.env with
+        whnfCache := s₅.env.whnfCache.insert key result}} := by
+  unfold whnfWithNatSuccModeNonLeaf
+  rw [ReaderT.run_bind]
+  change EStateM.bind
+    ((whnfWithNatSuccModePrefix source).run methods) _ s = _
+  unfold EStateM.bind
+  rw [hprefix]
+  simp only
+  rw [ReaderT.run_bind]
+  change EStateM.bind (TcM.whnfKey source) _ s₁ = _
+  unfold EStateM.bind
+  rw [hkey]
+  simp only
+  rw [ReaderT.run_bind]
+  change EStateM.bind ((isTransientNatLiteralWork source).run methods) _ s₂ = _
+  unfold EStateM.bind
+  rw [htransient]
+  simp [natSuccMode_collapse_beq]
+  change EStateM.bind (get : TcM .anon (TcState .anon)) _ s₃ = _
+  unfold EStateM.bind
+  rw [show (get : TcM .anon (TcState .anon)) s₃ = .ok s₃ s₃ from rfl]
+  simp only [hmiss]
+  rw [ReaderT.run_bind]
+  change EStateM.bind
+    ((whnfWithNatSuccModeMissCharge : RecM .anon Unit).run methods) _ s₃ = _
+  unfold EStateM.bind
+  rw [hcharge]
+  simp only
+  rw [ReaderT.run_bind]
+  change EStateM.bind
+    ((whnfWithNatSuccModeUncached source .collapse).run methods) _ s₄ = _
+  unfold EStateM.bind
+  rw [hrun]
+  simp only
+  rw [ReaderT.run_bind]
+  change EStateM.bind (get : TcM .anon (TcState .anon)) _ s₅ = _
+  unfold EStateM.bind
+  rw [show (get : TcM .anon (TcState .anon)) s₅ = .ok s₅ s₅ from rfl]
+  simp only
+  rw [if_pos hnative]
+  rfl
+
+/-- Stuck-succ full WHNF still pays the miss charge but bypasses both the
+outer cache read and write. -/
+theorem whnfWithNatSuccModeNonLeaf_stuck
+    {methods : Methods .anon} {s s₁ s₂ s₃ s₄ s₅ : TcState .anon}
+    {source result : KExpr .anon} {key : Address × Address}
+    {transient : Bool}
+    (hprefix : (whnfWithNatSuccModePrefix source).run methods s =
+      .ok () s₁)
+    (hkey : TcM.whnfKey source s₁ = .ok key s₂)
+    (htransient : (isTransientNatLiteralWork source).run methods s₂ =
+      .ok transient s₃)
+    (hcharge : (whnfWithNatSuccModeMissCharge : RecM .anon Unit).run
+      methods s₃ = .ok () s₄)
+    (hrun : (whnfWithNatSuccModeUncached source .stuck).run methods s₄ =
+      .ok result s₅) :
+    (whnfWithNatSuccModeNonLeaf source .stuck).run methods s =
+      .ok result s₅ := by
+  unfold whnfWithNatSuccModeNonLeaf
+  rw [ReaderT.run_bind]
+  change EStateM.bind
+    ((whnfWithNatSuccModePrefix source).run methods) _ s = _
+  unfold EStateM.bind
+  rw [hprefix]
+  simp only
+  rw [ReaderT.run_bind]
+  change EStateM.bind (TcM.whnfKey source) _ s₁ = _
+  unfold EStateM.bind
+  rw [hkey]
+  simp only
+  rw [ReaderT.run_bind]
+  change EStateM.bind ((isTransientNatLiteralWork source).run methods) _ s₂ = _
+  unfold EStateM.bind
+  rw [htransient]
+  simp [natSuccMode_stuck_beq]
+  change EStateM.bind
+    ((whnfWithNatSuccModeMissCharge : RecM .anon Unit).run methods) _ s₃ = _
+  unfold EStateM.bind
+  rw [hcharge]
+  simp only
+  change EStateM.bind
+    ((whnfWithNatSuccModeUncached source .stuck).run methods) _ s₄ = _
+  unfold EStateM.bind
+  rw [hrun]
+  rfl
+
+/-- Transient full-WHNF work is charged but cannot observe or populate the
+outer cache. -/
+theorem whnfWithNatSuccModeNonLeaf_transient
+    {methods : Methods .anon} {s s₁ s₂ s₃ s₄ s₅ : TcState .anon}
+    {source result : KExpr .anon} {key : Address × Address}
+    (hprefix : (whnfWithNatSuccModePrefix source).run methods s =
+      .ok () s₁)
+    (hkey : TcM.whnfKey source s₁ = .ok key s₂)
+    (htransient : (isTransientNatLiteralWork source).run methods s₂ =
+      .ok true s₃)
+    (hcharge : (whnfWithNatSuccModeMissCharge : RecM .anon Unit).run
+      methods s₃ = .ok () s₄)
+    (hrun : (whnfWithNatSuccModeUncached source .collapse).run methods s₄ =
+      .ok result s₅) :
+    (whnfWithNatSuccModeNonLeaf source .collapse).run methods s =
+      .ok result s₅ := by
+  unfold whnfWithNatSuccModeNonLeaf
+  rw [ReaderT.run_bind]
+  change EStateM.bind
+    ((whnfWithNatSuccModePrefix source).run methods) _ s = _
+  unfold EStateM.bind
+  rw [hprefix]
+  simp only
+  rw [ReaderT.run_bind]
+  change EStateM.bind (TcM.whnfKey source) _ s₁ = _
+  unfold EStateM.bind
+  rw [hkey]
+  simp only
+  rw [ReaderT.run_bind]
+  change EStateM.bind ((isTransientNatLiteralWork source).run methods) _ s₂ = _
+  unfold EStateM.bind
+  rw [htransient]
+  simp [natSuccMode_collapse_beq]
+  change EStateM.bind
+    ((whnfWithNatSuccModeMissCharge : RecM .anon Unit).run methods) _ s₃ = _
+  unfold EStateM.bind
+  rw [hcharge]
+  simp only
+  change EStateM.bind
+    ((whnfWithNatSuccModeUncached source .collapse).run methods) _ s₄ = _
+  unfold EStateM.bind
+  rw [hrun]
+  rfl
+
+theorem whnfWithNatSuccModeNonLeaf_nativeNoInsert
+    {methods : Methods .anon} {s s₁ s₂ s₃ s₄ s₅ : TcState .anon}
+    {source result : KExpr .anon} {key : Address × Address}
+    (hprefix : (whnfWithNatSuccModePrefix source).run methods s =
+      .ok () s₁)
+    (hkey : TcM.whnfKey source s₁ = .ok key s₂)
+    (htransient : (isTransientNatLiteralWork source).run methods s₂ =
+      .ok false s₃)
+    (hmiss : s₃.env.whnfCache[key]? = none)
+    (hcharge : (whnfWithNatSuccModeMissCharge : RecM .anon Unit).run
+      methods s₃ = .ok () s₄)
+    (hrun : (whnfWithNatSuccModeUncached source .collapse).run methods s₄ =
+      .ok result s₅)
+    (hnative : s₅.inNativeReduce = true) :
+    (whnfWithNatSuccModeNonLeaf source .collapse).run methods s =
+      .ok result s₅ := by
+  unfold whnfWithNatSuccModeNonLeaf
+  rw [ReaderT.run_bind]
+  change EStateM.bind
+    ((whnfWithNatSuccModePrefix source).run methods) _ s = _
+  unfold EStateM.bind
+  rw [hprefix]
+  simp only
+  rw [ReaderT.run_bind]
+  change EStateM.bind (TcM.whnfKey source) _ s₁ = _
+  unfold EStateM.bind
+  rw [hkey]
+  simp only
+  rw [ReaderT.run_bind]
+  change EStateM.bind ((isTransientNatLiteralWork source).run methods) _ s₂ = _
+  unfold EStateM.bind
+  rw [htransient]
+  simp [natSuccMode_collapse_beq]
+  change EStateM.bind (get : TcM .anon (TcState .anon)) _ s₃ = _
+  unfold EStateM.bind
+  rw [show (get : TcM .anon (TcState .anon)) s₃ = .ok s₃ s₃ from rfl]
+  simp only [hmiss]
+  rw [ReaderT.run_bind]
+  change EStateM.bind
+    ((whnfWithNatSuccModeMissCharge : RecM .anon Unit).run methods) _ s₃ = _
+  unfold EStateM.bind
+  rw [hcharge]
+  simp only
+  rw [ReaderT.run_bind]
+  change EStateM.bind
+    ((whnfWithNatSuccModeUncached source .collapse).run methods) _ s₄ = _
+  unfold EStateM.bind
+  rw [hrun]
+  simp only
+  rw [ReaderT.run_bind]
+  change EStateM.bind (get : TcM .anon (TcState .anon)) _ s₅ = _
+  unfold EStateM.bind
+  rw [show (get : TcM .anon (TcState .anon)) s₅ = .ok s₅ s₅ from rfl]
+  simp [hnative]
+  rfl
+
+theorem whnfWithNatSuccMode_hit_acceptance
+    {keys : WhnfContextKeys} {fallback : CacheSemantics}
+    {layer : WhnfLayer} {trProj : RawProjRel} {world : VerifyWorld}
+    {support : RunSupport} {Δ : KVLCtx} {methods : Methods .anon}
+    {source cached : KExpr .anon} {key : Address × Address}
+    {s s₀ s₁ s₂ s₃ : TcState .anon}
+    (hentry : WhnfDriverEntry methods source s s₀)
+    (hprefix : (whnfWithNatSuccModePrefix source).run methods s₀ =
+      .ok () s₁)
+    (hkey : TcM.whnfKey source s₁ = .ok key s₂)
+    (htransient : (isTransientNatLiteralWork source).run methods s₂ =
+      .ok false s₃)
+    (hhit : s₃.env.whnfCache[key]? = some cached)
+    (hI : WhnfStateInv layer (whnfCacheSemantics keys trProj fallback)
+      trProj world support keys.uvars Δ s₃)
+    (hsource : support source)
+    (hmatch : keys.Matches trProj world s₃ Δ source key) :
+    (whnfWithNatSuccMode source .collapse).run methods s =
+        .ok cached s₃ ∧
+      WhnfStateInv layer (whnfCacheSemantics keys trProj fallback)
+        trProj world support keys.uvars Δ s₃ ∧
+      WhnfMeaning trProj world keys.uvars Δ source cached := by
+  refine ⟨?_, hI, ?_⟩
+  · rw [hentry.full_eval .collapse]
+    exact whnfWithNatSuccModeNonLeaf_hit hprefix hkey htransient hhit
+  · exact hI.1.caches.whnfHitOfMatches (.whnf hhit) .whnf hsource hmatch
+
+theorem whnfWithNatSuccMode_miss_acceptance
+    {keys : WhnfContextKeys} {fallback : CacheSemantics}
+    {layer : WhnfLayer} {trProj : RawProjRel} {world : VerifyWorld}
+    {support : RunSupport} {Δ : KVLCtx} {methods : Methods .anon}
+    {source result : KExpr .anon} {key : Address × Address}
+    {s s₀ s₁ s₂ s₃ s₄ s₅ : TcState .anon}
+    (theory : WhnfTheory trProj world keys.uvars)
+    (hentry : WhnfDriverEntry methods source s s₀)
+    (hprefix : (whnfWithNatSuccModePrefix source).run methods s₀ =
+      .ok () s₁)
+    (hkey : TcM.whnfKey source s₁ = .ok key s₂)
+    (htransient : (isTransientNatLiteralWork source).run methods s₂ =
+      .ok false s₃)
+    (hmiss : s₃.env.whnfCache[key]? = none)
+    (hcharge : (whnfWithNatSuccModeMissCharge : RecM .anon Unit).run
+      methods s₃ = .ok () s₄)
+    (htrace : WhnfFullTrace layer
+      (whnfCacheSemantics keys trProj fallback) trProj world support
+      keys.uvars Δ methods .collapse maxWhnfFuel.toNat
+      (source, {}) s₄ result s₅)
+    (hnative : s₅.inNativeReduce = false)
+    (hnew : CacheProvenance (whnfCacheSemantics keys trProj fallback)
+      (CacheAuthority.stable world) support (.expr .whnf key result)) :
+    let s₆ := {s₅ with env := {s₅.env with
+      whnfCache := s₅.env.whnfCache.insert key result}}
+    (whnfWithNatSuccMode source .collapse).run methods s =
+        .ok result s₆ ∧
+      WhnfStateInv layer (whnfCacheSemantics keys trProj fallback)
+        trProj world support keys.uvars Δ s₄ ∧
+      WhnfStateInv layer (whnfCacheSemantics keys trProj fallback)
+        trProj world support keys.uvars Δ s₆ ∧
+      WhnfMeaning trProj world keys.uvars Δ source result := by
+  dsimp only
+  refine ⟨?_, htrace.initialInv, ?_, htrace.meaning theory⟩
+  · rw [hentry.full_eval .collapse]
+    exact whnfWithNatSuccModeNonLeaf_miss hprefix hkey htransient hmiss
+      hcharge htrace.uncached_eval hnative
+  · exact WhnfDriverCacheUpdate.full_whnfStateInv htrace.finalInv hnew
+
+theorem whnfWithNatSuccMode_stuck_acceptance
+    {keys : WhnfContextKeys} {fallback : CacheSemantics}
+    {layer : WhnfLayer} {trProj : RawProjRel} {world : VerifyWorld}
+    {support : RunSupport} {Δ : KVLCtx} {methods : Methods .anon}
+    {source result : KExpr .anon} {key : Address × Address}
+    {transient : Bool} {s s₀ s₁ s₂ s₃ s₄ s₅ : TcState .anon}
+    (theory : WhnfTheory trProj world keys.uvars)
+    (hentry : WhnfDriverEntry methods source s s₀)
+    (hprefix : (whnfWithNatSuccModePrefix source).run methods s₀ =
+      .ok () s₁)
+    (hkey : TcM.whnfKey source s₁ = .ok key s₂)
+    (htransient : (isTransientNatLiteralWork source).run methods s₂ =
+      .ok transient s₃)
+    (hcharge : (whnfWithNatSuccModeMissCharge : RecM .anon Unit).run
+      methods s₃ = .ok () s₄)
+    (htrace : WhnfFullTrace layer
+      (whnfCacheSemantics keys trProj fallback) trProj world support
+      keys.uvars Δ methods .stuck maxWhnfFuel.toNat
+      (source, {}) s₄ result s₅) :
+    (whnfWithNatSuccMode source .stuck).run methods s = .ok result s₅ ∧
+      WhnfStateInv layer (whnfCacheSemantics keys trProj fallback)
+        trProj world support keys.uvars Δ s₄ ∧
+      WhnfStateInv layer (whnfCacheSemantics keys trProj fallback)
+        trProj world support keys.uvars Δ s₅ ∧
+      WhnfMeaning trProj world keys.uvars Δ source result := by
+  refine ⟨?_, htrace.initialInv, htrace.finalInv, htrace.meaning theory⟩
+  rw [hentry.full_eval .stuck]
+  exact whnfWithNatSuccModeNonLeaf_stuck hprefix hkey htransient hcharge
+    htrace.uncached_eval
+
+theorem whnfWithNatSuccMode_transient_acceptance
+    {keys : WhnfContextKeys} {fallback : CacheSemantics}
+    {layer : WhnfLayer} {trProj : RawProjRel} {world : VerifyWorld}
+    {support : RunSupport} {Δ : KVLCtx} {methods : Methods .anon}
+    {source result : KExpr .anon} {key : Address × Address}
+    {s s₀ s₁ s₂ s₃ s₄ s₅ : TcState .anon}
+    (theory : WhnfTheory trProj world keys.uvars)
+    (hentry : WhnfDriverEntry methods source s s₀)
+    (hprefix : (whnfWithNatSuccModePrefix source).run methods s₀ =
+      .ok () s₁)
+    (hkey : TcM.whnfKey source s₁ = .ok key s₂)
+    (htransient : (isTransientNatLiteralWork source).run methods s₂ =
+      .ok true s₃)
+    (hcharge : (whnfWithNatSuccModeMissCharge : RecM .anon Unit).run
+      methods s₃ = .ok () s₄)
+    (htrace : WhnfFullTrace layer
+      (whnfCacheSemantics keys trProj fallback) trProj world support
+      keys.uvars Δ methods .collapse maxWhnfFuel.toNat
+      (source, {}) s₄ result s₅) :
+    (whnfWithNatSuccMode source .collapse).run methods s =
+        .ok result s₅ ∧
+      WhnfStateInv layer (whnfCacheSemantics keys trProj fallback)
+        trProj world support keys.uvars Δ s₄ ∧
+      WhnfStateInv layer (whnfCacheSemantics keys trProj fallback)
+        trProj world support keys.uvars Δ s₅ ∧
+      WhnfMeaning trProj world keys.uvars Δ source result := by
+  refine ⟨?_, htrace.initialInv, htrace.finalInv, htrace.meaning theory⟩
+  rw [hentry.full_eval .collapse]
+  exact whnfWithNatSuccModeNonLeaf_transient hprefix hkey htransient
+    hcharge htrace.uncached_eval
+
+/-- Public full WHNF is exactly collapse-mode WHNF; the theorem is kept as a
+named bridge for the eventual `Methods.WF` field. -/
+theorem whnf_public_eq_whnfWithNatSuccMode (e : KExpr .anon) :
+    whnf e = whnfWithNatSuccMode e .collapse := rfl
+
+/-- Syntactic forms on which production `RecM.whnf` returns immediately,
+before tracing, statistics, cache lookup, fuel, or any method back-edge. -/
+inductive WhnfLeaf : KExpr .anon → Prop
+  | sort {u info} : WhnfLeaf (.sort u info)
+  | all {name bi ty body info} : WhnfLeaf (.all name bi ty body info)
+  | lam {name bi ty body info} : WhnfLeaf (.lam name bi ty body info)
+  | nat {value blob info} : WhnfLeaf (.nat value blob info)
+  | str {value blob info} : WhnfLeaf (.str value blob info)
+
+namespace WhnfLeaf
+
+/-- Exact operational equation for every immediate-return form. -/
+theorem eval {e : KExpr .anon} (h : WhnfLeaf e) :
+    RecM.whnf e = pure e := by
+  cases h <;> rfl
+
+end WhnfLeaf
+
+/-- Forms on which structural WHNF returns before key computation and cache
+access.  Unlike full WHNF, constants are leaves because core reduction never
+performs delta unfolding. -/
+inductive WhnfCoreLeaf : KExpr .anon → Prop
+  | sort {u info} : WhnfCoreLeaf (.sort u info)
+  | all {name bi ty body info} : WhnfCoreLeaf (.all name bi ty body info)
+  | lam {name bi ty body info} : WhnfCoreLeaf (.lam name bi ty body info)
+  | nat {value blob info} : WhnfCoreLeaf (.nat value blob info)
+  | str {value blob info} : WhnfCoreLeaf (.str value blob info)
+  | const {id us info} : WhnfCoreLeaf (.const id us info)
+
+namespace WhnfCoreLeaf
+
+/-- Exact production equation, uniform over full and cheap projection flags. -/
+theorem eval {e : KExpr .anon} (h : WhnfCoreLeaf e)
+    (flags : WhnfFlags) :
+    RecM.whnfCoreWithFlags e flags = pure e := by
+  cases h <;> rfl
+
+end WhnfCoreLeaf
+
+/-- Exact production step for successful legacy de-Bruijn zeta reduction.
+The lookup may grow only the intern table because it lifts the stored value
+to the current depth. -/
+theorem whnfCoreWithFlagsStep_varZeta
+    {methods : Methods .anon} {s s' : TcState .anon}
+    {idx : UInt64} {name : Mode.anon.F Name} {md : ExprInfo .anon}
+    {flags : WhnfFlags} {val : KExpr .anon}
+    (hlookup : TcM.lookupLetVal idx s = .ok (some val) s') :
+    (whnfCoreWithFlagsStep (.var idx name md) flags).run methods s =
+      .ok (.next val) s' := by
+  unfold whnfCoreWithFlagsStep
+  change EStateM.bind (TcM.lookupLetVal idx) _ s = _
+  unfold EStateM.bind
+  rw [hlookup]
+  rfl
+
+/-- Exact production step for let-bound fvar zeta reduction.  This branch
+is state-pure and does not consult the recursive method table. -/
+theorem whnfCoreWithFlagsStep_fvarZeta
+    {methods : Methods .anon} {s : TcState .anon}
+    {id : FVarId} {name : Mode.anon.F Name} {md : ExprInfo .anon}
+    {declName : Mode.anon.F Name} {ty val : KExpr .anon}
+    {flags : WhnfFlags}
+    (hfind : s.lctx.find? id = some (.ldecl declName ty val)) :
+    (whnfCoreWithFlagsStep (.fvar id name md) flags).run methods s =
+      .ok (.next val) s := by
+  unfold whnfCoreWithFlagsStep
+  rw [ReaderT.run_bind]
+  change EStateM.bind (get : TcM .anon (TcState .anon)) _ s = _
+  unfold EStateM.bind
+  rw [show (get : TcM .anon (TcState .anon)) s = .ok s s from rfl]
+  simp only
+  rw [hfind]
+  rfl
+
+/-- Exact production step for a direct one-argument beta redex.  The head
+callback equation is intentionally stronger than `Methods.WF`: semantic
+closure alone cannot force a callback to return this syntactic lambda. -/
+theorem whnfCoreWithFlagsStep_betaOne
+    {methods : Methods .anon} {s s' : TcState .anon}
+    {nm : Mode.anon.F Name} {bi : Mode.anon.F Lean.BinderInfo}
+    {ty body arg result : KExpr .anon}
+    {lamMd appMd : ExprInfo .anon} {flags : WhnfFlags}
+    (hhead : methods.whnfCoreFlags (.lam nm bi ty body lamMd) flags s =
+      .ok (.lam nm bi ty body lamMd) s)
+    (hwalk : TcM.runIntern (simulSubst body #[arg] 0) s = .ok result s') :
+    (whnfCoreWithFlagsStep
+      (.app (.lam nm bi ty body lamMd) arg appMd) flags).run methods s =
+      .ok (.next result) s' := by
+  unfold whnfCoreWithFlagsStep
+  rw [ReaderT.run_bind, ReaderT.run_pure, pure_bind]
+  simp only [KExpr.collectSpine, KExpr.collectSpine.go]
+  change EStateM.bind
+    (methods.whnfCoreFlags (.lam nm bi ty body lamMd) flags) _ s = _
+  unfold EStateM.bind
+  rw [hhead]
+  simp [consumeBetaLams, consumeBetaLamsFuel]
+  change ReaderT.run
+    (BoundedStep.next <$> liftM
+      (TcM.runIntern (simulSubst body #[arg] 0)) :
+        RecM .anon (BoundedStep (KExpr .anon) (KExpr .anon))) methods s = _
+  rw [ReaderT.run_map, ReaderT.run_monadLift]
+  rw [← bind_pure_comp]
+  change EStateM.bind (TcM.runIntern (simulSubst body #[arg] 0))
+    (fun r => pure (BoundedStep.next r)) s = _
+  unfold EStateM.bind
+  rw [hwalk]
+  rfl
+
+/-- Exact production step for a successful projection reduction.  Both the
+cheap and full value-WHNF policies are represented by the same explicit
+callback equation, followed by the actual `tryProjReduce` execution. -/
+theorem whnfCoreWithFlagsStep_projection
+    {methods : Methods .anon} {s s₁ s₂ : TcState .anon}
+    {id : KId .anon} {field : UInt64} {value wvalue result : KExpr .anon}
+    {info : ExprInfo .anon} {flags : WhnfFlags}
+    (hwhnf :
+      (if flags.cheapProj then
+          (whnfCoreFlagsRec value flags).run methods s
+        else (whnfRec value).run methods s) = .ok wvalue s₁)
+    (hreduce : (tryProjReduce id field wvalue).run methods s₁ =
+      .ok (some result) s₂) :
+    (whnfCoreWithFlagsStep (.prj id field value info) flags).run methods s =
+      .ok (.next result) s₂ := by
+  unfold whnfCoreWithFlagsStep
+  simp only
+  cases hcheap : flags.cheapProj <;>
+      simp only [hcheap, Bool.false_eq_true, ↓reduceIte] at hwhnf ⊢
+  all_goals
+    rw [ReaderT.run_bind]
+    change EStateM.bind _ _ s = _
+    unfold EStateM.bind
+    rw [hwhnf]
+    simp only
+    rw [ReaderT.run_bind]
+    change EStateM.bind
+      (ReaderT.run (tryProjReduce id field wvalue) methods) _ s₁ = _
+    unfold EStateM.bind
+    rw [hreduce]
+    rfl
+
+/-- Exact production step for a successful ordinary iota reduction after
+the recursive head callback returns the same recursor constant.  State
+changes made by that callback remain explicit as `s₁`; semantic closure does
+not imply the syntactic self-return equation. -/
+theorem whnfCoreWithFlagsStep_iota
+    {methods : Methods .anon} {s s₁ s₂ : TcState .anon}
+    {recId : KId .anon} {us : Array (KUniv .anon)}
+    {headInfo appInfo : ExprInfo .anon} {f arg result : KExpr .anon}
+    {args : Array (KExpr .anon)} {flags : WhnfFlags}
+    (hspine : (.app f arg appInfo : KExpr .anon).collectSpine =
+      (.const recId us headInfo, args))
+    (hhead : methods.whnfCoreFlags (.const recId us headInfo) flags s =
+      .ok (.const recId us headInfo) s₁)
+    (hself : ((.const recId us headInfo : KExpr .anon) !=
+      .const recId us headInfo) = false)
+    (hiota :
+      (tryIotaWithFlags (.app f arg appInfo) flags).run methods s₁ =
+        .ok (some result) s₂) :
+    (whnfCoreWithFlagsStep (.app f arg appInfo) flags).run methods s =
+      .ok (.next result) s₂ := by
+  unfold whnfCoreWithFlagsStep
+  rw [ReaderT.run_bind, ReaderT.run_pure, pure_bind]
+  rw [hspine]
+  change EStateM.bind
+    (methods.whnfCoreFlags (.const recId us headInfo) flags) _ s = _
+  unfold EStateM.bind
+  rw [hhead]
+  simp only
+  rw [hself]
+  change EStateM.bind
+    (ReaderT.run (tryIotaWithFlags (.app f arg appInfo) flags) methods) _
+      s₁ = _
+  unfold EStateM.bind
+  rw [hiota]
+  rfl
+
+/-- Every structural leaf terminates one named production loop iteration. -/
+theorem whnfCoreWithFlagsStep_leaf {methods : Methods .anon}
+    {s : TcState .anon} {e : KExpr .anon} (hleaf : WhnfCoreLeaf e)
+    (flags : WhnfFlags) :
+    (whnfCoreWithFlagsStep e flags).run methods s = .ok (.done e) s := by
+  cases hleaf <;> rfl
+
+/-- Generic two-iteration equation for the production bounded driver: one
+successful `.next` step followed by a structural leaf.  Keeping this seam
+branch-agnostic lets beta, both zeta paths, and later projection/iota proofs
+share the exact 10,000-fuel argument. -/
+theorem whnfCoreWithFlagsUncached_nextLeaf
+    {methods : Methods .anon} {s s' : TcState .anon}
+    {source result : KExpr .anon} {flags : WhnfFlags}
+    (hstep : (whnfCoreWithFlagsStep source flags).run methods s =
+      .ok (.next result) s')
+    (hleaf : WhnfCoreLeaf result) :
+    (whnfCoreWithFlagsUncached source flags).run methods s =
+      .ok result s' := by
+  unfold whnfCoreWithFlagsUncached
+  rw [show maxWhnfFuel.toNat = 10000 by rfl]
+  rw [RecM.runBounded]
+  rw [ReaderT.run_bind]
+  change EStateM.bind
+    (ReaderT.run (whnfCoreWithFlagsStep source flags) methods) _ s = _
+  unfold EStateM.bind
+  rw [hstep]
+  simp only
+  rw [RecM.runBounded.eq_def]
+  simp only
+  rw [ReaderT.run_bind]
+  change EStateM.bind
+    (ReaderT.run (whnfCoreWithFlagsStep result flags) methods) _ s' = _
+  unfold EStateM.bind
+  rw [whnfCoreWithFlagsStep_leaf hleaf]
+  rfl
+
+/-- The actual bounded structural-WHNF driver performs one successful
+projection step and terminates on the resulting structural leaf. -/
+theorem whnfCoreWithFlagsUncached_projection
+    {methods : Methods .anon} {s s₁ s₂ : TcState .anon}
+    {id : KId .anon} {field : UInt64} {value wvalue result : KExpr .anon}
+    {info : ExprInfo .anon} {flags : WhnfFlags}
+    (hwhnf :
+      (if flags.cheapProj then
+          (whnfCoreFlagsRec value flags).run methods s
+        else (whnfRec value).run methods s) = .ok wvalue s₁)
+    (hreduce : (tryProjReduce id field wvalue).run methods s₁ =
+      .ok (some result) s₂)
+    (hleaf : WhnfCoreLeaf result) :
+    (whnfCoreWithFlagsUncached (.prj id field value info) flags).run
+      methods s = .ok result s₂ :=
+  whnfCoreWithFlagsUncached_nextLeaf
+    (whnfCoreWithFlagsStep_projection hwhnf hreduce) hleaf
+
+/-- The actual bounded structural-WHNF driver performs one successful iota
+step and terminates on the resulting structural leaf. -/
+theorem whnfCoreWithFlagsUncached_iota
+    {methods : Methods .anon} {s s₁ s₂ : TcState .anon}
+    {recId : KId .anon} {us : Array (KUniv .anon)}
+    {headInfo appInfo : ExprInfo .anon} {f arg result : KExpr .anon}
+    {args : Array (KExpr .anon)} {flags : WhnfFlags}
+    (hspine : (.app f arg appInfo : KExpr .anon).collectSpine =
+      (.const recId us headInfo, args))
+    (hhead : methods.whnfCoreFlags (.const recId us headInfo) flags s =
+      .ok (.const recId us headInfo) s₁)
+    (hself : ((.const recId us headInfo : KExpr .anon) !=
+      .const recId us headInfo) = false)
+    (hiota :
+      (tryIotaWithFlags (.app f arg appInfo) flags).run methods s₁ =
+        .ok (some result) s₂)
+    (hleaf : WhnfCoreLeaf result) :
+    (whnfCoreWithFlagsUncached (.app f arg appInfo) flags).run methods s =
+      .ok result s₂ :=
+  whnfCoreWithFlagsUncached_nextLeaf
+    (whnfCoreWithFlagsStep_iota hspine hhead hself hiota) hleaf
+
+/-- Conditional K1e projection package.  The production execution is proved
+definitionally above; semantic validity and full invariant preservation are
+obtained only through the explicit inductive-reduction boundary, which also
+requires a translation of the original projection. -/
+theorem whnfCoreWithFlagsUncached_projection_acceptance
+    {layer : WhnfLayer} {semantics : CacheSemantics}
+    {trProj : RawProjRel} {world : VerifyWorld} {support : RunSupport}
+    (oracle : InductiveReductionOracle layer semantics trProj world support)
+    {uvars : Nat} {Δ : KVLCtx} {methods : Methods .anon}
+    {s s₁ s₂ : TcState .anon} {id : KId .anon} {field : UInt64}
+    {value wvalue result : KExpr .anon} {info : ExprInfo .anon}
+    {flags : WhnfFlags} {sourceV : VExpr}
+    (hmethods : Methods.WF layer semantics trProj world support methods)
+    (hsource : TrKExprS world.venv uvars world.nameOf trProj Δ
+      (.prj id field value info) sourceV)
+    (hI : WhnfStateInv layer semantics trProj world support uvars Δ s)
+    (hwhnf :
+      (if flags.cheapProj then
+          (whnfCoreFlagsRec value flags).run methods s
+        else (whnfRec value).run methods s) = .ok wvalue s₁)
+    (hreduce : (tryProjReduce id field wvalue).run methods s₁ =
+      .ok (some result) s₂)
+    (hleaf : WhnfCoreLeaf result) :
+    (whnfCoreWithFlagsUncached (.prj id field value info) flags).run
+        methods s = .ok result s₂ ∧
+      WhnfStateInv layer semantics trProj world support uvars Δ s₂ ∧
+      WhnfMeaning trProj world uvars Δ
+        (.prj id field value info) result := by
+  have hsemantic :=
+    oracle.projection hmethods hsource hI hwhnf hreduce
+  exact ⟨whnfCoreWithFlagsUncached_projection hwhnf hreduce hleaf,
+    hsemantic.1, hsemantic.2⟩
+
+/-- Conditional K1e iota package.  The source translation premise is
+load-bearing: an untrusted catalog recursor can drive the production helper
+without denoting a Theory term, as the adversarial fixture demonstrates. -/
+theorem whnfCoreWithFlagsUncached_iota_acceptance
+    {layer : WhnfLayer} {semantics : CacheSemantics}
+    {trProj : RawProjRel} {world : VerifyWorld} {support : RunSupport}
+    (oracle : InductiveReductionOracle layer semantics trProj world support)
+    {uvars : Nat} {Δ : KVLCtx} {methods : Methods .anon}
+    {s s₁ s₂ : TcState .anon} {recId : KId .anon}
+    {us : Array (KUniv .anon)} {headInfo appInfo : ExprInfo .anon}
+    {f arg result : KExpr .anon} {args : Array (KExpr .anon)}
+    {flags : WhnfFlags} {sourceV : VExpr}
+    (hmethods : Methods.WF layer semantics trProj world support methods)
+    (hsource : TrKExprS world.venv uvars world.nameOf trProj Δ
+      (.app f arg appInfo) sourceV)
+    (hI : WhnfStateInv layer semantics trProj world support uvars Δ s)
+    (hspine : (.app f arg appInfo : KExpr .anon).collectSpine =
+      (.const recId us headInfo, args))
+    (hhead : methods.whnfCoreFlags (.const recId us headInfo) flags s =
+      .ok (.const recId us headInfo) s₁)
+    (hself : ((.const recId us headInfo : KExpr .anon) !=
+      .const recId us headInfo) = false)
+    (hiota :
+      (tryIotaWithFlags (.app f arg appInfo) flags).run methods s₁ =
+        .ok (some result) s₂)
+    (hleaf : WhnfCoreLeaf result) :
+    (whnfCoreWithFlagsUncached (.app f arg appInfo) flags).run methods s =
+        .ok result s₂ ∧
+      WhnfStateInv layer semantics trProj world support uvars Δ s₂ ∧
+      WhnfMeaning trProj world uvars Δ (.app f arg appInfo) result := by
+  have hsemantic :=
+    oracle.iota hmethods hsource hI hspine hhead hself hiota
+  exact ⟨whnfCoreWithFlagsUncached_iota hspine hhead hself hiota hleaf,
+    hsemantic.1, hsemantic.2⟩
+
+/-- The actual bounded structural-WHNF driver performs successful legacy
+zeta and terminates when the lifted value is a structural leaf. -/
+theorem whnfCoreWithFlagsUncached_varZeta
+    {methods : Methods .anon} {s s' : TcState .anon}
+    {idx : UInt64} {name : Mode.anon.F Name} {md : ExprInfo .anon}
+    {flags : WhnfFlags} {val : KExpr .anon}
+    (hlookup : TcM.lookupLetVal idx s = .ok (some val) s')
+    (hleaf : WhnfCoreLeaf val) :
+    (whnfCoreWithFlagsUncached (.var idx name md) flags).run methods s =
+      .ok val s' :=
+  whnfCoreWithFlagsUncached_nextLeaf
+    (whnfCoreWithFlagsStep_varZeta hlookup) hleaf
+
+/-- The actual bounded structural-WHNF driver performs let-bound fvar zeta
+and terminates when the stored value is a structural leaf. -/
+theorem whnfCoreWithFlagsUncached_fvarZeta
+    {methods : Methods .anon} {s : TcState .anon}
+    {id : FVarId} {name : Mode.anon.F Name} {md : ExprInfo .anon}
+    {declName : Mode.anon.F Name} {ty val : KExpr .anon}
+    {flags : WhnfFlags}
+    (hfind : s.lctx.find? id = some (.ldecl declName ty val))
+    (hleaf : WhnfCoreLeaf val) :
+    (whnfCoreWithFlagsUncached (.fvar id name md) flags).run methods s =
+      .ok val s :=
+  whnfCoreWithFlagsUncached_nextLeaf
+    (whnfCoreWithFlagsStep_fvarZeta hfind) hleaf
+
+/-- K1d legacy-zeta package.  The execution-indexed lift walker supplies the
+exact production result and intern-only frame; the reconciled context
+supplies the same inlined Theory value, so operational execution, invariant
+preservation, and semantic meaning are established together. -/
+theorem whnfCoreWithFlagsUncached_varZeta_acceptance
+    {α : Type} {initial : TcState .anon} {program : TcM .anon α}
+    {requests : List WalkerRequest} {support : RunSupport}
+    (hrun : RunAssumptions initial program requests support)
+    {layer : WhnfLayer} {semantics : CacheSemantics}
+    {trProj : RawProjRel} {world : VerifyWorld} {uvars : Nat}
+    {Δ : KVLCtx} {methods : Methods .anon} {s : TcState .anon}
+    {idx : UInt64} {name : Mode.anon.F Name} {md : ExprInfo .anon}
+    {ty val : KExpr .anon} {flags : WhnfFlags}
+    (htp : TrProjOK world.venv uvars trProj)
+    (hmem : WalkerRequest.lift val (idx + 1) 0 ∈ requests)
+    (hI : WhnfStateInv layer semantics trProj world support uvars Δ s)
+    (hidx : idx.toNat < s.ctx.size)
+    (hty : s.ctx[s.ctx.size - 1 - idx.toNat]? = some ty)
+    (hov : s.letVals[s.ctx.size - 1 - idx.toNat]? = some (some val))
+    (hbig : Δ.bvars + val.size < UInt64.size)
+    (hleaf : WhnfCoreLeaf (KExpr.liftSpec val (idx + 1) 0)) :
+    ∃ s',
+      (whnfCoreWithFlagsUncached (.var idx name md) flags).run methods s =
+          .ok (KExpr.liftSpec val (idx + 1) 0) s' ∧
+      WhnfStateInv layer semantics trProj world support uvars Δ s' ∧
+      InternUpdateFrame s s' ∧
+      WhnfMeaning trProj world uvars Δ (.var idx name md)
+        (KExpr.liftSpec val (idx + 1) 0) := by
+  obtain ⟨s', hlift, hI', hframe⟩ := hrun.lift_whnf_eval hmem hI
+  have hbang : s.letVals[s.ctx.size - 1 - idx.toNat]! = some val := by
+    obtain ⟨hbound, hvalue⟩ := getElem?_eq_some_iff.mp hov
+    rw [getElem!_pos s.letVals (s.ctx.size - 1 - idx.toNat) hbound,
+      hvalue]
+  have hlookup := TcM.lookupLetVal_eval hidx hbang hlift
+  have hsz : s.ctx.size < UInt64.size := by
+    rw [← hI.2.1.bvars_eq]
+    omega
+  exact ⟨s', whnfCoreWithFlagsUncached_varZeta hlookup hleaf,
+    hI', hframe,
+    WhnfMeaning.zetaVar hI.2.1 htp hidx hsz hty hov hbig⟩
+
+/-- K1d fvar-zeta package.  Unlike the legacy branch this execution is
+state-pure.  `hclosed` is intentionally visible: without it, a mixed context
+may have newer de Bruijn frames and production's unchanged stored value is
+not justified by `CtxRecon`. -/
+theorem whnfCoreWithFlagsUncached_fvarZeta_acceptance
+    {layer : WhnfLayer} {semantics : CacheSemantics}
+    {trProj : RawProjRel} {world : VerifyWorld} {support : RunSupport}
+    {uvars : Nat} {Δ : KVLCtx} {methods : Methods .anon}
+    {s : TcState .anon} {fv : FVarId}
+    {name : Mode.anon.F Name} {md : ExprInfo .anon}
+    {declName : Mode.anon.F Name} {ty val : KExpr .anon}
+    {flags : WhnfFlags}
+    (htp : TrProjOK world.venv uvars trProj)
+    (hI : WhnfStateInv layer semantics trProj world support uvars Δ s)
+    (hfind : s.lctx.find? fv = some (.ldecl declName ty val))
+    (hcon : KExpr.Constructed val) (hclosed : val.lbr = 0)
+    (hbig : Δ.bvars + val.size < UInt64.size)
+    (hleaf : WhnfCoreLeaf val) :
+    (whnfCoreWithFlagsUncached (.fvar fv name md) flags).run methods s =
+        .ok val s ∧
+      WhnfStateInv layer semantics trProj world support uvars Δ s ∧
+      WhnfMeaning trProj world uvars Δ (.fvar fv name md) val :=
+  ⟨whnfCoreWithFlagsUncached_fvarZeta hfind hleaf, hI,
+    WhnfMeaning.zetaFVar hI.2.1 htp hfind hcon hclosed hbig⟩
+
+/-- The actual 10,000-iteration production driver performs the direct beta
+step and then terminates when the walker result is a structural leaf. -/
+theorem whnfCoreWithFlagsUncached_betaOne
+    {methods : Methods .anon} {s s' : TcState .anon}
+    {nm : Mode.anon.F Name} {bi : Mode.anon.F Lean.BinderInfo}
+    {ty body arg result : KExpr .anon}
+    {lamMd appMd : ExprInfo .anon} {flags : WhnfFlags}
+    (hhead : methods.whnfCoreFlags (.lam nm bi ty body lamMd) flags s =
+      .ok (.lam nm bi ty body lamMd) s)
+    (hwalk : TcM.runIntern (simulSubst body #[arg] 0) s = .ok result s')
+    (hleaf : WhnfCoreLeaf result) :
+    (whnfCoreWithFlagsUncached
+      (.app (.lam nm bi ty body lamMd) arg appMd) flags).run methods s =
+      .ok result s' := by
+  unfold whnfCoreWithFlagsUncached
+  rw [show maxWhnfFuel.toNat = 10000 by rfl]
+  rw [RecM.runBounded]
+  rw [ReaderT.run_bind]
+  change EStateM.bind
+    (ReaderT.run (whnfCoreWithFlagsStep
+      (.app (.lam nm bi ty body lamMd) arg appMd) flags) methods) _ s = _
+  unfold EStateM.bind
+  rw [whnfCoreWithFlagsStep_betaOne hhead hwalk]
+  simp only
+  rw [RecM.runBounded.eq_def]
+  simp only
+  rw [ReaderT.run_bind]
+  change EStateM.bind
+    (ReaderT.run (whnfCoreWithFlagsStep result flags) methods) _ s' = _
+  unfold EStateM.bind
+  rw [whnfCoreWithFlagsStep_leaf hleaf]
+  rfl
+
+/-- Compose the production beta branch with the execution-indexed verified
+walker.  This proves both the concrete result and full post-state invariant;
+the only algorithm-specific premise left is the exact recursive-head callback
+equation described above. -/
+theorem whnfCoreWithFlagsUncached_betaOne_wf
+    {α : Type} {initial : TcState .anon} {program : TcM .anon α}
+    {requests : List WalkerRequest} {support : RunSupport}
+    (hrun : RunAssumptions initial program requests support)
+    {layer : WhnfLayer} {semantics : CacheSemantics}
+    {trProj : RawProjRel} {world : VerifyWorld} {uvars : Nat}
+    {Δ : KVLCtx} {methods : Methods .anon} {s : TcState .anon}
+    {nm : Mode.anon.F Name} {bi : Mode.anon.F Lean.BinderInfo}
+    {ty body arg : KExpr .anon} {lamMd appMd : ExprInfo .anon}
+    {flags : WhnfFlags}
+    (hmem : WalkerRequest.simulSubst body #[arg] 0 ∈ requests)
+    (hI : WhnfStateInv layer semantics trProj world support uvars Δ s)
+    (hhead : methods.whnfCoreFlags (.lam nm bi ty body lamMd) flags s =
+      .ok (.lam nm bi ty body lamMd) s)
+    (hleaf : WhnfCoreLeaf (KExpr.simulSubstSpec body #[arg] 0)) :
+    ∃ s',
+      (whnfCoreWithFlagsUncached
+        (.app (.lam nm bi ty body lamMd) arg appMd) flags).run methods s =
+          .ok (KExpr.simulSubstSpec body #[arg] 0) s' ∧
+      WhnfStateInv layer semantics trProj world support uvars Δ s' ∧
+      InternUpdateFrame s s' := by
+  obtain ⟨s', hwalk, hI', hframe⟩ :=
+    hrun.simulSubst_whnf_eval hmem hI
+  exact ⟨s', whnfCoreWithFlagsUncached_betaOne hhead hwalk hleaf,
+    hI', hframe⟩
+
+/-- First algorithmic K1 slice: all immediate-return WHNF forms preserve the
+complete fixed-world/context/cache invariant and their exact Theory meaning.
+The theorem is layer-polymorphic because these branches never inspect
+`noAccel` and never consume a `NativeOracle`. -/
+theorem whnf_leaf_wf {layer : WhnfLayer} {semantics : CacheSemantics}
+    {trProj : RawProjRel} {world : VerifyWorld} {support : RunSupport}
+    {uvars : Nat} {Δ : KVLCtx} {s : TcState .anon}
+    {e : KExpr .anon} {sourceV : VExpr}
+    (hleaf : WhnfLeaf e)
+    (htr : TrKExprS world.venv uvars world.nameOf trProj Δ e sourceV)
+    (hwf : VExpr.WF world.venv uvars Δ.toCtx sourceV) :
+    RecM.WF layer semantics trProj world support uvars Δ s (RecM.whnf e)
+      (fun result _ => WhnfPost trProj world uvars Δ sourceV result) := by
+  intro methods hmethods
+  rw [hleaf.eval]
+  exact TcM.WF.pure fun hI => WhnfPost.refl htr hwf
+
+/-- Convenient derived leaf theorem when the caller carries the uniform
+literal/projection Theory bundle instead of an expression-specific WF fact. -/
+theorem whnf_leaf_wf_of_theory {layer : WhnfLayer}
+    {semantics : CacheSemantics} {trProj : RawProjRel}
+    {world : VerifyWorld} {support : RunSupport} {uvars : Nat}
+    {Δ : KVLCtx} {s : TcState .anon} {e : KExpr .anon}
+    {sourceV : VExpr} (theory : WhnfTheory trProj world uvars)
+    (hleaf : WhnfLeaf e)
+    (htr : TrKExprS world.venv uvars world.nameOf trProj Δ e sourceV) :
+    RecM.WF layer semantics trProj world support uvars Δ s (RecM.whnf e)
+      (fun result _ => WhnfPost trProj world uvars Δ sourceV result) := by
+  intro methods hmethods
+  rw [hleaf.eval]
+  exact TcM.WF.pure fun hI =>
+    WhnfPost.refl htr (theory.exprWF hI.2.1 htr)
+
+/-- Immediate structural-WHNF forms preserve the complete K1 invariant and
+have reflexive Theory meaning.  This covers the actual flag-parametric core
+entry point, including constants and the cheap projection policy. -/
+theorem whnfCoreWithFlags_leaf_wf {layer : WhnfLayer}
+    {semantics : CacheSemantics} {trProj : RawProjRel}
+    {world : VerifyWorld} {support : RunSupport} {uvars : Nat}
+    {Δ : KVLCtx} {s : TcState .anon} {e : KExpr .anon}
+    {sourceV : VExpr} {flags : WhnfFlags}
+    (hleaf : WhnfCoreLeaf e)
+    (htr : TrKExprS world.venv uvars world.nameOf trProj Δ e sourceV)
+    (hwf : VExpr.WF world.venv uvars Δ.toCtx sourceV) :
+    RecM.WF layer semantics trProj world support uvars Δ s
+      (RecM.whnfCoreWithFlags e flags)
+      (fun result _ => WhnfPost trProj world uvars Δ sourceV result) := by
+  intro methods hmethods
+  rw [hleaf.eval]
+  exact TcM.WF.pure fun _ => WhnfPost.refl htr hwf
+
+end RecM
+
+/-! ## Acceleration boundary -/
+
+/-- Named semantic boundary for the four production acceleration gates.
+Each field is indexed by the actual helper execution, the concrete state,
+and a semantically closed recursive method table.  It asserts only the
+successful accelerated step; state preservation remains part of the WHNF
+Hoare proof.  Primitive-specific refinements can split these fields without
+changing `WhnfMeaning` or the no-acceleration theorem layer. -/
+structure NativeOracle (semantics : CacheSemantics) (trProj : RawProjRel)
+    (world : VerifyWorld) (support : RunSupport) : Prop where
+  native : ∀ {uvars Δ methods s e result s'},
+    methods.WF .accelerated semantics trProj world support →
+    WhnfStateInv .accelerated semantics trProj world support uvars Δ s →
+    (RecM.tryReduceNative e).run methods s = .ok (some result) s' →
+    WhnfMeaning trProj world uvars Δ e result
+  bitvec : ∀ {uvars Δ methods s e result s'},
+    methods.WF .accelerated semantics trProj world support →
+    WhnfStateInv .accelerated semantics trProj world support uvars Δ s →
+    (RecM.tryReduceBitvec e).run methods s = .ok (some result) s' →
+    WhnfMeaning trProj world uvars Δ e result
+  decidable : ∀ {uvars Δ methods s e result s'},
+    methods.WF .accelerated semantics trProj world support →
+    WhnfStateInv .accelerated semantics trProj world support uvars Δ s →
+    (RecM.tryReduceDecidable e).run methods s = .ok (some result) s' →
+    WhnfMeaning trProj world uvars Δ e result
+  finVal : ∀ {uvars Δ methods s id field value head args info result s'},
+    methods.WF .accelerated semantics trProj world support →
+    WhnfStateInv .accelerated semantics trProj world support uvars Δ s →
+    value.collectSpine = (head, args) →
+    (RecM.tryReduceFinValDecidableRec id field head args).run methods s =
+      .ok (some result) s' →
+    WhnfMeaning trProj world uvars Δ (.prj id field value info) result
+
+namespace RecM
+
+/-- With `noAccel` pinned, the general native helper returns `none` without
+changing state and without consulting the method table. -/
+theorem tryReduceNative_noAccel {methods : Methods .anon}
+    {s : TcState .anon} (h : s.noAccel = true) (e : KExpr .anon) :
+    (tryReduceNative e).run methods s = .ok none s := by
+  unfold tryReduceNative
+  rw [ReaderT.run_bind]
+  change (EStateM.bind EStateM.get _) s = _
+  simp [EStateM.bind, EStateM.get, h]
+  rfl
+
+/-- The BitVec acceleration gate is absent from the no-acceleration layer. -/
+theorem tryReduceBitvec_noAccel {methods : Methods .anon}
+    {s : TcState .anon} (h : s.noAccel = true) (e : KExpr .anon) :
+    (tryReduceBitvec e).run methods s = .ok none s := by
+  unfold tryReduceBitvec
+  rw [ReaderT.run_bind]
+  change (EStateM.bind EStateM.get _) s = _
+  simp [EStateM.bind, EStateM.get, h]
+  rfl
+
+/-- The Decidable synthesis acceleration gate is absent from the
+no-acceleration layer. -/
+theorem tryReduceDecidable_noAccel {methods : Methods .anon}
+    {s : TcState .anon} (h : s.noAccel = true) (e : KExpr .anon) :
+    (tryReduceDecidable e).run methods s = .ok none s := by
+  unfold tryReduceDecidable
+  rw [ReaderT.run_bind]
+  change (EStateM.bind EStateM.get _) s = _
+  simp [EStateM.bind, EStateM.get, h]
+  rfl
+
+/-- The specialized `Fin.val`/`Decidable.rec` acceleration gate is absent
+from the no-acceleration layer. -/
+theorem tryReduceFinValDecidableRec_noAccel {methods : Methods .anon}
+    {s : TcState .anon} (h : s.noAccel = true) (id : KId .anon)
+    (field : UInt64) (head : KExpr .anon) (args : Array (KExpr .anon)) :
+    (tryReduceFinValDecidableRec id field head args).run methods s =
+      .ok none s := by
+  unfold tryReduceFinValDecidableRec
+  rw [ReaderT.run_bind]
+  change (EStateM.bind EStateM.get _) s = _
+  simp [EStateM.bind, EStateM.get, h]
+  rfl
+
+end RecM
+
+end Ix.Tc
diff --git a/Ix/Tc/Verify/World.lean b/Ix/Tc/Verify/World.lean
new file mode 100644
index 00000000..63d864e1
--- /dev/null
+++ b/Ix/Tc/Verify/World.lean
@@ -0,0 +1,234 @@
+import Ix.Tc.Env
+import Lean4Lean.Theory.Typing.Env
+
+/-!
+# Non-circular verification worlds
+
+This is the additive G1a model.  It separates four things which the old
+whole-`KEnv` relation conflates:
+
+* `Catalog`: immutable ghost input, including pending and unrelated
+  declarations;
+* `VerifyWorld.trusted`: the ghost index intended to track declarations
+  already admitted to the semantic world;
+* `VerifyWorld.venv`: the well-formed Lean4Lean environment for that trusted
+  world;
+* `LoadedAgrees`: the one-way relation from the concrete lazy-load cache to
+  the catalog.
+
+Crucially, being catalogued is not a typing fact.  `VerifyWorld.ofCatalog`
+accepts an arbitrary catalog while trusting nothing, and `LoadedAgrees` does
+not require every catalog entry to be loaded.  The trusted-catalog semantic
+log is deliberately not faked as a bare structure field: G1c's
+`TrustedCatalogRel` in `Verify/Env.lean` is an explicit proof object connecting
+`trusted` to `venv`.  Consumers must carry that relation before treating
+trusted membership as a WF witness.
+
+This module was introduced beside the old whole-`KEnv` relation in G1a.
+`Verify/State.lean` now uses it for `TcInv`, and G2b consumers resolve exact
+constants through `TrustedConstRel`. The legacy `TrKEnv` remains only as a
+quarantined compatibility proof interface.
+-/
+
+namespace Ix.Tc
+
+open Lean4Lean (VEnv)
+
+/-- Immutable ghost input.  A catalog entry says which concrete declaration
+is committed at an id; it says nothing about that declaration's typing. -/
+abbrev Catalog := KId .anon → Option (KConst .anon)
+
+namespace Catalog
+
+/-- The empty declaration catalog. -/
+def empty : Catalog := fun _ => none
+
+/-- `id` has a concrete declaration in the catalog. -/
+def Contains (catalog : Catalog) (id : KId .anon) : Prop :=
+  ∃ c, catalog id = some c
+
+@[simp] theorem empty_apply (id : KId .anon) : empty id = none := rfl
+
+end Catalog
+
+/-- Ghost semantic state for verification.
+
+`trustedCatalogued` is representation coherence only.  It prevents the
+trusted index from naming a declaration absent from the immutable input, but
+does not assert `KConst`/`VConstant` translation or any WF judgment.  Those
+semantic witnesses belong to `TrustedCatalogRel`. -/
+structure VerifyWorld where
+  catalog : Catalog
+  trusted : KId .anon → Prop
+  venv : VEnv
+  nameOf : Address → Option Lean.Name
+  venvWF : venv.WF
+  trustedCatalogued : ∀ {id}, trusted id → Catalog.Contains catalog id
+
+namespace VerifyWorld
+
+/-- An arbitrary immutable catalog with no trusted declarations and an empty
+semantic environment.  No premise asks the catalog declarations to be
+well-typed. -/
+def ofCatalog (catalog : Catalog) : VerifyWorld where
+  catalog := catalog
+  trusted := fun _ => False
+  venv := .empty
+  nameOf := fun _ => none
+  venvWF := ⟨[], .empty⟩
+  trustedCatalogued := fun {_} h => False.elim h
+
+/-- The completely empty verification world. -/
+def empty : VerifyWorld := ofCatalog Catalog.empty
+
+@[simp] theorem ofCatalog_catalog (catalog : Catalog) :
+    (ofCatalog catalog).catalog = catalog := rfl
+
+@[simp] theorem ofCatalog_trusted (catalog : Catalog) (id : KId .anon) :
+    ¬(ofCatalog catalog).trusted id := fun h => h
+
+@[simp] theorem ofCatalog_venv (catalog : Catalog) :
+    (ofCatalog catalog).venv = .empty := rfl
+
+/-- Adversarial sanity check for the new boundary: a declaration can be
+catalogued without becoming trusted.  There is intentionally no WF premise. -/
+theorem ofCatalog_catalogued_not_trusted {catalog : Catalog}
+    {id : KId .anon} {c : KConst .anon} (h : catalog id = some c) :
+    Catalog.Contains (ofCatalog catalog).catalog id ∧
+      ¬(ofCatalog catalog).trusted id :=
+  ⟨⟨c, h⟩, ofCatalog_trusted _ _⟩
+
+/-- World extension keeps immutable input and address-to-name assignment
+fixed, while allowing the trusted index and its well-formed semantic
+environment to grow.  Concrete lazy-loaded entries are related separately
+by `LoadedExtension` below because they live in `KEnv`, not `VerifyWorld`. -/
+protected structure LE (before after : VerifyWorld) : Prop where
+  catalog : before.catalog = after.catalog
+  nameOf : before.nameOf = after.nameOf
+  trusted : ∀ {id}, before.trusted id → after.trusted id
+  venv : before.venv ≤ after.venv
+
+instance : LE VerifyWorld := ⟨VerifyWorld.LE⟩
+
+namespace LE
+
+theorem rfl {world : VerifyWorld} : world ≤ world :=
+  ⟨Eq.refl _, Eq.refl _, fun {_} h => h, VEnv.LE.rfl⟩
+
+theorem trans {a b c : VerifyWorld} (hab : a ≤ b) (hbc : b ≤ c) : a ≤ c :=
+  ⟨hab.catalog.trans hbc.catalog,
+    hab.nameOf.trans hbc.nameOf,
+    fun {_} h => hbc.trusted (hab.trusted h),
+    hab.venv.trans hbc.venv⟩
+
+/-- Catalog membership is invariant under world extension. -/
+theorem catalogued_iff {before after : VerifyWorld} (h : before ≤ after)
+    {id : KId .anon} :
+    Catalog.Contains before.catalog id ↔
+      Catalog.Contains after.catalog id := by
+  rw [h.catalog]
+
+end LE
+
+end VerifyWorld
+
+/-- Every concrete constant currently loaded in `env` is exactly the entry
+committed by `catalog`.  The implication is intentionally one-way: catalog
+entries may remain unloaded under lazy ingress. -/
+def LoadedAgrees (catalog : Catalog) (env : KEnv .anon) : Prop :=
+  ∀ {id c}, env.get? id = some c → catalog id = some c
+
+namespace LoadedAgrees
+
+theorem lookup {catalog : Catalog} {env : KEnv .anon}
+    (h : LoadedAgrees catalog env) {id : KId .anon} {c : KConst .anon}
+    (hget : env.get? id = some c) : catalog id = some c :=
+  h hget
+
+/-- Empty concrete state agrees with every catalog, including a nonempty or
+ill-typed one.  This is the lazy-load direction of the relation. -/
+theorem empty (catalog : Catalog) :
+    LoadedAgrees catalog ({} : KEnv .anon) := by
+  intro id c hget
+  simp [KEnv.get?] at hget
+
+/-- Since world extension fixes the catalog, loaded agreement is invariant
+under it. -/
+theorem world_iff {before after : VerifyWorld} (h : before ≤ after)
+    {env : KEnv .anon} :
+    LoadedAgrees before.catalog env ↔ LoadedAgrees after.catalog env := by
+  rw [h.catalog]
+
+section Insert
+
+variable [LawfulBEq (KId .anon)] [LawfulHashable (KId .anon)]
+
+/-- A lazy-load insertion preserves agreement when the inserted declaration
+is the catalog entry.  The lawfulness instances are hypotheses here; G1a
+does not move the existing global instances out of `Verify/Env.lean`. -/
+theorem insert {catalog : Catalog} {env : KEnv .anon}
+    (h : LoadedAgrees catalog env) {id : KId .anon} {c : KConst .anon}
+    (hc : catalog id = some c) : LoadedAgrees catalog (env.insert id c) := by
+  intro j d hget
+  simp only [KEnv.get?, KEnv.insert, Std.HashMap.getElem?_insert] at hget
+  split at hget
+  · next heq =>
+    cases hget
+    have hij : id = j := eq_of_beq heq
+    subst j
+    exact hc
+  · exact h hget
+
+end Insert
+
+end LoadedAgrees
+
+/-- The loaded-constant portion of a concrete environment only grows.  Cache,
+intern-table, block, and fuel evolution are intentionally outside this
+relation and will be conjoined by the later state invariant. -/
+structure LoadedExtension (before after : KEnv .anon) : Prop where
+  consts : ∀ {id c}, before.get? id = some c → after.get? id = some c
+
+namespace LoadedExtension
+
+theorem rfl {env : KEnv .anon} : LoadedExtension env env :=
+  ⟨fun {_ _} h => h⟩
+
+theorem trans {a b c : KEnv .anon} (hab : LoadedExtension a b)
+    (hbc : LoadedExtension b c) : LoadedExtension a c :=
+  ⟨fun {_ _} h => hbc.consts (hab.consts h)⟩
+
+end LoadedExtension
+
+/-- Agreement of a larger loaded cache implies agreement of every earlier
+loaded-cache prefix. -/
+theorem LoadedAgrees.of_extension {catalog : Catalog} {before after : KEnv .anon}
+    (hext : LoadedExtension before after) (h : LoadedAgrees catalog after) :
+    LoadedAgrees catalog before :=
+  fun {_ _} hget => h (hext.consts hget)
+
+/-- `ofCatalog` is inhabited together with an empty concrete load cache for
+every catalog, without a declaration-WF premise. -/
+theorem VerifyWorld.ofCatalog_loaded (catalog : Catalog) :
+    LoadedAgrees (VerifyWorld.ofCatalog catalog).catalog ({} : KEnv .anon) :=
+  LoadedAgrees.empty catalog
+
+section CataloguedLoaded
+
+variable [LawfulBEq (KId .anon)] [LawfulHashable (KId .anon)]
+
+/-- Stronger adversarial fixture: an arbitrary catalog declaration may be
+present in the concrete lazy-load cache while remaining untrusted.  The
+construction needs exact catalog agreement, but deliberately no translation
+or declaration-WF witness. -/
+theorem VerifyWorld.ofCatalog_loaded_not_trusted {catalog : Catalog}
+    {id : KId .anon} {c : KConst .anon} (hcat : catalog id = some c) :
+    LoadedAgrees (VerifyWorld.ofCatalog catalog).catalog
+        (({} : KEnv .anon).insert id c) ∧
+      ¬(VerifyWorld.ofCatalog catalog).trusted id :=
+  ⟨LoadedAgrees.insert (LoadedAgrees.empty catalog) hcat,
+    VerifyWorld.ofCatalog_trusted _ _⟩
+
+end CataloguedLoaded
+
+end Ix.Tc
diff --git a/Ix/Tc/Whnf.lean b/Ix/Tc/Whnf.lean
index 0ad1c120..337b1dc1 100644
--- a/Ix/Tc/Whnf.lean
+++ b/Ix/Tc/Whnf.lean
@@ -42,28 +42,6 @@ open Std (HashMap HashSet)
 /-- Local fuel cap for whnf on *open* arguments of the Nat reducer. -/
 def natReducerOpenArgRecFuel : UInt64 := 4096
 
-/-- Reduction-policy flags (whnf.rs `WhnfFlags`). -/
-structure WhnfFlags where
-  cheapRec : Bool
-  cheapProj : Bool
-  deriving BEq, Repr, Inhabited
-
-namespace WhnfFlags
-
-def FULL : WhnfFlags := ⟨false, false⟩
-def DEF_EQ_CORE : WhnfFlags := ⟨false, true⟩
-
-@[inline] def isFull (f : WhnfFlags) : Bool := !f.cheapRec && !f.cheapProj
-
-end WhnfFlags
-
-/-- Nat succ-collapse policy: `stuck` bypasses whnf caches and disables the
-    succ-chain collapse (used inside the succ-peeling loop itself). -/
-inductive NatSuccMode where
-  | collapse
-  | stuck
-  deriving BEq, Repr, Inhabited
-
 /-- Recursor info snapshot for iota reduction (tc.rs `IotaInfo`). -/
 structure IotaInfo (m : Mode) where
   k : Bool
@@ -92,18 +70,19 @@ def extractNatLit (e : KExpr m) (prims : Primitives m) : Option Nat :=
   | _ => none
 
 /-- Nat value from literal form or a constructor numeral
-    (`Nat.succ (Nat.succ …(lit)…)`). -/
-partial def extractNatValue (e : KExpr m) (prims : Primitives m) : Option Nat :=
+    (`Nat.succ (Nat.succ …(lit)…)`). Exactly one application is accepted at
+    each successor layer, matching the former `collectSpine`/size check. -/
+def extractNatValue (e : KExpr m) (prims : Primitives m) : Option Nat :=
   match extractNatLit e prims with
   | some n => some n
   | none =>
-    let (head, args) := e.collectSpine
-    match head with
-    | .const id _ _ =>
-      if id.addr == prims.natSucc.addr && args.size == 1 then
-        (extractNatValue args[0]! prims).map (· + 1)
+    match e with
+    | .app (.const id _ _) arg _ =>
+      if id.addr == prims.natSucc.addr then
+        (extractNatValue arg prims).map (· + 1)
       else none
     | _ => none
+termination_by structural e
 
 /-- Binary Nat op evaluation. `none` when uncomputable (pow exponent above
     the kernel cap, shift beyond u64) — caller leaves the term unreduced. -/
@@ -143,7 +122,7 @@ def extractIntLit (e : KExpr m) (prims : Primitives m) : Option _root_.Int :=
 
 /-- Arity/field info when a definition body is a projection wrapper
     `λ…λ. Prj(S, f, Var k)` (whnf.rs `projection_definition_info`). -/
-partial def projectionDefinitionInfo (val : KExpr m) :
+def projectionDefinitionInfo (val : KExpr m) :
     Option (Nat × KId m × UInt64 × Nat) :=
   go val 0
 where
@@ -157,6 +136,7 @@ where
         else some (arity, structId, field, arity - 1 - idx.toNat)
       | _ => none
     | _ => none
+  termination_by structural cur
 
 namespace RecM
 
@@ -258,13 +238,350 @@ def finishAppResult (result₀ : KExpr m) (args : Array (KExpr m))
     result ← TcM.intern (KExpr.mkApp result arg)
   return result
 
+/-! ### Bounded Nat-offset parsing (Tier B)
+
+The public API carries the historical `depth`; the total workers carry the
+equivalent remaining budget `256 - depth` so every recursive call is visibly
+decreasing and the old cutoff result is unchanged.
+-/
+
+mutual
+
+def natOffsetFuel : Nat → KExpr m → RecM m (Option (KExpr m × Nat))
+  | 0, _ => pure none
+  | fuel + 1, e => do
+    let (head, args) := e.collectSpine
+    let .const id _ _ := head | return none
+    let p ← prims
+    if id.addr == p.natSucc.addr && args.size == 1 then
+      let arg := args[0]!
+      let (base, offset) := (← natOffsetFuel fuel arg).getD (arg, 0)
+      return some (base, offset + 1)
+    if id.addr == p.natAdd.addr && args.size == 2 then
+      let some rhs ← evalNatOffsetLiteralFuel fuel args[1]! | return none
+      let arg := args[0]!
+      let (base, offset) := (← natOffsetFuel fuel arg).getD (arg, 0)
+      return some (base, offset + rhs)
+    return none
+
+/-- Syntactic, no-delta evaluator for Nat offset constants (weaker than
+    WHNF by design), indexed by its remaining historical depth budget. -/
+def evalNatOffsetLiteralFuel : Nat → KExpr m → RecM m (Option Nat)
+  | 0, _ => pure none
+  | fuel + 1, e => do
+    let p ← prims
+    if let some n := extractNatValue e p then
+      return some n
+    let (head, args) := e.collectSpine
+    let .const id _ _ := head | return none
+    if id.addr == p.natPred.addr && args.size == 1 then
+      let some n ← evalNatOffsetLiteralFuel fuel args[0]! | return none
+      return some (n - 1)
+    if (← isNatBinArithAddr id.addr) && args.size == 2 then
+      let some a ← evalNatOffsetLiteralFuel fuel args[0]! | return none
+      let some b ← evalNatOffsetLiteralFuel fuel args[1]! | return none
+      return computeNatBin id.addr PrimAddrs.canonical a b
+    return none
+
+end
+
+def natOffset (e : KExpr m) (depth : Nat) :
+    RecM m (Option (KExpr m × Nat)) :=
+  natOffsetFuel (256 - depth) e
+
+def natOffsetOrZero (e : KExpr m) (depth : Nat) :
+    RecM m (KExpr m × Nat) := do
+  return (← natOffset e depth).getD (e, 0)
+
+def evalNatOffsetLiteral (e : KExpr m) (depth : Nat) :
+    RecM m (Option Nat) :=
+  evalNatOffsetLiteralFuel (256 - depth) e
+
+/-! ### Non-recursive WHNF helpers
+
+These helpers used to live in the large recursive WHNF mutual block even
+though none of them takes a recursive edge.  Keeping them outside that block
+makes their equations transparent to the K0 proofs without adding runtime
+fuel or changing their operational behavior.
+-/
+
+/-- Universe-instantiated body of an unfolded head, cached by the head
+    `const` expression's content hash (lean4 C++ `m_unfold` cache). -/
+def unfoldConstValue (headExpr : KExpr m) (val : KExpr m)
+    (us : Array (KUniv m)) : RecM m (KExpr m) := do
+  let key := headExpr.addr
+  if let some cached := (← get).env.unfoldCache[key]? then
+    return cached
+  let result ← TcM.instantiateUnivParams val us
+  modify fun s => { s with env := { s.env with
+    unfoldCache := s.env.unfoldCache.insert key result } }
+  return result
+
+def tryDeltaUnfold (e : KExpr m) : RecM m (Option (KExpr m)) := do
+  let (head, args) := e.collectSpine
+  let .const id us _ := head | return none
+  let val ← match (← TcM.tryGetConst id) with
+    | some (.defn (kind := kind) (val := val) ..) =>
+      match kind with
+      | .defn | .thm => pure val
+      | .opaq => return none
+    | _ => return none
+  let val ← unfoldConstValue head val us
+  let mut result := val
+  for arg in args do
+    result ← TcM.intern (KExpr.mkApp result arg)
+  return some result
+
+/-- Delta: unfold one defined constant (head-applied or bare). -/
+def deltaUnfoldOne (e : KExpr m) : RecM m (Option (KExpr m)) := do
+  if let some unfolded ← tryDeltaUnfold e then
+    return some unfolded
+  if let .const id us _ := e then
+    match (← TcM.tryGetConst id) with
+    | some (.defn (kind := kind) (val := val) ..) =>
+      match kind with
+      | .defn | .thm => return some (← unfoldConstValue e val us)
+      | .opaq => return none
+    | _ => return none
+  return none
+
+/-- Transient-mode iota application: beta-reduce as we go without interning
+    (Nat-literal recursor chains would otherwise pin every predecessor). -/
+def applyIotaArg (result : KExpr m) (arg : KExpr m)
+    (transient : Bool) : RecM m (KExpr m) := do
+  if transient then
+    if let .lam _ _ _ body _ := result then
+      return substNoIntern body arg 0
+    return KExpr.mkApp result arg
+  else
+    TcM.intern (KExpr.mkApp result arg)
+
+def isNatLiteralRecursorApp (e : KExpr m) : RecM m Bool := do
+  let (head, spine) := e.collectSpine
+  let .const id _ _ := head | return false
+  let p ← prims
+  if id.addr != p.natRec.addr && id.addr != p.natCasesOn.addr then
+    return false
+  let some (.recr (params := params) (motives := motives) (minors := minors)
+      (indices := indices) ..) ← TcM.tryGetConst id
+    | return false
+  let majorIdx := (params + motives + minors + indices).toNat
+  match spine[majorIdx]? with
+  | some (.nat ..) => return true
+  | _ => return false
+
+/-- Nat-literal recursor work is only useful while the current WHNF runs;
+    caching it would make RSS linear in the literal. -/
+def isTransientNatLiteralWork (e : KExpr m) : RecM m Bool := do
+  if (← isNatLiteralRecursorApp e) then
+    return true
+  let (head, args) := e.collectSpine
+  let .const id _ _ := head | return false
+  if id.addr == (← prims).natSucc.addr && args.size == 1 then
+    isNatLiteralRecursorApp args[0]!
+  else
+    return false
+
+/-- Lean's `cleanupNatOffsetMajor`: expose one ctor layer of a definitional
+    offset `base + k` (k > 0) as `Nat.succ (base + (k-1))`, keeping closed
+    arithmetic for the primitive reducer. -/
+def cleanupNatOffsetMajor (e : KExpr m) :
+    RecM m (Option (KExpr m)) := do
+  if (← evalNatOffsetLiteral e 0).isSome then
+    return none
+  let some (base, offset) ← natOffset e 0 | return none
+  if offset == 0 then
+    return none
+  let predOffset := offset - 1
+  let pred ← if predOffset == 0 then pure base
+    else do mkNatAdd base (natExprFromValue predOffset)
+  return some (← mkNatSucc pred)
+
+def projectDecidableFinValMinor (id : KId m) (field : UInt64)
+    (minor : KExpr m) : RecM m (Option (KExpr m)) := do
+  let .lam name bi dom body _ := minor | return none
+  let proj ← TcM.intern (KExpr.mkPrj id field body)
+  return some (← TcM.intern (KExpr.mkLam name bi dom proj))
+
+/-- `(Decidable.rec … : Fin n).val` → push the projection into both minors
+    (whnf.rs `try_reduce_fin_val_decidable_rec`). -/
+def tryReduceFinValDecidableRec (id : KId m) (field : UInt64)
+    (head : KExpr m) (args : Array (KExpr m)) :
+    RecM m (Option (KExpr m)) := do
+  if (← get).noAccel then return none
+  let p ← prims
+  if id.addr != p.fin.addr || field != 0 then
+    return none
+  let .const recId recUs _ := head | return none
+  if recId.addr != p.decidableRec.addr || args.size < 5 then
+    return none
+  let .lam motiveName motiveBi motiveDom _ _ := args[1]! | return none
+  let some falseMinor ← projectDecidableFinValMinor id field args[2]!
+    | return none
+  let some trueMinor ← projectDecidableFinValMinor id field args[3]!
+    | return none
+  let natTy ← TcM.intern (.mkConst p.nat #[])
+  let motive ← TcM.intern (KExpr.mkLam motiveName motiveBi motiveDom natTy)
+  let mut result ← TcM.intern (KExpr.mkConst recId recUs)
+  result ← TcM.intern (KExpr.mkApp result args[0]!)
+  result ← TcM.intern (KExpr.mkApp result motive)
+  result ← TcM.intern (KExpr.mkApp result falseMinor)
+  result ← TcM.intern (KExpr.mkApp result trueMinor)
+  result ← TcM.intern (KExpr.mkApp result args[4]!)
+  for arg in args.extract 5 args.size do
+    result ← TcM.intern (KExpr.mkApp result arg)
+  return some result
+
+/-- Rewrite an applied projection-wrapper definition to a `prj` node. -/
+def tryReduceProjectionDefinition (e : KExpr m) :
+    RecM m (Option (KExpr m)) := do
+  let (head, args) := e.collectSpine
+  let .const id _ _ := head | return none
+  let val ← match (← TcM.tryGetConst id) with
+    | some (.defn (kind := .defn) (val := val) ..) => pure val
+    | _ => return none
+  let some (arity, structId, field, structArgIdx) :=
+    projectionDefinitionInfo val | return none
+  if args.size < arity then
+    return none
+  let mut result ← TcM.intern (KExpr.mkPrj structId field args[structArgIdx]!)
+  for arg in args.extract arity args.size do
+    result ← TcM.intern (KExpr.mkApp result arg)
+  return some result
+
+def natRecLiteralParts (e : KExpr m) :
+    RecM m (Option (NatRecLiteralParts m)) := do
+  let (head, spine) := e.collectSpine
+  let .const id _ _ := head | return none
+  if id.addr != (← prims).natRec.addr then
+    return none
+  let some (.recr (params := params) (motives := motives) (minors := minors)
+      (indices := indices) ..) ← TcM.tryGetConst id
+    | return none
+  if minors.toNat < 2 then
+    return none
+  let baseIdx := params.toNat + motives.toNat
+  let stepIdx := baseIdx + 1
+  let majorIdx := params.toNat + motives.toNat + minors.toNat + indices.toNat
+  let some (.nat major _ _) := spine[majorIdx]? | return none
+  return some { spine, major, baseIdx, stepIdx }
+
+/-- Heads that leave a Nat-predicate argument stuck. -/
+def isNatStuckRecursorAddr (addr : Address) : RecM m Bool := do
+  let p ← prims
+  return addr == p.natRec.addr || addr == p.natCasesOn.addr
+    || addr == p.bitVecToNat.addr
+
+def isStuckNatPredicateProbe (e : KExpr m) : RecM m Bool := do
+  let (head, _) := e.collectSpine
+  match head with
+  | .const id _ _ =>
+    return (← isNatBinPredAddr id.addr) || (← isNatStuckRecursorAddr id.addr)
+  | .prj id _ val _ =>
+    if id.addr == (← prims).fin.addr then
+      return true
+    let (valHead, _) := val.collectSpine
+    match valHead with
+    | .const valId _ _ => isNatStuckRecursorAddr valId.addr
+    | _ => return false
+  | _ => return false
+
+/-- `(width, n)` from `BitVec.ofNat width n` or
+    `OfNat.ofNat (BitVec width) n inst…`. -/
+def bitvecOfNatArgs (e : KExpr m) :
+    RecM m (Option (KExpr m × KExpr m)) := do
+  let p ← prims
+  let (head, args) := e.collectSpine
+  let .const id _ _ := head | return none
+  if id.addr == p.bitVecOfNat.addr && args.size == 2 then
+    return some (args[0]!, args[1]!)
+  if id.addr != p.ofNatOfNat.addr || args.size < 2 then
+    return none
+  let (typeHead, typeArgs) := args[0]!.collectSpine
+  let .const typeId _ _ := typeHead | return none
+  if typeId.addr == p.bitVec.addr && typeArgs.size == 1 then
+    return some (typeArgs[0]!, args[1]!)
+  return none
+
+def charOfNatExpr (n : Nat) : RecM m (Option (KExpr m)) := do
+  let charOfNat ← TcM.intern (.mkConst (← prims).charOfNat #[])
+  let natLit ← TcM.intern (natExprFromValue n : KExpr m)
+  return some (← TcM.intern (KExpr.mkApp charOfNat natLit))
+
+/-- String literal primitives: `String.back` / legacy back /
+    `utf8ByteSize` / `toByteArray ""`. -/
+def tryReduceString (e : KExpr m) : RecM m (Option (KExpr m)) := do
+  let (head, args) := e.collectSpine
+  if args.size != 1 then
+    return none
+  let .const id _ _ := head | return none
+  let p ← prims
+  let isBack := id.addr == p.stringBack.addr
+    || id.addr == p.stringLegacyBack.addr
+  let isUtf8ByteSize := id.addr == p.stringUtf8ByteSize.addr
+  let isToByteArray := id.addr == p.stringToByteArray.addr
+  if !isBack && !isUtf8ByteSize && !isToByteArray then
+    return none
+  let .str s _ _ := args[0]! | return none
+  if isUtf8ByteSize then
+    return some (← TcM.intern (natExprFromValue s.utf8ByteSize : KExpr m))
+  if isToByteArray then
+    if s.isEmpty then
+      return some (← TcM.intern (.mkConst p.byteArrayEmpty #[]))
+    return none
+  let codepoint := (s.toList.getLast?.map (·.toNat)).getD 65
+  charOfNatExpr codepoint
+
+def discoverBlockInductives (blockId : KId m) :
+    RecM m (Array (KId m)) := do
+  let some members ← TcM.tryGetBlock blockId | return #[]
+  let mut inds : Array (KId m) := #[]
+  for id in members do
+    if let some (.indc ..) ← TcM.tryGetConst id then
+      inds := inds.push id
+  return inds
+
+/-- Peel as many leading lambdas as there are application arguments. The
+    explicit bound is the original argument count, so the old inner `repeat`
+    cannot outlive its spine. -/
+def consumeBetaLamsFuel : Nat → KExpr m → Array (KExpr m) →
+    Array (KExpr m) → KExpr m × Array (KExpr m)
+  | 0, body, _, consumed => (body, consumed)
+  | fuel + 1, body, args, consumed =>
+    if consumed.size ≥ args.size then
+      (body, consumed)
+    else
+      match body with
+      | .lam _ _ _ inner _ =>
+        consumeBetaLamsFuel fuel inner args
+          (consumed.push args[consumed.size]!)
+      | _ => (body, consumed)
+
+def consumeBetaLams (body : KExpr m) (args : Array (KExpr m)) :
+    KExpr m × Array (KExpr m) :=
+  consumeBetaLamsFuel args.size body args (Array.mkEmpty args.size)
+
+/-- Internal WHNF back-edges. Each crosses to the predecessor `methodsN`
+    table without changing the runtime state; the policy-sensitive entries
+    preserve cheap-projection and stuck-succ behavior exactly. -/
+@[inline] def whnfRec (e : KExpr m) : RecM m (KExpr m) := do
+  (← read).whnf e
+
+@[inline] def whnfModeRec (e : KExpr m) (mode : NatSuccMode) :
+    RecM m (KExpr m) := do
+  (← read).whnfMode e mode
+
+@[inline] def whnfCoreFlagsRec (e : KExpr m) (flags : WhnfFlags) :
+    RecM m (KExpr m) := do
+  (← read).whnfCoreFlags e flags
+
 mutual
 
 /-- Full WHNF: loop of whnf-no-delta → native/nat/decidable/string → delta. -/
-partial def whnf (e : KExpr m) : RecM m (KExpr m) :=
+def whnf (e : KExpr m) : RecM m (KExpr m) :=
   whnfWithNatSuccMode e .collapse
 
-partial def whnfWithNatSuccMode (e : KExpr m) (natSuccMode : NatSuccMode) :
+def whnfWithNatSuccMode (e : KExpr m) (natSuccMode : NatSuccMode) :
     RecM m (KExpr m) := do
   -- Quick exit for non-reducing forms.
   match e with
@@ -272,8 +589,57 @@ partial def whnfWithNatSuccMode (e : KExpr m) (natSuccMode : NatSuccMode) :
   | .var i _ _ =>
     if !(← TcM.isLetVar (m := m) i) then return e
   | _ => pure ()
+  whnfWithNatSuccModeNonLeaf e natSuccMode
+
+/-- One full-WHNF loop iteration.  The named seam exposes the exact order of
+    no-delta normalization, cycle detection, accelerators, literal reducers,
+    and one delta step without changing the bounded driver. -/
+def whnfWithNatSuccModeStep (natSuccMode : NatSuccMode)
+    (state : KExpr m × HashSet Address) :
+    RecM m (BoundedStep (KExpr m × HashSet Address) (KExpr m)) := do
+  let (cur, seen) := state
+  let cur ← whnfNoDeltaImpl cur .FULL natSuccMode
+  if seen.contains cur.addr then
+    return .done cur
+  let seen := seen.insert cur.addr
+  -- Native reduction runs before nat reduction (lean4lean order).
+  if let some reduced ← tryReduceNative cur then
+    return .next (reduced, seen)
+  if let some reduced ← tryReduceBitvec cur then
+    return .next (reduced, seen)
+  -- Nat primitives BEFORE delta (short-circuit Nat.sub/pow/… bodies).
+  if let some reduced ← tryReduceNatWithSuccMode cur natSuccMode then
+    return .next (reduced, seen)
+  -- Nat decidables BEFORE delta.
+  if let some reduced ← tryReduceDecidable cur then
+    return .next (reduced, seen)
+  if let some reduced ← tryReduceString cur then
+    return .next (reduced, seen)
+  if let some unfolded ← deltaUnfoldOne cur then
+    return .next (unfolded, seen)
+  return .done cur
+
+/-- Full-WHNF bounded loop without the outer instrumentation/cache policy. -/
+def whnfWithNatSuccModeUncached (e : KExpr m)
+    (natSuccMode : NatSuccMode) : RecM m (KExpr m) :=
+  runBounded (whnfWithNatSuccModeStep natSuccMode) maxWhnfFuel.toNat (e, {})
+
+/-- Trace/statistics prefix executed by full WHNF after syntactic fast paths
+    and before key computation. -/
+def whnfWithNatSuccModePrefix (e : KExpr m) : RecM m Unit := do
   TcM.stepTrace (m := m) "whnf+" fun _ => TcM.addr8 e.addr
   TcM.bumpStats (m := m) fun s => { s with whnfCalls := s.whnfCalls + 1 }
+
+/-- Work charged only after a full-WHNF cache miss. -/
+def whnfWithNatSuccModeMissCharge : RecM m Unit := do
+  TcM.bumpStats (m := m) fun s => { s with whnfMisses := s.whnfMisses + 1 }
+  TcM.tick (m := m)
+
+/-- Instrumented/keyed full-WHNF body reached after the public syntactic fast
+    paths.  Naming it makes the cache and fuel boundary equation-visible. -/
+def whnfWithNatSuccModeNonLeaf (e : KExpr m)
+    (natSuccMode : NatSuccMode) : RecM m (KExpr m) := do
+  whnfWithNatSuccModePrefix e
   let key ← TcM.whnfKey e
   let useCache := natSuccMode == .collapse
   let transientNatWork ← isTransientNatLiteralWork e
@@ -281,69 +647,32 @@ partial def whnfWithNatSuccMode (e : KExpr m) (natSuccMode : NatSuccMode) :
     if let some cached := (← get).env.whnfCache[key]? then
       return cached
   -- Tick AFTER fast paths and cache: only consume fuel for actual work.
-  TcM.bumpStats (m := m) fun s => { s with whnfMisses := s.whnfMisses + 1 }
-  TcM.tick (m := m)
-  let mut cur := e
-  let mut fuel := maxWhnfFuel
-  let mut seen : HashSet Address := {}
-  repeat
-    if fuel == 0 then
-      throw .maxRecDepth
-    fuel := fuel - 1
-    cur ← whnfNoDeltaImpl cur .FULL natSuccMode
-    if seen.contains cur.addr then
-      break
-    seen := seen.insert cur.addr
-    -- Native reduction runs before nat reduction (lean4lean order).
-    if let some reduced ← tryReduceNative cur then
-      cur := reduced
-      continue
-    if let some reduced ← tryReduceBitvec cur then
-      cur := reduced
-      continue
-    -- Nat primitives BEFORE delta (short-circuit Nat.sub/pow/… bodies).
-    if let some reduced ← tryReduceNatWithSuccMode cur natSuccMode then
-      cur := reduced
-      continue
-    -- Nat decidables BEFORE delta.
-    if let some reduced ← tryReduceDecidable cur then
-      cur := reduced
-      continue
-    if let some reduced ← tryReduceString cur then
-      cur := reduced
-      continue
-    if let some unfolded ← deltaUnfoldOne cur then
-      cur := unfolded
-      continue
-    break
+  whnfWithNatSuccModeMissCharge
+  let cur ← whnfWithNatSuccModeUncached e natSuccMode
   if !(← get).inNativeReduce && useCache && !transientNatWork then
     modify fun s => { s with env := { s.env with
       whnfCache := s.env.whnfCache.insert key cur } }
   return cur
 
 /-- Structural WHNF (beta/iota/zeta/proj), NO delta, FULL flags. -/
-partial def whnfCore (e : KExpr m) : RecM m (KExpr m) :=
+def whnfCore (e : KExpr m) : RecM m (KExpr m) :=
   whnfCoreWithFlags e .FULL
 
 /-- Structural WHNF for def-eq's cheap-projection scaffold
     (`whnfCore (cheapProj := true)`). Bumps `cheapRecursionDepth` so cheap
     false negatives stay out of the full def-eq cache. -/
-partial def whnfCoreForDefEq (e : KExpr m) : RecM m (KExpr m) := do
+def whnfCoreForDefEq (e : KExpr m) : RecM m (KExpr m) := do
   modify fun s => { s with cheapRecursionDepth := s.cheapRecursionDepth + 1 }
   try
     whnfCoreWithFlags e .DEF_EQ_CORE
   finally
     modify fun s => { s with cheapRecursionDepth := s.cheapRecursionDepth - 1 }
 
-partial def whnfCoreWithFlags (e : KExpr m) (flags : WhnfFlags) :
+/-- Key/cache/uncached body reached after structural-WHNF's syntactic fast
+paths.  Naming this seam leaves runtime behavior unchanged while allowing the
+outer cache policy to be verified independently of leaf/variable dispatch. -/
+def whnfCoreWithFlagsNonLeaf (e : KExpr m) (flags : WhnfFlags) :
     RecM m (KExpr m) := do
-  -- Leaves whnf_core never reduces (incl. `const` — no delta here); `var`
-  -- only when no let frame can zeta it.
-  match e with
-  | .sort .. | .all .. | .lam .. | .nat .. | .str .. | .const .. => return e
-  | .var i _ _ =>
-    if !(← TcM.isLetVar (m := m) i) then return e
-  | _ => pure ()
   let key ← TcM.whnfKey e
   let transientNatWork ← isTransientNatLiteralWork e
   if flags.isFull then
@@ -365,102 +694,129 @@ partial def whnfCoreWithFlags (e : KExpr m) (flags : WhnfFlags) :
         whnfCoreCheapCache := s.env.whnfCoreCheapCache.insert key result } }
     return result
 
-partial def whnfCoreWithFlagsUncached (e : KExpr m) (flags : WhnfFlags) :
+def whnfCoreWithFlags (e : KExpr m) (flags : WhnfFlags) :
     RecM m (KExpr m) := do
-  let mut cur := e
-  let mut fuel := maxWhnfFuel
-  repeat
-    if fuel == 0 then
-      throw .maxRecDepth
-    fuel := fuel - 1
+  -- Leaves whnf_core never reduces (incl. `const` — no delta here); `var`
+  -- only when no let frame can zeta it.
+  match e with
+  | .sort .. | .all .. | .lam .. | .nat .. | .str .. | .const .. => return e
+  | .var i _ _ =>
+    if !(← TcM.isLetVar (m := m) i) then return e
+  | _ => pure ()
+  whnfCoreWithFlagsNonLeaf e flags
+
+/-- One structural-WHNF loop iteration.  Naming the step keeps the bounded
+driver unchanged while exposing a stable verification seam for individual
+reduction branches. -/
+def whnfCoreWithFlagsStep (cur : KExpr m) (flags : WhnfFlags) :
+    RecM m (BoundedStep (KExpr m) (KExpr m)) := do
     match cur with
     | .var i _ _ =>
       -- Legacy let-bound variable zeta-reduction.
       match (← TcM.lookupLetVal (m := m) i) with
-      | some val =>
-        cur := val
-        continue
-      | none => return cur
+      | some val => return .next val
+      | none => return .done cur
     | .fvar id _ _ =>
       -- Let-bound fvar zeta-reduction (lean4lean `whnfFVar`).
       match (← get).lctx.find? id with
-      | some (.ldecl _ _ val) =>
-        cur := val
-        continue
-      | _ => return cur
+      | some (.ldecl _ _ val) => return .next val
+      | _ => return .done cur
     | .sort .. | .all .. | .lam .. | .nat .. | .str .. | .const .. =>
-      return cur
+      return .done cur
     | .prj id field val _ =>
       -- FULL: full whnf on the struct value (delta may expose a ctor).
       -- CHEAP: structural only; stuck projections stay stuck.
-      let wval ← if flags.cheapProj then whnfCoreWithFlags val flags
-        else whnf val
+      let wval ← if flags.cheapProj then whnfCoreFlagsRec val flags
+        else whnfRec val
       match (← tryProjReduce id field wval) with
-      | some result =>
-        cur := result
-        continue
-      | none => return cur
+      | some result => return .next result
+      | none => return .done cur
     | .letE _ _ val body _ _ =>
-      cur ← TcM.runIntern (subst body val 0)
-      continue
+      return .next (← TcM.runIntern (subst body val 0))
     | .app .. => pure ()
     -- App: collect spine, whnf-core the head, beta / iota.
     let (f0, args) := cur.collectSpine
-    let f ← whnfCoreWithFlags f0 flags
+    let f ← whnfCoreFlagsRec f0 flags
     if let .lam .. := f then
       -- Multi-arg beta.
-      let mut body := f
-      let mut consumedArgs : Array (KExpr m) := Array.mkEmpty args.size
-      repeat
-        if consumedArgs.size ≥ args.size then break
-        match body with
-        | .lam _ _ _ inner _ =>
-          consumedArgs := consumedArgs.push args[consumedArgs.size]!
-          body := inner
-        | _ => break
+      let (body₀, consumedArgs) := consumeBetaLams f args
+      let mut body := body₀
       let remainingStart := consumedArgs.size
       if !consumedArgs.isEmpty then
         body ← TcM.runIntern (simulSubst body consumedArgs.reverse 0)
       for arg in args.extract remainingStart args.size do
         body ← TcM.intern (KExpr.mkApp body arg)
-      cur := body
-      continue
+      return .next body
     if f != f0 then
       -- Head reduced: rebuild, try iota once, else done.
       let mut rebuilt := f
       for arg in args do
         rebuilt ← TcM.intern (KExpr.mkApp rebuilt arg)
       match (← tryIotaWithFlags rebuilt flags) with
-      | some reduced =>
-        cur := reduced
-        continue
-      | none => return rebuilt
+      | some reduced => return .next reduced
+      | none => return .done rebuilt
     match (← tryIotaWithFlags cur flags) with
-    | some reduced =>
-      cur := reduced
-      continue
-    | none => return cur
-  throw .maxRecDepth
+    | some reduced => return .next reduced
+    | none => return .done cur
+
+def whnfCoreWithFlagsUncached (e : KExpr m) (flags : WhnfFlags) :
+    RecM m (KExpr m) :=
+  runBounded (fun cur => whnfCoreWithFlagsStep cur flags)
+    maxWhnfFuel.toNat e
 
 /-- WHNF without delta: whnf-core → proj-app → nat/native/string → quot. -/
-partial def whnfNoDelta (e : KExpr m) : RecM m (KExpr m) :=
+def whnfNoDelta (e : KExpr m) : RecM m (KExpr m) :=
   whnfNoDeltaImpl e .FULL .collapse
 
 /-- Def-eq no-delta WHNF (cheap projection policy). -/
-partial def whnfNoDeltaForDefEq (e : KExpr m) : RecM m (KExpr m) := do
+def whnfNoDeltaForDefEq (e : KExpr m) : RecM m (KExpr m) := do
   modify fun s => { s with cheapRecursionDepth := s.cheapRecursionDepth + 1 }
   try
     whnfNoDeltaImpl e .DEF_EQ_CORE .collapse
   finally
     modify fun s => { s with cheapRecursionDepth := s.cheapRecursionDepth - 1 }
 
-partial def whnfNoDeltaImpl (e : KExpr m) (flags : WhnfFlags)
+/-- One no-delta WHNF loop iteration, in the precise production reducer
+    order.  Successful syntax-directed helpers remain visible as `.next`;
+    a fully stuck structural result terminates the loop. -/
+def whnfNoDeltaImplStep (flags : WhnfFlags) (natSuccMode : NatSuccMode)
+    (cur : KExpr m) : RecM m (BoundedStep (KExpr m) (KExpr m)) := do
+  let cur ← whnfCoreWithFlags cur flags
+  -- App-of-Prj: whnf_core resolves the outermost Prj only; give the
+  -- head one more attempt under the same projection policy.
+  match (← tryProjAppReduce cur flags) with
+  | some (projResult, args) =>
+    let mut result := projResult
+    for arg in args do
+      result ← TcM.intern (KExpr.mkApp result arg)
+    return .next result
+  | none => pure ()
+  if let some reduced ← tryReduceBitvec cur then
+    return .next reduced
+  if let some reduced ← tryReduceNatWithSuccMode cur natSuccMode then
+    return .next reduced
+  -- Native/string before projection-definition rewriting (wrappers like
+  -- Subtype.val are projection definitions; once rewritten to Prj the
+  -- recognizers no longer see the head).
+  if let some reduced ← tryReduceNative cur then
+    return .next reduced
+  if let some reduced ← tryReduceString cur then
+    return .next reduced
+  if flags.isFull then
+    if let some reduced ← tryReduceProjectionDefinition cur then
+      return .next reduced
+  if let some reduced ← tryQuotReduce cur then
+    return .next reduced
+  return .done cur
+
+/-- No-delta bounded loop without its outer cache policy. -/
+def whnfNoDeltaImplUncached (e : KExpr m) (flags : WhnfFlags)
+    (natSuccMode : NatSuccMode) : RecM m (KExpr m) :=
+  runBounded (whnfNoDeltaImplStep flags natSuccMode) maxWhnfFuel.toNat e
+
+/-- Key/cache/uncached no-delta body reached after syntactic fast paths. -/
+def whnfNoDeltaImplNonLeaf (e : KExpr m) (flags : WhnfFlags)
     (natSuccMode : NatSuccMode) : RecM m (KExpr m) := do
-  match e with
-  | .sort .. | .all .. | .lam .. | .nat .. | .str .. => return e
-  | .var i _ _ =>
-    if !(← TcM.isLetVar (m := m) i) then return e
-  | _ => pure ()
   let key ← TcM.whnfKey e
   let useCache := natSuccMode == .collapse
   let transientNatWork ← isTransientNatLiteralWork e
@@ -471,46 +827,7 @@ partial def whnfNoDeltaImpl (e : KExpr m) (flags : WhnfFlags)
     else
       if let some cached := (← get).env.whnfNoDeltaCheapCache[key]? then
         return cached
-  let mut cur := e
-  let mut fuel := maxWhnfFuel
-  repeat
-    if fuel == 0 then
-      throw .maxRecDepth
-    fuel := fuel - 1
-    cur ← whnfCoreWithFlags cur flags
-    -- App-of-Prj: whnf_core resolves the outermost Prj only; give the
-    -- head one more attempt under the same projection policy.
-    match (← tryProjAppReduce cur flags) with
-    | some (projResult, args) =>
-      let mut result := projResult
-      for arg in args do
-        result ← TcM.intern (KExpr.mkApp result arg)
-      cur := result
-      continue
-    | none => pure ()
-    if let some reduced ← tryReduceBitvec cur then
-      cur := reduced
-      continue
-    if let some reduced ← tryReduceNatWithSuccMode cur natSuccMode then
-      cur := reduced
-      continue
-    -- Native/string before projection-definition rewriting (wrappers like
-    -- Subtype.val are projection definitions; once rewritten to Prj the
-    -- recognizers no longer see the head).
-    if let some reduced ← tryReduceNative cur then
-      cur := reduced
-      continue
-    if let some reduced ← tryReduceString cur then
-      cur := reduced
-      continue
-    if flags.isFull then
-      if let some reduced ← tryReduceProjectionDefinition cur then
-        cur := reduced
-        continue
-    if let some reduced ← tryQuotReduce cur then
-      cur := reduced
-      continue
-    break
+  let cur ← whnfNoDeltaImplUncached e flags natSuccMode
   if !(← get).inNativeReduce && useCache && !transientNatWork then
     if flags.isFull then
       modify fun s => { s with env := { s.env with
@@ -520,49 +837,18 @@ partial def whnfNoDeltaImpl (e : KExpr m) (flags : WhnfFlags)
         whnfNoDeltaCheapCache := s.env.whnfNoDeltaCheapCache.insert key cur } }
   return cur
 
-/-- Delta: unfold one defined constant (head-applied or bare). -/
-partial def deltaUnfoldOne (e : KExpr m) : RecM m (Option (KExpr m)) := do
-  if let some unfolded ← tryDeltaUnfold e then
-    return some unfolded
-  if let .const id us _ := e then
-    match (← TcM.tryGetConst id) with
-    | some (.defn (kind := kind) (val := val) ..) =>
-      match kind with
-      | .defn | .thm => return some (← unfoldConstValue e val us)
-      | .opaq => return none
-    | _ => return none
-  return none
-
-partial def tryDeltaUnfold (e : KExpr m) : RecM m (Option (KExpr m)) := do
-  let (head, args) := e.collectSpine
-  let .const id us _ := head | return none
-  let val ← match (← TcM.tryGetConst id) with
-    | some (.defn (kind := kind) (val := val) ..) =>
-      match kind with
-      | .defn | .thm => pure val
-      | .opaq => return none
-    | _ => return none
-  let val ← unfoldConstValue head val us
-  let mut result := val
-  for arg in args do
-    result ← TcM.intern (KExpr.mkApp result arg)
-  return some result
-
-/-- Universe-instantiated body of an unfolded head, cached by the head
-    `const` expression's content hash (lean4 C++ `m_unfold` cache). -/
-partial def unfoldConstValue (headExpr : KExpr m) (val : KExpr m)
-    (us : Array (KUniv m)) : RecM m (KExpr m) := do
-  let key := headExpr.addr
-  if let some cached := (← get).env.unfoldCache[key]? then
-    return cached
-  let result ← TcM.instantiateUnivParams val us
-  modify fun s => { s with env := { s.env with
-    unfoldCache := s.env.unfoldCache.insert key result } }
-  return result
+def whnfNoDeltaImpl (e : KExpr m) (flags : WhnfFlags)
+    (natSuccMode : NatSuccMode) : RecM m (KExpr m) := do
+  match e with
+  | .sort .. | .all .. | .lam .. | .nat .. | .str .. => return e
+  | .var i _ _ =>
+    if !(← TcM.isLetVar (m := m) i) then return e
+  | _ => pure ()
+  whnfNoDeltaImplNonLeaf e flags natSuccMode
 
 /-- Iota: recursor applied to a constructor (or K-synthesized / struct-eta
     fallback). `cheapRec` reduces the major structurally only. -/
-partial def tryIotaWithFlags (e : KExpr m) (flags : WhnfFlags) :
+def tryIotaWithFlags (e : KExpr m) (flags : WhnfFlags) :
     RecM m (Option (KExpr m)) := do
   let (head, spine) := e.collectSpine
   let .const recId recUs _ := head | return none
@@ -584,8 +870,8 @@ partial def tryIotaWithFlags (e : KExpr m) (flags : WhnfFlags) :
     else pure major
   let major := (← cleanupNatOffsetMajor major).getD major
   -- WHNF the major (cheap mode skips delta on the major itself).
-  let majorWhnf0 ← if flags.cheapRec then whnfCoreWithFlags major flags
-    else whnf major
+  let majorWhnf0 ← if flags.cheapRec then whnfCoreFlagsRec major flags
+    else whnfRec major
   -- Nat literal → constructor form (one layer).
   let mut majorWhnf := majorWhnf0
   let mut majorWasNatLit := false
@@ -600,8 +886,8 @@ partial def tryIotaWithFlags (e : KExpr m) (flags : WhnfFlags) :
   match majorWhnf with
   | .str val _ _ =>
     let strCtor ← strLitToConstructor val
-    majorWhnf ← if flags.cheapRec then whnfCoreWithFlags strCtor flags
-      else whnf strCtor
+    majorWhnf ← if flags.cheapRec then whnfCoreFlagsRec strCtor flags
+      else whnfRec strCtor
   | _ => pure ()
   -- Constructor application?
   let (ctorHead, ctorArgs) := majorWhnf.collectSpine
@@ -636,7 +922,7 @@ partial def tryIotaWithFlags (e : KExpr m) (flags : WhnfFlags) :
   -- Struct eta iota fallback.
   tryStructEtaIota recId recr recUs spine
 
-partial def isStructLike (id : KId m) : RecM m Bool := do
+def isStructLike (id : KId m) : RecM m Bool := do
   match (← TcM.tryGetConst id) with
   | some (.indc (indices := indices) (ctors := ctors) ..) =>
     if indices != 0 || ctors.size != 1 then
@@ -644,102 +930,10 @@ partial def isStructLike (id : KId m) : RecM m Bool := do
   | _ => return false
   return !(← computedIsRec id)
 
-/-- Transient-mode iota application: beta-reduce as we go without interning
-    (Nat-literal recursor chains would otherwise pin every predecessor). -/
-partial def applyIotaArg (result : KExpr m) (arg : KExpr m)
-    (transient : Bool) : RecM m (KExpr m) := do
-  if transient then
-    if let .lam _ _ _ body _ := result then
-      return substNoIntern body arg 0
-    return KExpr.mkApp result arg
-  else
-    TcM.intern (KExpr.mkApp result arg)
-
-/-- Nat-literal recursor work is only useful while the current WHNF runs;
-    caching it would make RSS linear in the literal. -/
-partial def isTransientNatLiteralWork (e : KExpr m) : RecM m Bool := do
-  if (← isNatLiteralRecursorApp e) then
-    return true
-  let (head, args) := e.collectSpine
-  let .const id _ _ := head | return false
-  if id.addr == (← prims).natSucc.addr && args.size == 1 then
-    isNatLiteralRecursorApp args[0]!
-  else
-    return false
-
-partial def isNatLiteralRecursorApp (e : KExpr m) : RecM m Bool := do
-  let (head, spine) := e.collectSpine
-  let .const id _ _ := head | return false
-  let p ← prims
-  if id.addr != p.natRec.addr && id.addr != p.natCasesOn.addr then
-    return false
-  let some (.recr (params := params) (motives := motives) (minors := minors)
-      (indices := indices) ..) ← TcM.tryGetConst id
-    | return false
-  let majorIdx := (params + motives + minors + indices).toNat
-  match spine[majorIdx]? with
-  | some (.nat ..) => return true
-  | _ => return false
-
-/-- Lean's `cleanupNatOffsetMajor`: expose one ctor layer of a definitional
-    offset `base + k` (k > 0) as `Nat.succ (base + (k-1))`, keeping closed
-    arithmetic for the primitive reducer. -/
-partial def cleanupNatOffsetMajor (e : KExpr m) :
-    RecM m (Option (KExpr m)) := do
-  if (← evalNatOffsetLiteral e 0).isSome then
-    return none
-  let some (base, offset) ← natOffset e 0 | return none
-  if offset == 0 then
-    return none
-  let predOffset := offset - 1
-  let pred ← if predOffset == 0 then pure base
-    else do mkNatAdd base (natExprFromValue predOffset)
-  return some (← mkNatSucc pred)
-
-partial def natOffset (e : KExpr m) (depth : Nat) :
-    RecM m (Option (KExpr m × Nat)) := do
-  if depth ≥ 256 then
-    return none
-  let (head, args) := e.collectSpine
-  let .const id _ _ := head | return none
-  let p ← prims
-  if id.addr == p.natSucc.addr && args.size == 1 then
-    let (base, offset) ← natOffsetOrZero args[0]! (depth + 1)
-    return some (base, offset + 1)
-  if id.addr == p.natAdd.addr && args.size == 2 then
-    let some rhs ← evalNatOffsetLiteral args[1]! (depth + 1) | return none
-    let (base, offset) ← natOffsetOrZero args[0]! (depth + 1)
-    return some (base, offset + rhs)
-  return none
-
-partial def natOffsetOrZero (e : KExpr m) (depth : Nat) :
-    RecM m (KExpr m × Nat) := do
-  return (← natOffset e depth).getD (e, 0)
-
-/-- Syntactic, no-delta evaluator for Nat offset constants (weaker than
-    WHNF by design). -/
-partial def evalNatOffsetLiteral (e : KExpr m) (depth : Nat) :
-    RecM m (Option Nat) := do
-  if depth ≥ 256 then
-    return none
-  let p ← prims
-  if let some n := extractNatValue e p then
-    return some n
-  let (head, args) := e.collectSpine
-  let .const id _ _ := head | return none
-  if id.addr == p.natPred.addr && args.size == 1 then
-    let some n ← evalNatOffsetLiteral args[0]! (depth + 1) | return none
-    return some (n - 1)
-  if (← isNatBinArithAddr id.addr) && args.size == 2 then
-    let some a ← evalNatOffsetLiteral args[0]! (depth + 1) | return none
-    let some b ← evalNatOffsetLiteral args[1]! (depth + 1) | return none
-    return computeNatBin id.addr PrimAddrs.canonical a b
-  return none
-
 /-- Struct-eta iota: single-rule recursor over a non-recursive one-ctor
     zero-index inductive; rebuild the rule with projections of the major.
     Prop-typed majors are excluded (lean4lean `toCtorWhenStruct`). -/
-partial def tryStructEtaIota (recId : KId m) (recr : IotaInfo m)
+def tryStructEtaIota (recId : KId m) (recr : IotaInfo m)
     (recUs : Array (KUniv m)) (spine : Array (KExpr m)) :
     RecM m (Option (KExpr m)) := do
   if recr.rules.size != 1 then
@@ -758,7 +952,7 @@ partial def tryStructEtaIota (recId : KId m) (recr : IotaInfo m)
     | return none
   let some majorSort ← try? (TcM.withInferOnly ((← read).infer majorTy))
     | return none
-  let some majorSortW ← try? (whnf majorSort) | return none
+  let some majorSortW ← try? (whnfRec majorSort) | return none
   if let .sort u _ := majorSortW then
     if u.isZero then
       return none
@@ -776,11 +970,11 @@ partial def tryStructEtaIota (recId : KId m) (recr : IotaInfo m)
 
 /-- K-like recursors: when the major isn't a ctor but its type matches the
     target inductive, build `ctor₀ params…` and def-eq-verify its type. -/
-partial def synthCtorWhenK (major : KExpr m) (recId : KId m)
+def synthCtorWhenK (major : KExpr m) (recId : KId m)
     (recr : IotaInfo m) : RecM m (Option (KExpr m)) := do
   let some majorTy ← try? (TcM.withInferOnly ((← read).infer major))
     | return none
-  let some majorTyW ← try? (whnf majorTy) | return none
+  let some majorTyW ← try? (whnfRec majorTy) | return none
   let (tyHead, tyArgs) := majorTyW.collectSpine
   let .const tyHeadId tyUs _ := tyHead | return none
   let recTy ← match (← TcM.tryGetConst recId) with
@@ -814,12 +1008,12 @@ partial def synthCtorWhenK (major : KExpr m) (recId : KId m)
 
 /-- Projection of a ctor application (with string-literal expansion first,
     and the `Fin.val`-through-`Decidable.rec` special case). -/
-partial def tryProjReduce (id : KId m) (field : UInt64) (wval : KExpr m) :
+def tryProjReduce (id : KId m) (field : UInt64) (wval : KExpr m) :
     RecM m (Option (KExpr m)) := do
   let wval ← match wval with
     | .str s _ _ => do
       let expanded ← strLitToConstructor s
-      whnf expanded
+      whnfRec expanded
     | _ => pure wval
   let (head, args) := wval.collectSpine
   if let some result ← tryReduceFinValDecidableRec id field head args then
@@ -830,83 +1024,31 @@ partial def tryProjReduce (id : KId m) (field : UInt64) (wval : KExpr m) :
     | _ => return none
   return args[ctorParams + field.toNat]?
 
-/-- `(Decidable.rec … : Fin n).val` → push the projection into both minors
-    (whnf.rs `try_reduce_fin_val_decidable_rec`). -/
-partial def tryReduceFinValDecidableRec (id : KId m) (field : UInt64)
-    (head : KExpr m) (args : Array (KExpr m)) :
-    RecM m (Option (KExpr m)) := do
-  if (← get).noAccel then return none
-  let p ← prims
-  if id.addr != p.fin.addr || field != 0 then
-    return none
-  let .const recId recUs _ := head | return none
-  if recId.addr != p.decidableRec.addr || args.size < 5 then
-    return none
-  let .lam motiveName motiveBi motiveDom _ _ := args[1]! | return none
-  let some falseMinor ← projectDecidableFinValMinor id field args[2]!
-    | return none
-  let some trueMinor ← projectDecidableFinValMinor id field args[3]!
-    | return none
-  let natTy ← TcM.intern (.mkConst p.nat #[])
-  let motive ← TcM.intern (KExpr.mkLam motiveName motiveBi motiveDom natTy)
-  let mut result ← TcM.intern (KExpr.mkConst recId recUs)
-  result ← TcM.intern (KExpr.mkApp result args[0]!)
-  result ← TcM.intern (KExpr.mkApp result motive)
-  result ← TcM.intern (KExpr.mkApp result falseMinor)
-  result ← TcM.intern (KExpr.mkApp result trueMinor)
-  result ← TcM.intern (KExpr.mkApp result args[4]!)
-  for arg in args.extract 5 args.size do
-    result ← TcM.intern (KExpr.mkApp result arg)
-  return some result
-
-partial def projectDecidableFinValMinor (id : KId m) (field : UInt64)
-    (minor : KExpr m) : RecM m (Option (KExpr m)) := do
-  let .lam name bi dom body _ := minor | return none
-  let proj ← TcM.intern (KExpr.mkPrj id field body)
-  return some (← TcM.intern (KExpr.mkLam name bi dom proj))
-
 /-- `App(Prj(S, i, v), args…)`: one more projection attempt on the head. -/
-partial def tryProjAppReduce (e : KExpr m) (flags : WhnfFlags) :
+def tryProjAppReduce (e : KExpr m) (flags : WhnfFlags) :
     RecM m (Option (KExpr m × Array (KExpr m))) := do
   let (head, args) := e.collectSpine
   if args.isEmpty then
     return none
   let .prj id field val _ := head | return none
-  let wval ← if flags.cheapProj then whnfCoreWithFlags val flags
-    else whnf val
+  let wval ← if flags.cheapProj then whnfCoreFlagsRec val flags
+    else whnfRec val
   match (← tryProjReduce id field wval) with
   | some result => return some (result, args)
   | none => return none
 
-/-- Rewrite an applied projection-wrapper definition to a `prj` node. -/
-partial def tryReduceProjectionDefinition (e : KExpr m) :
-    RecM m (Option (KExpr m)) := do
-  let (head, args) := e.collectSpine
-  let .const id _ _ := head | return none
-  let val ← match (← TcM.tryGetConst id) with
-    | some (.defn (kind := .defn) (val := val) ..) => pure val
-    | _ => return none
-  let some (arity, structId, field, structArgIdx) :=
-    projectionDefinitionInfo val | return none
-  if args.size < arity then
-    return none
-  let mut result ← TcM.intern (KExpr.mkPrj structId field args[structArgIdx]!)
-  for arg in args.extract arity args.size do
-    result ← TcM.intern (KExpr.mkApp result arg)
-  return some result
-
 /-- Major-premise inductive of a recursor type: peel `skip` foralls, then
     scan (bounded) for the first forall whose domain head is an inductive. -/
-partial def getMajorInductiveId (recTy : KExpr m) (skip : UInt64) :
+def getMajorInductiveId (recTy : KExpr m) (skip : UInt64) :
     RecM m (KId m) := do
   let mut ty := recTy
   for _ in [0:skip.toNat] do
-    let w ← whnf ty
+    let w ← whnfRec ty
     match w with
     | .all _ _ _ body _ => ty := body
     | _ => throw (.other "get_major_inductive_id: not enough foralls")
   for _ in [0:9] do
-    let w ← whnf ty
+    let w ← whnfRec ty
     match w with
     | .all _ _ dom body _ =>
       let (head, _) := dom.collectSpine
@@ -919,10 +1061,10 @@ partial def getMajorInductiveId (recTy : KExpr m) (skip : UInt64) :
     "get_major_inductive_id: no inductive-headed forall within scan bound")
 
 /-- Nat primitives: succ-collapse, binary arithmetic, boolean predicates. -/
-partial def tryReduceNat (e : KExpr m) : RecM m (Option (KExpr m)) :=
+def tryReduceNat (e : KExpr m) : RecM m (Option (KExpr m)) :=
   tryReduceNatWithSuccMode e .collapse
 
-partial def tryReduceNatWithSuccMode (e : KExpr m)
+def tryReduceNatWithSuccMode (e : KExpr m)
     (natSuccMode : NatSuccMode) : RecM m (Option (KExpr m)) := do
   let (head, args) := e.collectSpine
   let .const id _ _ := head | return none
@@ -956,77 +1098,56 @@ partial def tryReduceNatWithSuccMode (e : KExpr m)
 /-- Collapse a `Nat.succ` chain onto a literal (with stuck-chain memo: the
     inner WHNF runs in `stuck` mode which bypasses caches, so without the
     memo a stuck `succ^k(x)` re-peels from every depth — O(k²)). -/
-partial def tryReduceNatSuccIter (arg : KExpr m) :
+def tryReduceNatSuccIter (arg : KExpr m) :
     RecM m (Option (KExpr m)) := do
   let entryKey ← TcM.whnfKey arg
   if (← get).env.natSuccStuck.contains entryKey then
     return none
-  let mut visited : Array (Address × Address) := #[entryKey]
-  let mut offset : Nat := 1
-  let mut cur := arg
-  repeat
+  runBounded (fun (cur, offset, visited) => do
     if let some result ← tryReduceNatSuccLinearRec cur offset then
-      return some result
-    let w ← whnfWithNatSuccMode cur .stuck
+      return .done (some result)
+    let w ← whnfModeRec cur .stuck
     if let some n := extractNatLit w (← prims) then
-      return some (natExprFromValue (n + offset))
+      return .done (some (natExprFromValue (n + offset)))
     let (head, args) := w.collectSpine
     let isSucc ← match head with
       | .const id _ _ =>
         pure (id.addr == (← prims).natSucc.addr && args.size == 1)
       | _ => pure false
     if isSucc then
-      offset := offset + 1
-      cur := args[0]!
+      let offset := offset + 1
+      let cur := args[0]!
       let curKey ← TcM.whnfKey cur
       if (← get).env.natSuccStuck.contains curKey then
         -- Known-stuck suffix ⇒ the whole chain above is stuck too.
         let vs := visited
         modify fun s => { s with env := { s.env with
           natSuccStuck := vs.foldl (·.insert ·) s.env.natSuccStuck } }
-        return none
-      visited := visited.push curKey
+        return .done none
+      let visited := visited.push curKey
       -- succ(cur) can surface later as a succ-iter argument too.
-      visited := visited.push (← TcM.whnfKey w)
-      continue
+      let visited := visited.push (← TcM.whnfKey w)
+      return .next (cur, offset, visited)
     let vs := visited
     modify fun s => { s with env := { s.env with
       natSuccStuck := vs.foldl (·.insert ·) s.env.natSuccStuck } }
-    return none
-  return none
+    return .done none) maxWhnfFuel.toNat (arg, 1, #[entryKey])
 
 /-- `Nat.rec base step (lit n)` where step = `fun _ ih => Nat.succ ih`:
     compute `base + n + offset` directly. -/
-partial def tryReduceNatSuccLinearRec (arg : KExpr m) (offset : Nat) :
+def tryReduceNatSuccLinearRec (arg : KExpr m) (offset : Nat) :
     RecM m (Option (KExpr m)) := do
   let some parts ← natRecLiteralParts arg | return none
   let some base := parts.spine[parts.baseIdx]? | return none
   let some step := parts.spine[parts.stepIdx]? | return none
   if !(← isNatSuccIhStep step) then
     return none
-  let baseWhnf ← whnf base
+  let baseWhnf ← whnfRec base
   let some baseVal := extractNatValue baseWhnf (← prims) | return none
   return some (natExprFromValue (baseVal + parts.major + offset))
 
-partial def natRecLiteralParts (e : KExpr m) :
-    RecM m (Option (NatRecLiteralParts m)) := do
-  let (head, spine) := e.collectSpine
-  let .const id _ _ := head | return none
-  if id.addr != (← prims).natRec.addr then
-    return none
-  let some (.recr (params := params) (motives := motives) (minors := minors)
-      (indices := indices) ..) ← TcM.tryGetConst id
-    | return none
-  if minors.toNat < 2 then
-    return none
-  let baseIdx := params.toNat + motives.toNat
-  let stepIdx := baseIdx + 1
-  let majorIdx := params.toNat + motives.toNat + minors.toNat + indices.toNat
-  let some (.nat major _ _) := spine[majorIdx]? | return none
-  return some { spine, major, baseIdx, stepIdx }
-
-partial def isNatSuccIhStep (step : KExpr m) : RecM m Bool := do
-  let step ← whnf step
+def isNatSuccIhStep (step : KExpr m) : RecM m Bool := do
+  let step ← whnfRec step
   let .lam _ _ _ body _ := step | return false
   let .lam _ _ _ body _ := body | return false
   let (head, args) := body.collectSpine
@@ -1040,16 +1161,16 @@ partial def isNatSuccIhStep (step : KExpr m) : RecM m Bool := do
 /-- WHNF a Nat-reducer argument. Open arguments get a bounded local fuel so
     a stuck symbolic argument can't burn the shared budget; fuel exhaustion
     yields `none` (leave unreduced). -/
-partial def whnfNatReducerArg (arg : KExpr m) :
+def whnfNatReducerArg (arg : KExpr m) :
     RecM m (Option (KExpr m)) := do
   if !arg.hasFVars || (← get).eagerReduce then
-    return some (← whnf arg)
+    return some (← whnfRec arg)
   let savedFuel := (← get).recFuel
   let localFuel := min savedFuel natReducerOpenArgRecFuel
   modify fun s => { s with recFuel := localFuel }
   let result : Except (TcError m) (KExpr m) ←
     try
-      let w ← whnf arg
+      let w ← whnfRec arg
       pure (Except.ok w)
     catch e =>
       pure (Except.error e)
@@ -1060,7 +1181,7 @@ partial def whnfNatReducerArg (arg : KExpr m) :
   | .error .maxRecDepth | .error .maxRecFuel => return none
   | .error e => throw e
 
-partial def tryReduceNatPredicate (addr : Address) (args : Array (KExpr m)) :
+def tryReduceNatPredicate (addr : Address) (args : Array (KExpr m)) :
     RecM m (Option (KExpr m)) := do
   let some wa ← whnfNatReducerArg args[0]! | return none
   let p ← prims
@@ -1076,7 +1197,7 @@ partial def tryReduceNatPredicate (addr : Address) (args : Array (KExpr m)) :
     with the canonical kernel proof terms; `decLt n m → decLe (n+1) m`;
     Int decidables get literal *normalization* only. `decLe false` falls to
     delta (needs the `False` primitive). -/
-partial def tryReduceDecidable (e : KExpr m) : RecM m (Option (KExpr m)) := do
+def tryReduceDecidable (e : KExpr m) : RecM m (Option (KExpr m)) := do
   if (← get).noAccel then return none
   let (head, args) := e.collectSpine
   let .const id _ _ := head | return none
@@ -1092,8 +1213,8 @@ partial def tryReduceDecidable (e : KExpr m) : RecM m (Option (KExpr m)) := do
     return none
   if args.size < 2 then
     return none
-  let wa ← whnf args[0]!
-  let wb ← whnf args[1]!
+  let wa ← whnfRec args[0]!
+  let wb ← whnfRec args[1]!
   let some aVal := extractNatValue wa p | return none
   let some bVal := extractNatValue wb p | return none
   -- S5: @Eq.refl.{1} for Bool : Type = Sort 1.
@@ -1109,7 +1230,7 @@ partial def tryReduceDecidable (e : KExpr m) : RecM m (Option (KExpr m)) := do
   let some prop ← (do
     let some eTy ← try? (TcM.withInferOnly ((← read).infer e))
       | return none
-    let eTyWhnf ← whnf eTy
+    let eTyWhnf ← whnfRec eTy
     let (_, typeArgs) := eTyWhnf.collectSpine
     return typeArgs[0]?) | return none
   let (bResult, proofTrueFn, proofFalseFn) :=
@@ -1150,12 +1271,12 @@ partial def tryReduceDecidable (e : KExpr m) : RecM m (Option (KExpr m)) := do
 
 /-- Normalize Int decidable arguments to canonical ctor-form literals (the
     delta+iota chain then reduces them; no native Int evaluation). -/
-partial def tryNormalizeIntDecidable (addr : Address)
+def tryNormalizeIntDecidable (addr : Address)
     (args : Array (KExpr m)) : RecM m (Option (KExpr m)) := do
   if args.size < 2 then
     return none
-  let wa ← whnf args[0]!
-  let wb ← whnf args[1]!
+  let wa ← whnfRec args[0]!
+  let wb ← whnfRec args[1]!
   let p ← prims
   let some aVal := extractIntLit wa p | return none
   let some bVal := extractIntLit wb p | return none
@@ -1173,7 +1294,7 @@ partial def tryNormalizeIntDecidable (addr : Address)
 
 /-- Quotient reduction (`Quot.lift` arity 6 / major 5; `Quot.ind` arity 5 /
     major 4), gated on the resolved primitive addresses. -/
-partial def tryQuotReduce (e : KExpr m) : RecM m (Option (KExpr m)) := do
+def tryQuotReduce (e : KExpr m) : RecM m (Option (KExpr m)) := do
   let (head, args) := e.collectSpine
   let .const id _ _ := head | return none
   let p ← prims
@@ -1186,7 +1307,7 @@ partial def tryQuotReduce (e : KExpr m) : RecM m (Option (KExpr m)) := do
       pure (3, 4)
     else
       return none
-  let majorWhnf ← whnf args[majorIdx]!
+  let majorWhnf ← whnfRec args[majorIdx]!
   let (mkHead, mkArgs) := majorWhnf.collectSpine
   let .const mkId _ _ := mkHead | return none
   if mkId.addr != p.quotCtor.addr then
@@ -1201,33 +1322,16 @@ partial def tryQuotReduce (e : KExpr m) : RecM m (Option (KExpr m)) := do
 
 -- ### BitVec native reduction (whnf.rs try_reduce_bitvec)
 
-/-- Heads that leave a Nat-predicate argument stuck. -/
-partial def isNatStuckRecursorAddr (addr : Address) : RecM m Bool := do
-  let p ← prims
-  return addr == p.natRec.addr || addr == p.natCasesOn.addr
-    || addr == p.bitVecToNat.addr
-
-partial def isStuckNatPredicateProbe (e : KExpr m) : RecM m Bool := do
-  let (head, _) := e.collectSpine
-  match head with
-  | .const id _ _ =>
-    return (← isNatBinPredAddr id.addr) || (← isNatStuckRecursorAddr id.addr)
-  | .prj id _ val _ =>
-    if id.addr == (← prims).fin.addr then
-      return true
-    let (valHead, _) := val.collectSpine
-    match valHead with
-    | .const valId _ _ => isNatStuckRecursorAddr valId.addr
-    | _ => return false
-  | _ => return false
-
 /-- Bounded literal evaluator for widths/predicate args: literal
     extraction, succ/pred/binary-arith folding, stuck-probe early-out,
     whnf fallback. Mirrors whnf.rs `try_eval_nat_value_for_pred`. -/
-partial def tryEvalNatValueForPred (e : KExpr m) (depth : Nat := 0) :
-    RecM m (Option Nat) := do
-  if depth ≥ 64 then
-    return none
+def tryEvalNatValueForPred (e : KExpr m) (depth : Nat := 0) :
+    RecM m (Option Nat) :=
+  tryEvalNatValueForPredFuel (64 - depth) e
+
+def tryEvalNatValueForPredFuel : Nat → KExpr m → RecM m (Option Nat)
+  | 0, _ => return none
+  | fuel + 1, e => do
   let p ← prims
   if let some n := extractNatLit e p then
     return some n
@@ -1237,51 +1341,34 @@ partial def tryEvalNatValueForPred (e : KExpr m) (depth : Nat := 0) :
   match head with
   | .const id _ _ =>
     if id.addr == p.natSucc.addr && args.size == 1 then
-      let some pred ← tryEvalNatValueForPred args[0]! (depth + 1)
+      let some pred ← tryEvalNatValueForPredFuel fuel args[0]!
         | return none
       return some (pred + 1)
     if id.addr == p.natPred.addr && args.size == 1 then
-      let some n ← tryEvalNatValueForPred args[0]! (depth + 1)
+      let some n ← tryEvalNatValueForPredFuel fuel args[0]!
         | return none
       return some (n - 1)
     if (← isNatBinArithAddr id.addr) && args.size == 2 then
-      let some a ← tryEvalNatValueForPred args[0]! (depth + 1)
+      let some a ← tryEvalNatValueForPredFuel fuel args[0]!
         | return none
-      let some b ← tryEvalNatValueForPred args[1]! (depth + 1)
+      let some b ← tryEvalNatValueForPredFuel fuel args[1]!
         | return none
       return computeNatBin id.addr PrimAddrs.canonical a b
   | .var .. | .fvar .. | .sort .. | .lam .. | .all .. | .str .. | .nat .. =>
     return none
   | _ => pure ()
-  let w ← whnf e
+  let w ← whnfRec e
   if let some n := extractNatValue w p then
     return some n
   if w.addr == e.addr then
     return none
-  tryEvalNatValueForPred w (depth + 1)
-
-/-- `(width, n)` from `BitVec.ofNat width n` or
-    `OfNat.ofNat (BitVec width) n inst…`. -/
-partial def bitvecOfNatArgs (e : KExpr m) :
-    RecM m (Option (KExpr m × KExpr m)) := do
-  let p ← prims
-  let (head, args) := e.collectSpine
-  let .const id _ _ := head | return none
-  if id.addr == p.bitVecOfNat.addr && args.size == 2 then
-    return some (args[0]!, args[1]!)
-  if id.addr != p.ofNatOfNat.addr || args.size < 2 then
-    return none
-  let (typeHead, typeArgs) := args[0]!.collectSpine
-  let .const typeId _ _ := typeHead | return none
-  if typeId.addr == p.bitVec.addr && typeArgs.size == 1 then
-    return some (typeArgs[0]!, args[1]!)
-  return none
+  tryEvalNatValueForPredFuel fuel w
 
 /-- `BitVec.toNat (BitVec.ofNat w n) ⇒ n % 2^w` (width ≤ 2^24). -/
-partial def tryReduceBitvecToNat (value : KExpr m) :
+def tryReduceBitvecToNat (value : KExpr m) :
     RecM m (Option (KExpr m)) := do
   let some (width, nExpr) ← bitvecOfNatArgs value | return none
-  let nWhnf ← whnf nExpr
+  let nWhnf ← whnfRec nExpr
   let some n := extractNatValue nWhnf (← prims) | return none
   if n == 0 then
     return some (natLiteral 0)
@@ -1292,7 +1379,7 @@ partial def tryReduceBitvecToNat (value : KExpr m) :
 
 /-- `value.toNat` — collapsed when possible, else the symbolic
     `BitVec.toNat width value` application. -/
-partial def bitvecToNatExpr (width value : KExpr m) : RecM m (KExpr m) := do
+def bitvecToNatExpr (width value : KExpr m) : RecM m (KExpr m) := do
   if let some result ← tryReduceBitvecToNat value then
     return result
   let head ← TcM.intern (.mkConst (← prims).bitVecToNat #[])
@@ -1302,16 +1389,16 @@ partial def bitvecToNatExpr (width value : KExpr m) : RecM m (KExpr m) := do
 /-- `BitVec.ult w x y`: rhs 0 ⇒ false; both literal ⇒ compare; else the
     definitional `Nat.ble (succ x.toNat) y.toNat` route when it collapses
     to a Bool literal. -/
-partial def tryReduceBitvecUlt (width lhs rhs : KExpr m) :
+def tryReduceBitvecUlt (width lhs rhs : KExpr m) :
     RecM m (Option (KExpr m)) := do
   let p ← prims
   let lhsNat ← bitvecToNatExpr width lhs
   let rhsNat ← bitvecToNatExpr width rhs
-  let rhsNatWhnf ← whnf rhsNat
+  let rhsNatWhnf ← whnfRec rhsNat
   if let some rhsVal := extractNatValue rhsNatWhnf p then
     if rhsVal == 0 then
       return some (← TcM.intern (.mkConst p.boolFalse #[]))
-    let lhsNatWhnf ← whnf lhsNat
+    let lhsNatWhnf ← whnfRec lhsNat
     if let some lhsVal := extractNatValue lhsNatWhnf p then
       let resultId := if lhsVal < rhsVal then p.boolTrue else p.boolFalse
       return some (← TcM.intern (.mkConst resultId #[]))
@@ -1319,13 +1406,13 @@ partial def tryReduceBitvecUlt (width lhs rhs : KExpr m) :
   let ble ← TcM.intern (.mkConst p.natBle #[])
   let cmpLhs ← TcM.intern (.mkApp ble lhsSucc)
   let cmp ← TcM.intern (.mkApp cmpLhs rhsNat)
-  let result ← whnf cmp
+  let result ← whnfRec cmp
   if (← boolLitValue result).isSome then
     return some result
   return none
 
 /-- `LT.lt (BitVec w) inst x y ⇒ ult w x y`. -/
-partial def tryReduceBitvecLtProp (prop : KExpr m) :
+def tryReduceBitvecLtProp (prop : KExpr m) :
     RecM m (Option (KExpr m)) := do
   let p ← prims
   let (head, args) := prop.collectSpine
@@ -1340,7 +1427,7 @@ partial def tryReduceBitvecLtProp (prop : KExpr m) :
 
 /-- BitVec native reduction: `BitVec.toNat`, `BitVec.ult`, and
     `Decidable.decide (LT.lt (BitVec w) …)`. -/
-partial def tryReduceBitvec (e : KExpr m) : RecM m (Option (KExpr m)) := do
+def tryReduceBitvec (e : KExpr m) : RecM m (Option (KExpr m)) := do
   if (← get).noAccel then return none
   let p ← prims
   let (head, args) := e.collectSpine
@@ -1361,7 +1448,7 @@ partial def tryReduceBitvec (e : KExpr m) : RecM m (Option (KExpr m)) := do
 /-- Native reduction: `Lean.reduceBool/reduceNat` markers,
     `System.Platform.numBits ⇒ 64` (also the `Subtype.val (getNumBits ())`
     form), and the PUnit/Unit SizeOf singletons. -/
-partial def tryReduceNative (e : KExpr m) : RecM m (Option (KExpr m)) := do
+def tryReduceNative (e : KExpr m) : RecM m (Option (KExpr m)) := do
   if (← get).noAccel then return none
   let (head, args) := e.collectSpine
   let .const id _ _ := head | return none
@@ -1406,7 +1493,7 @@ partial def tryReduceNative (e : KExpr m) : RecM m (Option (KExpr m)) := do
   modify fun s => { s with inNativeReduce := true }
   let result : Except (TcError m) (KExpr m) ←
     try
-      let r ← whnf body
+      let r ← whnfRec body
       pure (Except.ok r)
     catch err =>
       pure (Except.error err)
@@ -1426,51 +1513,13 @@ partial def tryReduceNative (e : KExpr m) : RecM m (Option (KExpr m)) := do
     | .nat .. => return some result
     | _ => return none
 
-/-- String literal primitives: `String.back` / legacy back /
-    `utf8ByteSize` / `toByteArray ""`. -/
-partial def tryReduceString (e : KExpr m) : RecM m (Option (KExpr m)) := do
-  let (head, args) := e.collectSpine
-  if args.size != 1 then
-    return none
-  let .const id _ _ := head | return none
-  let p ← prims
-  let isBack := id.addr == p.stringBack.addr
-    || id.addr == p.stringLegacyBack.addr
-  let isUtf8ByteSize := id.addr == p.stringUtf8ByteSize.addr
-  let isToByteArray := id.addr == p.stringToByteArray.addr
-  if !isBack && !isUtf8ByteSize && !isToByteArray then
-    return none
-  let .str s _ _ := args[0]! | return none
-  if isUtf8ByteSize then
-    return some (← TcM.intern (natExprFromValue s.utf8ByteSize : KExpr m))
-  if isToByteArray then
-    if s.isEmpty then
-      return some (← TcM.intern (.mkConst p.byteArrayEmpty #[]))
-    return none
-  let codepoint := (s.toList.getLast?.map (·.toNat)).getD 65
-  charOfNatExpr codepoint
-
-partial def charOfNatExpr (n : Nat) : RecM m (Option (KExpr m)) := do
-  let charOfNat ← TcM.intern (.mkConst (← prims).charOfNat #[])
-  let natLit ← TcM.intern (natExprFromValue n : KExpr m)
-  return some (← TcM.intern (KExpr.mkApp charOfNat natLit))
-
 -- ### `is_rec` verification (inductive.rs `computed_is_rec` — hosted here
 -- because struct-likeness needs it; `Ix.Tc.Inductive` reuses it)
 
-partial def discoverBlockInductives (blockId : KId m) :
-    RecM m (Array (KId m)) := do
-  let some members ← TcM.tryGetBlock blockId | return #[]
-  let mut inds : Array (KId m) := #[]
-  for id in members do
-    if let some (.indc ..) ← TcM.tryGetConst id then
-      inds := inds.push id
-  return inds
-
 /-- Constructive `is_rec`: any constructor field (after params) mentioning
     any inductive of the mutual block. Provisional-true cache entry guards
     re-entrancy through whnf → struct-eta → isStructLike. -/
-partial def computedIsRec (ind : KId m) : RecM m Bool := do
+def computedIsRec (ind : KId m) : RecM m Bool := do
   if let some v := (← get).env.isRecCache[ind.addr]? then
     return v
   let (params, ctors, block) ← match (← TcM.getConst ind) with
@@ -1491,7 +1540,7 @@ partial def computedIsRec (ind : KId m) : RecM m Bool := do
       isRecCache := s.env.isRecCache.erase ind.addr } }
     throw e
 
-partial def computeIsRec (ctors : Array (KId m)) (nParams : Nat)
+def computeIsRec (ctors : Array (KId m)) (nParams : Nat)
     (blockAddrs : Array Address) : RecM m Bool := do
   for ctorId in ctors do
     let ctorTy ← match (← TcM.tryGetConst ctorId) with
@@ -1499,18 +1548,20 @@ partial def computeIsRec (ctors : Array (KId m)) (nParams : Nat)
       | _ => continue
     let mut ty := ctorTy
     for _ in [0:nParams] do
-      let w ← whnf ty
+      let w ← whnfRec ty
       match w with
       | .all _ _ _ body _ => ty := body
       | _ => break
-    repeat
-      let w ← whnf ty
+    let found ← runBounded (fun ty => do
+      let w ← whnfRec ty
       match w with
       | .all _ _ dom body _ =>
         if exprMentionsAnyAddr dom blockAddrs then
-          return true
-        ty := body
-      | _ => break
+          return .done true
+        return .next body
+      | _ => return .done false) maxWhnfFuel.toNat ty
+    if found then
+      return true
   return false
 
 end
diff --git a/Tests/Ix/Tc/CheckTests.lean b/Tests/Ix/Tc/CheckTests.lean
index c3580f62..382c0d74 100644
--- a/Tests/Ix/Tc/CheckTests.lean
+++ b/Tests/Ix/Tc/CheckTests.lean
@@ -119,6 +119,42 @@ def wellScopedTests : TestSeq :=
         | .error (.unknownConst _) => true
         | _ => false) : Bool))
 
+/-! ### K0 totalization boundaries -/
+
+def totalizationTests : TestSeq :=
+  test "universe validation preserves LIFO error order"
+    ((let a : KUniv .anon :=
+        .param 2 () (Address.blake3 "univ-work-a".toUTF8)
+      let b : KUniv .anon :=
+        .param 3 () (Address.blake3 "univ-work-b".toUTF8)
+      let root : KUniv .anon :=
+        .max a b (Address.blake3 "univ-work-root".toUTF8)
+      match ((RecM.validateUnivParamsSeen root 0 {}).run default).run
+          (TcState.ofEnvAnon {}) with
+      | .error (.univParamOutOfRange idx 0) _ => idx == 3
+      | _ => false) : Bool)
+  ++ test "well-scopedness worklist remains stack-safe on a deep spine"
+    ((let deep := (List.range 4096).foldl
+        (fun e n => KExpr.mkApp e (.mkNatLit n)) (.mkNatLit 0)
+      match ((RecM.validateExprWellScoped deep 0 0).run default).run
+          (TcState.ofEnvAnon {}) with
+      | .ok () _ => true
+      | .error _ _ => false) : Bool)
+  ++ test "nested-positivity zero depth fails before changing state"
+    ((let initial : TcState .anon :=
+        { TcState.ofEnvAnon {} with recFuel := 7 }
+      match ((RecM.checkPositivityDomainFuel 0 (.mkSort .mkZero) #[]).run
+          default).run initial with
+      | .error .maxRecDepth s => s.recFuel == 7 && s.lctx.size == 0
+      | _ => false) : Bool)
+  ++ test "forall counting restores the local context"
+    ((let sort0 : AE := .mkSort .mkZero
+      let ty := KExpr.mkAll () () sort0
+        (KExpr.mkAll () () sort0 (KExpr.mkAll () () sort0 sort0))
+      match ((RecM.countForalls ty).run default).run (TcState.ofEnvAnon {}) with
+      | .ok n s => n == 3 && s.lctx.size == 0
+      | .error _ _ => false) : Bool)
+
 /-! ### Safety lattice -/
 
 def safetyTests : TestSeq :=
@@ -153,6 +189,14 @@ def safetyTests : TestSeq :=
       let (ixon, puAddr) := storeConst ixon partialUser
       failsContaining ixon sAddr "references partial definition"
         && passes ixon puAddr : Bool))
+  ++ test "safety worklist remains stack-safe on a deep application spine"
+    ((let leaf := pAddr (Address.blake3 "safety-leaf".toUTF8)
+      let deep := (List.range 4096).foldl
+        (fun e n => KExpr.mkApp e (.mkNatLit n)) leaf
+      match ((RecM.checkNoUnsafeRefs deep .safe).run default).run
+          (TcState.ofEnvAnon {}) with
+      | .ok () _ => true
+      | .error _ _ => false) : Bool)
 
 /-! ### Quot validation -/
 
@@ -247,6 +291,89 @@ def lazyTests : TestSeq :=
       | .error (.other msg) _ => (msg.splitOn "integrity").length > 1
       | _ => false : Bool))
 
+/-! ### Failed-check cache isolation -/
+
+/-- Sizes of exactly the caches rolled back by the public `checkConst` error
+boundary. `blockCheckResults` is intentionally separate because new failures
+are retained for deterministic replay. -/
+def subjectCacheSizes (env : KEnv .anon) : Array Nat := #[
+  env.whnfCache.size,
+  env.whnfNoDeltaCache.size,
+  env.whnfNoDeltaCheapCache.size,
+  env.whnfCoreCache.size,
+  env.whnfCoreCheapCache.size,
+  env.inferCache.size,
+  env.inferOnlyCache.size,
+  env.defEqCache.size,
+  env.defEqCheapCache.size,
+  env.defEqFailure.size,
+  env.unfoldCache.size,
+  env.natSuccStuck.size,
+  env.isPropCache.size,
+  env.isRecCache.size,
+  env.recursorCache.size,
+  env.recMajorsCache.size,
+  env.blockPeerAgreementCache.size
+]
+
+def cacheIsolationTests : TestSeq :=
+  test "failed pending check rolls back new caches and preserves warm caches"
+    ((let (ixon, aAddr) := envA
+      let bad : Ixon.Constant :=
+        ⟨.defn ⟨.defn, .safe, 0, .ref 0 #[], .sort 0⟩,
+          #[], #[aAddr], #[.zero]⟩
+      let (ixon, badAddr) := storeConst ixon bad
+      let warmExpr := pAddr aAddr
+      let warmKey := (warmExpr.addr, emptyCtxAddr)
+      let replayBlock : KId .anon :=
+        ⟨Address.blake3 "cache-isolation-replay".toUTF8, ()⟩
+      let base := ingressEnvOf ixon
+      let warmed : KEnv .anon := { base with
+        whnfCache := base.whnfCache.insert warmKey warmExpr
+        blockCheckResults := base.blockCheckResults.insert replayBlock
+          (.error .typeExpected) }
+      let initial := TcState.ofEnvAnon warmed
+      let raw := (TcM.runRec
+        (RecM.checkConst (m := .anon) ⟨badAddr, ()⟩)).run initial
+      let isolated := (TcM.checkConst (m := .anon) ⟨badAddr, ()⟩).run initial
+      match raw, isolated with
+      | .error _ rawState, .error _ isolatedState =>
+        let rawGrew := subjectCacheSizes rawState.env != subjectCacheSizes warmed
+        let rolledBack :=
+          subjectCacheSizes isolatedState.env == subjectCacheSizes warmed
+        let warmEntryKept :=
+          isolatedState.env.whnfCache[warmKey]? == some warmExpr
+        let replayKept :=
+          match isolatedState.env.blockCheckResults[replayBlock]? with
+          | some (.error .typeExpected) => true
+          | _ => false
+        let nonCacheStateKept :=
+          isolatedState.env.consts.size == rawState.env.consts.size &&
+            isolatedState.recFuel == rawState.recFuel
+        let nextWarm :=
+          (TcM.checkConst (m := .anon) ⟨aAddr, ()⟩).run isolatedState
+        let nextFresh :=
+          (TcM.checkConst (m := .anon) ⟨aAddr, ()⟩).run initial
+        let sameVerdict := match nextWarm, nextFresh with
+          | .ok () _, .ok () _ => true
+          | .error e _, .error e' _ => e == e'
+          | _, _ => false
+        rawGrew && rolledBack && warmEntryKept && replayKept &&
+          nonCacheStateKept && sameVerdict
+      | _, _ => false : Bool))
+  ++ test "error rollback retains an earlier block success"
+    ((let block : KId .anon :=
+        ⟨Address.blake3 "cache-isolation-old-success".toUTF8, ()⟩
+      let emptyEnv : KEnv .anon := {}
+      let before : KEnv .anon := { emptyEnv with
+        blockCheckResults := emptyEnv.blockCheckResults.insert block (.ok ()) }
+      let after : KEnv .anon := { before with
+        blockCheckResults := before.blockCheckResults.insert block
+          (.error .typeExpected) }
+      match (before.restoreCheckCachesOnError after).blockCheckResults[block]? with
+      | some (.ok ()) => true
+      | _ => false : Bool))
+
 /-! ### Forced verification of primitive addresses (`--no-verify` hole)
 
 Acceleration substitutes native semantics for the declarations at the
@@ -524,7 +651,9 @@ def parallelTests : TestSeq :=
            fails={report.failures.size} kenv={kenv.consts.size}")) .done
 
 public def suite : List TestSeq :=
-  [acceptRejectTests, wellScopedTests, safetyTests, quotTests, blockTests,
-   lazyTests, primVerifyTests, inductiveTests, recursorTests, parallelTests]
+  [acceptRejectTests, wellScopedTests, totalizationTests, safetyTests,
+   quotTests, blockTests,
+   lazyTests, cacheIsolationTests, primVerifyTests, inductiveTests,
+   recursorTests, parallelTests]
 
 end Tests.Tc.CheckTests
diff --git a/Tests/Ix/Tc/InferDefEq.lean b/Tests/Ix/Tc/InferDefEq.lean
index d07796b3..08782f55 100644
--- a/Tests/Ix/Tc/InferDefEq.lean
+++ b/Tests/Ix/Tc/InferDefEq.lean
@@ -7,7 +7,7 @@ public import Tests.Ix.Tc.WhnfTests
 
 /-!
 Type inference and definitional equality with the real knot
-(`Ix.Tc.methods`). Exercises the tiers that were inert under stub methods:
+(`Ix.Tc.methodsN`). Exercises the tiers that were inert under stub methods:
 K-like ctor synthesis in iota, proof irrelevance, lambda eta, struct eta,
 and unit-like equality.
 -/
@@ -38,6 +38,87 @@ def runTcOn (env : AnonEnv) (x : TcM .anon α) : Except (TcError .anon) α :=
   | .ok a _ => .ok a
   | .error e _ => .error e
 
+/-- One of the direct method-table reads used by the production knot. -/
+def directInferBackedge (e : AE) : RecM .anon AE :=
+  fun methods => methods.infer e
+
+/-- The two policy-sensitive WHNF back-edges added to make cheap projection
+    and stuck-successor recursion decrease the same method-table index. -/
+def directWhnfModeBackedge (e : AE) (mode : NatSuccMode) : RecM .anon AE :=
+  fun methods => methods.whnfMode e mode
+
+def directWhnfCoreFlagsBackedge (e : AE) (flags : WhnfFlags) :
+    RecM .anon AE :=
+  fun methods => methods.whnfCoreFlags e flags
+
+def knotFuelTests : TestSeq :=
+  test "zero current fuel rejects the first method back-edge without mutation"
+    ((let initial : TcState .anon :=
+        { TcState.ofEnvAnon {} with recFuel := 0, fuelBudget := 37 }
+      match (TcM.runRec (directInferBackedge sort0)).run initial with
+      | .error .maxRecFuel final =>
+        final.recFuel == 0 && final.fuelBudget == 37 &&
+          final.dispatchDepth == initial.dispatchDepth &&
+          final.env.consts.size == initial.env.consts.size
+      | _ => false) : Bool)
+  ++ test "one method-table level permits one non-recursive infer dispatch"
+    ((let initial : TcState .anon :=
+        { TcState.ofEnvAnon {} with recFuel := 1, fuelBudget := 99 }
+      match (TcM.runRec (directInferBackedge sort0)).run initial with
+      | .ok ty final => ty.addr == sort1.addr && final.recFuel == 1
+      | _ => false) : Bool)
+  ++ test "zero depth rejects policy-sensitive WHNF back-edges unchanged"
+    ((let initial : TcState .anon :=
+        { TcState.ofEnvAnon {} with recFuel := 0, fuelBudget := 41 }
+      match (TcM.runRec
+              (directWhnfModeBackedge sort0 .stuck)).run initial,
+          (TcM.runRec
+              (directWhnfCoreFlagsBackedge sort0 .DEF_EQ_CORE)).run initial with
+      | .error .maxRecFuel modeFinal, .error .maxRecFuel flagsFinal =>
+        modeFinal.recFuel == initial.recFuel &&
+          modeFinal.fuelBudget == initial.fuelBudget &&
+          modeFinal.dispatchDepth == initial.dispatchDepth &&
+          modeFinal.env.consts.size == initial.env.consts.size &&
+          flagsFinal.recFuel == initial.recFuel &&
+          flagsFinal.fuelBudget == initial.fuelBudget &&
+          flagsFinal.dispatchDepth == initial.dispatchDepth &&
+          flagsFinal.env.consts.size == initial.env.consts.size
+      | _, _ => false) : Bool)
+  ++ test "one level admits non-recursive policy-sensitive WHNF dispatch"
+    ((let initial : TcState .anon :=
+        { TcState.ofEnvAnon {} with recFuel := 1, fuelBudget := 43 }
+      match (TcM.runRec
+              (directWhnfModeBackedge sort0 .stuck)).run initial,
+          (TcM.runRec
+              (directWhnfCoreFlagsBackedge sort0 .DEF_EQ_CORE)).run initial with
+      | .ok modeResult modeFinal, .ok flagsResult flagsFinal =>
+        modeResult.addr == sort0.addr && flagsResult.addr == sort0.addr &&
+          modeFinal.recFuel == initial.recFuel &&
+          modeFinal.fuelBudget == initial.fuelBudget &&
+          modeFinal.dispatchDepth == initial.dispatchDepth &&
+          flagsFinal.recFuel == initial.recFuel &&
+          flagsFinal.fuelBudget == initial.fuelBudget &&
+          flagsFinal.dispatchDepth == initial.dispatchDepth
+      | _, _ => false) : Bool)
+  ++ test "zero fuel still permits a top-level infer with no back-edge"
+    ((let initial : TcState .anon :=
+        { TcState.ofEnvAnon {} with recFuel := 0, fuelBudget := 99 }
+      match (TcM.infer sort0).run initial with
+      | .ok ty final => ty.addr == sort1.addr && final.recFuel == 0
+      | _ => false) : Bool)
+  ++ test "Infer structural recursion consumes method-table depth"
+    ((let forallExpr := KExpr.mkAll () () sort0 sort0
+      let zero : TcState .anon :=
+        { TcState.ofEnvAnon {} with recFuel := 0, fuelBudget := 17 }
+      let one : TcState .anon :=
+        { TcState.ofEnvAnon {} with recFuel := 1, fuelBudget := 17 }
+      match (TcM.infer forallExpr).run zero,
+          (TcM.infer forallExpr).run one with
+      | .error .maxRecFuel zeroFinal, .ok _ oneFinal =>
+        zeroFinal.recFuel == 0 && zeroFinal.fuelBudget == 17 &&
+          zeroFinal.env.inferCache.isEmpty && oneFinal.recFuel == 1
+      | _, _ => false) : Bool)
+
 def inferEq (env : AnonEnv) (e expected : AE) : Bool :=
   match runTcOn env (TcM.infer e) with
   | .ok ty => ty.addr == expected.addr
@@ -258,6 +339,7 @@ def defEqAdvanced : TestSeq :=
       | .ok v s => v && s.env.defEqFailure.size ≥ 0
       | .error _ _ => false : Bool))
 
-public def suite : List TestSeq := [inferTests, defEqBasics, defEqAdvanced]
+public def suite : List TestSeq :=
+  [knotFuelTests, inferTests, defEqBasics, defEqAdvanced]
 
 end Tests.Tc.InferDefEq
diff --git a/Tests/Ix/Tc/Substrate.lean b/Tests/Ix/Tc/Substrate.lean
index 9017f56c..32183b84 100644
--- a/Tests/Ix/Tc/Substrate.lean
+++ b/Tests/Ix/Tc/Substrate.lean
@@ -213,6 +213,11 @@ def equivTests : TestSeq :=
       let (inC1, em) := em.isEquiv (eqAddr 100, c1) (eqAddr 200, c1)
       let (inC2, _) := em.isEquiv (eqAddr 100, c2) (eqAddr 200, c2)
       return inC1 && !inC2)
+  ++ test "find reaches the root and path-halves within the node bound"
+    ((let em : EquivManager :=
+        { parent := #[1, 2, 3, 3], rank := #[0, 0, 0, 0] }
+      let (root, em) := em.find 0
+      root == 3 && em.parent == #[2, 2, 3, 3]) : Bool)
 
 /-! ### TcM: ctx-id chain, cache keys, fuel, modes (ported from tc.rs tests) -/
 
@@ -259,6 +264,18 @@ def ctxTests : TestSeq :=
       TcM.popLocal
       let c3 := (← get).numLetBindings
       return c1 == 1 && c2 == 1 && c3 == 0) == .ok true)
+  ++ test "restoreDepth pops the exact suffix and restores frame metadata"
+    (runTcVal (do
+      TcM.pushLocal sort0
+      let saved := (← get).ctx.size
+      let savedId := (← get).ctxId
+      TcM.pushLet sort1 sort0
+      TcM.pushLocal sort1
+      TcM.restoreDepth saved
+      let s ← get
+      return s.ctx.size == saved && s.letVals.size == saved &&
+        s.numLetBindings == 0 && s.ctxId == savedId &&
+        s.ctxIdStack.size == saved) == .ok true)
   ++ test "whnfKey empty ctx for closed expr"
     (runTcVal (do
       TcM.pushLocal sort0
diff --git a/Tests/Ix/Tc/Unit.lean b/Tests/Ix/Tc/Unit.lean
index 76c5077a..bf076c7c 100644
--- a/Tests/Ix/Tc/Unit.lean
+++ b/Tests/Ix/Tc/Unit.lean
@@ -114,6 +114,45 @@ def exprAnonMeta : TestSeq :=
   ++ test "nat" ((aNatLit 42).addr == (mNatLit 42).addr)
   ++ test "str" ((aStrLit "hello").addr == (mStrLit "hello").addr)
 
+def renderTests : TestSeq :=
+  test "render preserves leaf output through depth 20"
+    (KExpr.render (aVar 0) 20 == "#0")
+  ++ test "render cuts off before inspecting a node at depth 21"
+    (KExpr.render (aVar 0) 21 == "...")
+  ++ test "render gives children the predecessor budget"
+    (KExpr.render (KExpr.mkApp (aVar 0) (aVar 1)) 20 == "(... ...)")
+
+def canonicalTotalizationTests : TestSeq :=
+  test "compareKUniv recurses structurally through successors"
+    (compareKUniv (KUniv.mkSucc aZ) (KUniv.mkSucc (aP 0)) ==
+      compareKUniv aZ (aP 0))
+  ++ test "mergeSorted preserves the left-before-right tie rule"
+    ((let leftId := aId "left"
+      let rightId := aId "right"
+      let c : KConst .anon := .axio () () false 0 sort0A
+      match mergeSorted {} (fun _ => none) #[(leftId, c)] #[(rightId, c)] with
+      | .ok items =>
+        items.size == 2 && items[0]!.1 == leftId && items[1]!.1 == rightId
+      | .error _ => false) : Bool)
+  ++ test "canonical refinement keeps its empty-input fast path"
+    ((match sortKConstsWithSeedKey (m := .anon) (fun _ => none)
+        (fun id _ => id.addr) #[] with
+      | .ok classes => classes.isEmpty
+      | .error _ => false) : Bool)
+
+def occurrenceTests : TestSeq :=
+  test "exprMentionsAddr sees constant and projection heads"
+    ((let c := aId "needle"
+      let e := KExpr.mkLet () sort0A (KExpr.mkConst c #[])
+        (KExpr.mkPrj c 0 (aVar 0)) false
+      exprMentionsAddr e c.addr &&
+        !exprMentionsAddr e (aId "absent").addr) : Bool)
+  ++ test "exprMentionsAddr remains stack-safe on a deep application spine"
+    ((let c := aId "deep-needle"
+      let e := (List.range 4096).foldl
+        (fun e _ => KExpr.mkApp e (aVar 0)) (KExpr.mkConst c #[])
+      exprMentionsAddr e c.addr) : Bool)
+
 /-! ### ExprInfo invariants (ported from expr.rs tests) -/
 
 def exprInfo : TestSeq :=
@@ -362,7 +401,8 @@ def modeTests : TestSeq :=
           == (Address.blake3 "x".toUTF8).cmpBytes (Address.blake3 "y".toUTF8)))
 
 public def suite : List TestSeq :=
-  [rawParity, univAnonMeta, exprAnonMeta, exprInfo, smartCtors, levelAlgebra,
-   props, modeTests]
+  [rawParity, univAnonMeta, exprAnonMeta, renderTests,
+    canonicalTotalizationTests, occurrenceTests, exprInfo, smartCtors,
+    levelAlgebra, props, modeTests]
 
 end Tests.Tc.Unit
diff --git a/Tests/Ix/Tc/WhnfTests.lean b/Tests/Ix/Tc/WhnfTests.lean
index c34100b4..9a8d3dac 100644
--- a/Tests/Ix/Tc/WhnfTests.lean
+++ b/Tests/Ix/Tc/WhnfTests.lean
@@ -31,9 +31,24 @@ def appN (f : AE) (args : List AE) : AE := args.foldl .mkApp f
 
 def P := PrimAddrs.canonical
 
-/-- Run a whnf action against a given anon env with stub methods. -/
+/-- Tie only WHNF's internal policy-sensitive recursion. Infer/isDefEq stay
+    as throw stubs, preserving the isolation this suite relies on. -/
+def whnfOnlyMethodsN : Nat → Methods .anon
+  | 0 => default
+  | n + 1 =>
+    { (default : Methods .anon) with
+      whnf := fun e => (RecM.whnf e).run (whnfOnlyMethodsN n)
+      whnfCore := fun e => (RecM.whnfCore e).run (whnfOnlyMethodsN n)
+      whnfMode := fun e mode =>
+        (RecM.whnfWithNatSuccMode e mode).run (whnfOnlyMethodsN n)
+      whnfCoreFlags := fun e flags =>
+        (RecM.whnfCoreWithFlags e flags).run (whnfOnlyMethodsN n) }
+
+/-- Run a whnf action against a given anon env with only the non-WHNF
+    back-edges stubbed. -/
 def runWhnf (env : AnonEnv) (e : AE) : Except (TcError .anon) AE :=
-  match ((RecM.whnf e).run default).run (.ofEnvAnon env) with
+  match ((RecM.whnf e).run (whnfOnlyMethodsN maxWhnfFuel.toNat)).run
+      (.ofEnvAnon env) with
   | .ok a _ => .ok a
   | .error err _ => .error err
 
@@ -44,6 +59,80 @@ def whnfEq (env : AnonEnv) (e expected : AE) : Bool :=
 
 def emptyEnv : AnonEnv := {}
 
+/-! ### Totalized pure helpers -/
+
+def pureHelperTests : TestSeq :=
+  test "extractNatValue accepts literals and exact unary successor spines"
+    (extractNatValue (natLit 7) Primitives.ofAnonAddrs == some 7 &&
+      extractNatValue
+        (KExpr.mkApp (pAddr P.natSucc)
+          (KExpr.mkApp (pAddr P.natSucc) (natLit 3)))
+        Primitives.ofAnonAddrs == some 5)
+  ++ test "extractNatValue rejects an over-applied successor"
+    (extractNatValue
+      (appN (pAddr P.natSucc) [natLit 1, natLit 2])
+      Primitives.ofAnonAddrs == none)
+  ++ test "projectionDefinitionInfo counts lambdas and projected parameter"
+    ((let structId := aId "S"
+      let body := KExpr.mkPrj structId 3 (.mkVar 1 ())
+      let wrapper := KExpr.mkLam () () sort0
+        (KExpr.mkLam () () sort0 body)
+      projectionDefinitionInfo wrapper == some (2, structId, 3, 0)) : Bool)
+  ++ test "projectionDefinitionInfo rejects a variable outside the wrapper"
+    ((let structId := aId "S"
+      let wrapper := KExpr.mkLam () () sort0
+        (KExpr.mkPrj structId 0 (.mkVar 1 ()))
+      (projectionDefinitionInfo wrapper).isNone) : Bool)
+  ++ test "natOffset preserves symbolic base and counts the successor spine"
+    ((let x := pConst (aId "x")
+      let e := KExpr.mkApp (pAddr P.natSucc)
+        (KExpr.mkApp (pAddr P.natSucc) x)
+      match ((RecM.natOffset e 0).run default).run (.ofEnvAnon {}) with
+      | .ok (some (base, offset)) _ => base.addr == x.addr && offset == 2
+      | _ => false) : Bool)
+  ++ test "Nat-offset depth cutoff occurs before literal inspection"
+    ((let e := natLit 9
+      let state := TcState.ofEnvAnon {}
+      match ((RecM.evalNatOffsetLiteral e 255).run default).run state,
+          ((RecM.evalNatOffsetLiteral e 256).run default).run state with
+      | .ok (some 9) _, .ok none _ => true
+      | _, _ => false) : Bool)
+  ++ test "predicate Nat evaluator zero fuel returns none unchanged"
+    ((let initial : TcState .anon :=
+        { TcState.ofEnvAnon {} with recFuel := 7, fuelBudget := 11 }
+      match ((RecM.tryEvalNatValueForPredFuel 0 (natLit 9)).run default).run
+          initial with
+      | .ok none final =>
+        final.recFuel == initial.recFuel &&
+          final.fuelBudget == initial.fuelBudget &&
+          final.dispatchDepth == initial.dispatchDepth &&
+          final.env.consts.size == initial.env.consts.size
+      | _ => false) : Bool)
+  ++ test "bounded-loop exhaustion occurs before the next step"
+    ((let step (n : Nat) :
+          RecM .anon (RecM.BoundedStep Nat Nat) := do
+        modify fun s => { s with recFuel := s.recFuel - 1 }
+        return .next (n + 1)
+      let initial : TcState .anon :=
+        { TcState.ofEnvAnon {} with recFuel := 7 }
+      match (RecM.runBounded step 0 0).run default initial,
+          (RecM.runBounded step 1 0).run default initial with
+      | .error .maxRecDepth zeroState, .error .maxRecDepth oneState =>
+        zeroState.recFuel == 7 && oneState.recFuel == 6
+      | _, _ => false) : Bool)
+  ++ test "beta-lambda peeling is bounded by the application spine"
+    ((let x := pConst (aId "x")
+      let y := pConst (aId "y")
+      let z := pConst (aId "z")
+      let body := KExpr.mkVar 1 ()
+      let lam2 := KExpr.mkLam () () sort1
+        (KExpr.mkLam () () sort1 body)
+      match RecM.consumeBetaLams lam2 #[x, y, z] with
+      | (.var 1 _ _, consumed) =>
+        consumed.size == 2 && consumed[0]!.addr == x.addr &&
+          consumed[1]!.addr == y.addr
+      | _ => false) : Bool)
+
 /-! ### Structural reduction -/
 
 def structuralTests : TestSeq :=
@@ -231,7 +320,8 @@ def nativeTests : TestSeq :=
 def cacheTests : TestSeq :=
   test "whnf caches full results"
     ((let e := appN (pAddr P.natAdd) [natLit 2, natLit 3]
-     match ((RecM.whnf e).run default).run (.ofEnvAnon {}) with
+     match ((RecM.whnf e).run (whnfOnlyMethodsN maxWhnfFuel.toNat)).run
+         (.ofEnvAnon {}) with
      | .ok _ s => !s.env.whnfCache.isEmpty
      | .error _ _ => false : Bool))
   ++ test "iota results land in the whnf cache"
@@ -240,12 +330,14 @@ def cacheTests : TestSeq :=
      let recId := recrProjAddr blockAddr 1
      let e := appN (pAddr recId)
        [pConst (aId "m"), pConst (aId "n"), pAddr (ctorProjAddr blockAddr 0 0)]
-     match ((RecM.whnf e).run default).run (.ofEnvAnon env) with
+     match ((RecM.whnf e).run (whnfOnlyMethodsN maxWhnfFuel.toNat)).run
+         (.ofEnvAnon env) with
      | .ok _ s => !s.env.whnfCache.isEmpty
      | .error _ _ => false : Bool))
 
 public def suite : List TestSeq :=
-  [structuralTests, iotaTests, natTests, nativeTests, cacheTests]
+  [pureHelperTests, structuralTests, iotaTests, natTests, nativeTests,
+    cacheTests]
 
 end Tests.Tc.WhnfTests
 
diff --git a/docs/tc-k0-backedge-audit.md b/docs/tc-k0-backedge-audit.md
new file mode 100644
index 00000000..243e79e7
--- /dev/null
+++ b/docs/tc-k0-backedge-audit.md
@@ -0,0 +1,180 @@
+# Ix.Tc K0 recursion and back-edge audit
+
+Snapshot: 2026-07-27. This is the named K0 tick/measure artifact required by
+the formal-verification plan. Its production scope is the kernel call graph
+rooted at `TcM.checkConst`: `Whnf`, `Infer`, `DefEq`, `Inductive`, and
+`Check`, together with the shared monad, expression, local-context,
+union-find, and canonical-checking helpers they call. Ingress, egress,
+parallel scheduling, and the meta-level trust-audit visitor are not on that
+call graph.
+
+The audit result is now:
+
+- zero `partial def` declarations in the production kernel call graph;
+- zero `while` or `repeat` terms in the five recursive kernel modules;
+- a total six-field recursive-method table, indexed by an explicit `Nat`;
+- explicit finite bounds for every loop or recursive strongly connected
+  component that Lean could not accept structurally;
+- exact equations and fuel-boundary regressions for the totalization seams.
+
+A finite bound is operational evidence, not a soundness proof. K1 and K2
+must still prove the semantic WF properties of the transparent algorithms.
+
+## Shared runtime fuel
+
+There is one shared runtime counter, `TcState.recFuel`. Exactly two
+production sites consume it:
+
+| Entry | Charge point | Fast paths before the charge | Exhaustion |
+|---|---|---|---|
+| `RecM.whnf` | `whnfWithNatSuccMode`, after quick exits and cache hits | non-reducing forms and a warm `whnfCache` hit | `.maxRecFuel`; `TcM.tick` leaves the error state unchanged |
+| `RecM.isDefEq` | `isDefEq`, after address, equivalence-manager, and cache exits | reflexive/equivalent/cached results | `.maxRecFuel`; `TcM.tick` leaves the error state unchanged |
+
+`RecM.infer`, `RecM.whnfCore`, and `RecM.whnfNoDelta` have no entry tick.
+Consequently, “every recursive hop ticks” is false and must never be used as
+a termination or soundness argument.
+
+`TcM.runRec` selects `methodsN s.recFuel.toNat` from the current state once,
+not from `fuelBudget`. The method-table index is a logical call-depth bound;
+crossing a back-edge uses the predecessor table without itself mutating
+runtime state. Runtime ticks and method depth are therefore separate
+resources even though the initial value of the latter is selected from
+`recFuel`.
+
+## Total recursive-method knot
+
+`Methods` has six fields. The two policy-sensitive WHNF fields are necessary:
+re-entering plain `whnf` would incorrectly restore successor collapse, and
+re-entering plain `whnfCore` would incorrectly discard cheap projection/
+recursor flags.
+
+| Field | Successor-table implementation | Main production back-edges |
+|---|---|---|
+| `whnf` | `RecM.whnf` under `methodsN n` | `whnfRec` |
+| `whnfCore` | `RecM.whnfCore` under `methodsN n` | retained public/legacy interface; no raw algorithmic read |
+| `whnfMode` | `RecM.whnfWithNatSuccMode` under `methodsN n` | stuck-successor normalization through `whnfModeRec` |
+| `whnfCoreFlags` | `RecM.whnfCoreWithFlags` under `methodsN n` | cheap/full structural recursion through `whnfCoreFlagsRec` |
+| `infer` | `RecM.infer` under `methodsN n` | `inferCall`, `inferOnlyCall`, and five WHNF inference probes |
+| `isDefEq` | `RecM.isDefEq` under `methodsN n` | `isDefEqCall` plus WHNF's instrumented `callIsDefEq` probe |
+
+`methodsOut` implements all six fields as `.maxRecFuel` with the input state
+unchanged. `methodsN 0 = methodsOut`; every field of `methodsN (n + 1)` runs
+its corresponding algorithm under `methodsN n`. Thus every logical
+back-edge decreases the table index even on tick-free paths and on arguments
+that are not syntactic subterms.
+
+The direct-read audit is:
+
+```text
+rg -n '\(← read\)\.(whnf|whnfCore|whnfMode|whnfCoreFlags|infer|isDefEq)' \
+  Ix/Tc --glob '*.lean'
+```
+
+The live edges have the following roles:
+
+- WHNF recursion uses `whnfRec`, `whnfModeRec`, and `whnfCoreFlagsRec`.
+- WHNF has five direct `infer` probes in struct-eta, K-recursion, and
+  decidable reduction. They still read the predecessor table; the direct
+  syntax avoids an `Infer` import cycle.
+- Infer's structural recursion uses `inferCall`; infer-only recursion wraps
+  the same predecessor field with `TcM.withInferOnly`.
+- Every recursive DefEq edge uses `isDefEqCall`. Its inference probes use
+  `inferOnlyCall`.
+- `Inductive.computeKTarget` uses `inferOnlyCall`.
+- `Whnf.synthCtorWhenK` uses `callIsDefEq`, which adds balanced diagnostic
+  dispatch instrumentation around the same predecessor field.
+
+The four older `call*` wrappers maintain `dispatchDepth`. That counter is
+not the termination argument. `maxDispatchDepth = 200000` is only a
+Lean-side native-stack hardening guard, and its `.other` error is deliberately
+distinct from parity-visible `.maxRecDepth`.
+
+## Explicit local bounds and measures
+
+| Cluster | Bound / measure | Exhaustion behavior |
+|---|---|---|
+| WHNF delta, core, no-delta, stuck-successor, and telescope scans | `maxWhnfFuel = 10000` through `RecM.runBounded` | `.maxRecDepth` before invoking the next step |
+| DefEq lazy-delta and projection loops | `maxWhnfFuel` through `runBounded` | `.maxRecDepth` before the next step |
+| Inductive positivity, universe/field, nested-type, flat-block, recursor, and telescope scans | structural worklists or `maxWhnfFuel` | structural completion or `.maxRecDepth` |
+| `Check.countForalls` | `maxWhnfFuel` | `.maxRecDepth`; completed iterations retain their state, matching `EStateM` |
+| Nat-offset walkers | `256 - depth` | successful `none` at zero |
+| predicate Nat evaluator | `64 - depth` | successful `none` at zero |
+| beta-lambda peeling | original application-argument count | returns the consumed prefix |
+| positivity/nested-constructor mutual SCC | decreasing `Nat`, initialized from `maxWhnfFuel` | `.maxRecDepth` at zero |
+| open Nat-reducer argument | temporary `min recFuel 4096` | restores the outer counter minus fuel actually consumed |
+| DefEq semantic recursion guard | `maxDefEqDepth = 2000` | `.maxRecDepth`, after balancing `defEqDepth` |
+
+Expression occurrence, safety-reference, universe-validation, and
+well-scopedness traversals use explicit worklists with structural measures.
+Canonical sorting/refinement uses input-size fuel; context truncation,
+context-suffix closure, and union-find path halving use finite container-size
+bounds. These replacements preserve the old traversal order where errors are
+observable; unit regressions pin the LIFO universe-validation order.
+
+The operational behavior change is intentionally narrow: malformed or
+adversarial inputs that could previously diverge in an unbounded loop now
+return `.maxRecDepth` at the documented cap. Valid-corpus verdict and
+headroom parity is the A5 closure gate. Rust and Aiur are deliberately
+unchanged in K0; any corresponding hardening is a later transport obligation
+after the Ix.Tc theorem interface is stable.
+
+## Proof and regression surface
+
+`Ix.Tc.Verify.Totalization` exposes, and the completed trust manifest audits:
+
+- zero/successor equations for all six `methodsN` fields;
+- unchanged-error-state equations for all six `methodsOut` fields;
+- `TcM.runRec` current-fuel and public-entry equations;
+- exact run equations for `inferCall`, `inferOnlyCall`, `isDefEqCall`,
+  `whnfRec`, `whnfModeRec`, and `whnfCoreFlagsRec`;
+- wrapper equations for full/stuck WHNF, full/cheap WHNF core, Infer, Nat
+  evaluators, worklists, and every introduced zero-fuel boundary;
+- production `checkInductive`, recursor, `RecM.checkConst`, and
+  `TcM.checkConst` roots now that the complete kernel is transparent.
+
+Regressions cover zero table depth before mutation, one-level non-recursive
+dispatch for all relevant method families, Infer structural depth, zero
+local-loop fuel before the next mutation, exact LIFO diagnostics, deep
+worklist stack safety, local-context restoration, and normal-corpus checker
+behavior.
+
+The reproducible source audits are:
+
+```text
+rg -n '^\s*partial def' \
+  Ix/Tc/{Whnf,Infer,DefEq,Inductive,Check}.lean
+rg -n '^\s*(while|repeat)\b' \
+  Ix/Tc/{Whnf,Infer,DefEq,Inductive,Check}.lean
+rg -n 'TcM\.tick' \
+  Ix/Tc/{Whnf,Infer,DefEq,Inductive,Check}.lean
+```
+
+The first two must return no matches; the last must return exactly the WHNF
+and DefEq charge sites described above.
+
+## Boundary to K1/K2
+
+K0 establishes total, equation-visible production functions and preserves
+their tested operational behavior. It does **not** establish checker
+soundness. `Methods.WF`, the conditional WHNF/Infer/DefEq WF theorems, and
+the knot-closing induction `(methodsN n).WF` belong to K1/K2. In particular,
+the method index closes Lean termination for tick-free cycles, but K1/K2
+must still prove that each field preserves `VerifyWorld`, run support, cache
+coherence, and the declared native/inductive oracle boundaries.
+
+## Closure validation
+
+The 2026-07-27 K0 closure run passed all of the following:
+
+- exact four-statement sorry-frontier check;
+- completed (295 roots) and statement (4 roots) trust audits;
+- `lake build IxTcVerify` and the default `lake build`;
+- strict `tc-unit` with warnings treated as failures;
+- pinned Init/Std stress constants and accelerated-versus-pure differential;
+- Init-scale anon verdict parity;
+- focused anon differential, full anon/meta roundtrip, and `tc-init` suites;
+- Lean4Lean replay and tutorial suites.
+
+No production source in the Rust kernel or Aiur IxVM was changed. Their
+acceptance simulation/refinement work remains downstream of the Ix.Tc
+soundness theorem.
diff --git a/lakefile.lean b/lakefile.lean
index 0cef6469..fa86b2f2 100644
--- a/lakefile.lean
+++ b/lakefile.lean
@@ -149,7 +149,11 @@ section IxTcVerify
 Non-default: `lake build ix` never
 touches it, and `build-all` (the lint driver) skips it by name while it
 carries `sorry`s — `lake lint -- --wfail` would otherwise fail on the
-WIP proof frontier. Dev loop: `lake build IxTcVerify`. -/
+WIP proof frontier. Required CI builds it separately without `--wfail`,
+audits the exact local sorry frontier, and checks exact per-root transitive
+axiom plus direct-`sorryAx`-origin manifests. Dev loop:
+`lake build IxTcVerify`; focused trust audit:
+`lake build Ix.Tc.Verify.Audit.Completed Ix.Tc.Verify.Audit.Statements`. -/
 lean_lib IxTcVerify where
   globs := #[.submodules `Ix.Tc.Verify]
 
@@ -214,6 +218,7 @@ script "build-all" (args) := do
   let exeNames := pkg.configTargets LeanExe.configKind |>.map (·.name.toString)
   -- IxTcVerify is the WIP proofs lib: sorry-bearing by design while the
   -- verification frontier is open, so it must not run under `--wfail`.
+  -- Required CI builds it separately and audits the exact frontier.
   let allNames := (libNames ++ exeNames |>.toList).filter (· != "IxTcVerify")
   for name in allNames do
     IO.println s!"Building: {name}"